Mercurial > hg > xemacs-beta
changeset 80:1ce6082ce73f r20-0b90
Import from CVS: tag r20-0b90
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:05:44 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:06:37 2007 +0200 @@ -1,4 +1,13 @@ -*- indented-text -*- +to 20.0 beta90 +-- ediff-2.64 +-- viper-2.92 +-- bench.el-1.2 +-- Degenerate extent insertion speedup courtesy of David Moore +-- decipher.el (from Emacs 19.34) +-- w3-3.0.43 +-- Miscellaneous bug fixes + to 20.0 beta34 -- backup-dir 2.0 courtesy of Greg Klanderman -- lazy-lock-1.15
--- a/ChangeLog Mon Aug 13 09:05:44 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:06:37 2007 +0200 @@ -1,3 +1,11 @@ +Sat Jan 11 12:05:31 1997 Steven L Baur <steve@altair.xemacs.org> + * XEmacs 20.0 beta90 (prerelease 1) is released. + * XEmacs 19.15 beta90 (prerelease 1) is released. + +Tue Jan 7 08:45:16 1997 Steven L Baur <steve@altair.xemacs.org> + + * configure.in (LIBS): Revise test for XFree86 (look for XF86Config). + Sat Jan 4 14:52:57 1997 Steven L Baur <steve@altair.xemacs.org> * XEmacs 20.0 beta 34 is released. * XEmacs 19.15 beta 7 is released. @@ -6,6 +14,133 @@ * lwlib/Makefile.in.in: lwlib is required if X11 is used. +Wed Jan 1 08:30:48 1997 Martin Buchholz <mrb@eng.sun.com> + + * src/emacs.c: Make sure + `./temacs -batch -l loadup.el run-temacs <emacs-args>' + works properly + + * src/Makefile.in.in (rtcmacs): Add support for RTC, Sun's + competitor to Purify. + + * man/lispref/symbols.texi: Fix up bit vector documentation + * man/lispref/sequences.texi: Fix up bit vector documentation + + * lisp/sunpro/sunpro-load.el: Only preload mime-setup for Sun. + + * lisp/prim/update-elc.el: Don't rely on autoloads. + +Tue Dec 31 09:46:13 1996 Martin Buchholz <mrb@eng.sun.com> + + * lisp/prim/auto-autoloads.el: New, completely program-generated, file + * lib-src/update-autoloads.sh: Rewritten to use auto-autoloads.el. + * lisp/utils/autoload.el: Reorganization of autoload mechanism: + Errors during autoload generation are just that - errors. + + Generated autoloads are now in a separate file of their own. + + Reliability of autoload generation greatly increased. + + Distribution smaller by about 100k. + + `make autoloads' is still the preferred mechanism for update. + + Autoloads are always regenerated completely from scratch. This + avoids errors with obsolete or corrupted autoload entries. + + Caching of autoload entries using timestamps has been eliminated. + + Files that have no autoloads no longer have a comment placed into + the generated autoloads file. + + There was a bug where autoload entries would sometimes end up + being inserted into the *middle* of other autoload entries, + thereby corrupting them. + + * src/event-Xt.c: Remove SUNOS_GCC_L0_BUG kludge. + +Sun Dec 29 05:37:43 1996 Martin Buchholz <mrb@eng.sun.com> + + * lib-src/update-autoloads.sh: Make sure that `make autoloads' + doesn't use the autoload facility to load `autoload'; + load it explicity instead. + + * lib-src/update-elc.sh (ignore_dirs): ignore SCCS, CVS, RCS dirs + + * man/Makefile: Reinstate hyperbole & oo-browser manuals + + * lisp/modes/mail-abbrevs.el: Apply patch originated from Noah Friedman + + * src/mule-charset.c: Use lower case for charset registry, to + match XLFD. + + * Makefile.in: replace list of info files with *.info* - one less + maintenance headache + + * etc/sample.emacs: Add sample code to highlight continuation glyph + + * man/oo-browser.texi: Fix TeXability + + * man/hyperbole.texi: Fix TeXability + + * man/vhdl-mode.texi: Fix TeXability + + * lisp/prim/loaddefs.el: Wholesale housecleaning + `make autoloads' should finally work. + + * lib-src/emacsclient.c (main): ANSIfication, compiler warning removal + + * lisp/mule/mule-files.el: Add support for multi-lingual info files. + + * lib-src/update-elc.sh: `make all-elc' was updating files in + `special' directories without using the Makefiles + designed for that purpose. + - make sure ilisp isn't remade every time through `make all-elc'. + + * info/dir (Packages): Add Japanese TM info files + + * src/inline.c: Allow compilation with `gcc -g' + + * src/syntax.c (word_constituent_p): Allow compilation with `gcc -g' + + * src/lread.c: Don't put `...' immediately after a filename, so + that various tools can recognize the filename as such. + + * src/event-Xt.c (x_to_emacs_keysym): Fix crash when + --with-xim=xlib and key event on window frame. + Change return foo to return (foo) when return is a macro. + + * src/editfns.c (Ffollowing_char): docstring fixes. + + * man/tm/Makefile: Add support for Japanese TM info (but not dvi) files. + This Makefile is no longer officially broken. + + * info/dir: Add Japanese tm documents. + + * man/tm/tm-vm-en.texi: Make document TeX-friendly. + + * lib-src/update-autoloads.sh (EMACS): Don't rely on non-portable + xargs -i flag. + + * lisp/mule/mule-files.el (file-coding-system-alist): Make sure + the `binary' coding system is used for .gz and .Z extensions. + + * man/viper.texi: Viper version 2.90 + + * man/ediff.texi: Ediff Version 2.62 + + * lisp/packages/ispell.el (ispell-word): Avoid using strings with + define-key, for compatibility with loaddefs.el + + * lisp/modes/eiffel3.el: Make compatible with update-autoloads. + + * lisp/ilisp/Makefile (elc): Add target to avoid re-compilation. + + * lib-src/update-elc.sh: XEmacs sometimes re-byte-compiled elisp + files in dirs that have their own Makefiles. + + + Sun Dec 29 17:02:49 1996 Steven L Baur <steve@altair.xemacs.org> * Makefile.in (install-arch-indep): Force compression with `gzip -f'.
--- a/Makefile.in Mon Aug 13 09:05:44 2007 +0200 +++ b/Makefile.in Mon Aug 13 09:06:37 2007 +0200 @@ -234,7 +234,7 @@ # Sub-target for all-elc. dump-elc dump-elcs: FRC.dump-elcs - cd src; $(MAKE) dump-elcs $(MFLAGS) \ + cd src && $(MAKE) dump-elcs $(MFLAGS) \ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' autoloads: src @@ -299,7 +299,7 @@ .RECURSIVE: ${SUBDIR} ${SUBDIR}: ${SUBDIR_MAKEFILES} src/config.h FRC - cd $@; $(MAKE) all $(MFLAGS) \ + cd $@ && $(MAKE) all $(MFLAGS) \ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' Makefile: ${srcdir}/Makefile.in config.status @@ -352,7 +352,7 @@ $(MAKE) install $(MFLAGS) prefix=${prefix} \ exec_prefix=${exec_prefix} bindir=${bindir} libdir=${libdir} \ archlibdir=${archlibdir}) - if [ `(cd ${archlibdir}; /bin/pwd)` != `(cd ./lib-src; /bin/pwd)` ]; \ + if [ `(cd ${archlibdir} && /bin/pwd)` != `(cd ./lib-src && /bin/pwd)` ]; \ then \ ${INSTALL_DATA} lib-src/DOC ${archlibdir}/DOC ; \ for subdir in `find ${archlibdir} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; do \ @@ -363,7 +363,7 @@ ${INSTALL_PROGRAM} src/xemacs ${bindir}/xemacs-${version} -chmod 0755 ${bindir}/xemacs-${version} rm -f ${bindir}/xemacs - (cd ${bindir} ; ${LN_S} xemacs-${version} ./xemacs) + (cd ${bindir} && ${LN_S} xemacs-${version} ./xemacs) install-arch-indep: mkdir -set ${COPYDESTS} ; \ @@ -380,7 +380,8 @@ [ -d $${dir} ] \ && [ `(cd $${dir} && /bin/pwd)` != `(cd $${dest} && /bin/pwd)` ] \ && (echo "Copying $${dir}..." ; \ - (cd $${dir}; tar -cf - . )|(cd $${dest};umask 022; tar -xf - );\ + (cd $${dir} && tar -cf - . ) | \ + (cd $${dest} && umask 022 && tar -xf - );\ chmod 0755 $${dest}; \ for subdir in `find $${dest} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; do \ rm -rf $${subdir}/RCS $${subdir}/CVS $${subdir}/SCCS ; \ @@ -389,17 +390,17 @@ done if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \ then \ - (cd ${srcdir}/info ; \ + (cd ${srcdir}/info && \ if [ ! -f ${infodir}/dir ] && [ -f dir ]; then \ ${INSTALL_DATA} ${srcdir}/info/dir ${infodir}/dir ; \ fi ; \ for f in *.info* ; do \ ${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f ; \ chmod 0644 ${infodir}/$$f; \ - gzip -f9 ${infodir}/$$f; \ + gzip -9 -f ${infodir}/$$f; \ done); \ else true; fi - cd ${srcdir}/etc; for page in xemacs etags ctags gnuserv \ + cd ${srcdir}/etc && for page in xemacs etags ctags gnuserv \ gnuclient gnuattach gnudoit ; do \ ${INSTALL_DATA} ${srcdir}/etc/$${page}.1 ${mandir}/$${page}${manext} ; \ chmod 0644 ${mandir}/$${page}${manext} ; \ @@ -574,10 +575,10 @@ @echo "If you don't have a copy of etags around, then do 'make lib-src' first." @PATH=`pwd`/lib-src:$$PATH HOME=/-=-; export PATH HOME; \ echo "Using etags from `which etags`." - PATH=`pwd`/lib-src:$$PATH ; export PATH; cd ${srcdir} ; \ + PATH=`pwd`/lib-src:$$PATH ; export PATH; cd ${srcdir} && \ etags --regex='/[ ]*DEF\(VAR\|INE\)_[A-Z_]+[ ]*([ ]*"\([^"]+\)"/\2/' src/*.[ch] ; \ for d in `find lisp -name SCCS -prune -o -name RCS -prune -o -type d -print` ; do \ - (cd $$d ; if [ "`echo *.el`" != "*.el" ] ; then etags -a -o ${srcdir}/TAGS *.el ; fi ) ; \ + (cd $$d && if [ "`echo *.el`" != "*.el" ] ; then etags -a -o ${srcdir}/TAGS *.el ; fi ) ; \ done ; \ etags -a lwlib/*.[ch]
--- a/configure Mon Aug 13 09:05:44 2007 +0200 +++ b/configure Mon Aug 13 09:06:37 2007 +0200 @@ -3011,7 +3011,9 @@ if test -d /usr/X386/include; then HAVE_XFREE386=yes test -z "${C_SWITCH_X_SITE}" && C_SWITCH_X_SITE="-I/usr/X386/include" - elif test -d /usr/X11R6/include; then + elif test -f /etc/XF86Config -o \ + -f /etc/X11/XF86Config -o \ + -f /usr/X11R6/lib/X11/XF86Config; then HAVE_XFREE386=yes test -z "${C_SWITCH_X_SITE}" && C_SWITCH_X_SITE="-I/usr/X11R6/include" else @@ -5519,23 +5521,33 @@ # AIX export list -for export in /usr/lpp/X11/bin/smt.exp /usr/bin/X11/smt.exp ; do - if test -f "$export" ; then - -{ -test -n "$verbose" && \ -echo " defining" AIX_SMT_EXP to be "-bI:$export" -echo "#define" AIX_SMT_EXP "-bI:$export" >> confdefs.h -DEFS="$DEFS -DAIX_SMT_EXP=-bI:$export" -ac_sed_defs="${ac_sed_defs}\${ac_dA}AIX_SMT_EXP\${ac_dB}AIX_SMT_EXP\${ac_dC}-bI:\\\\\\\$export\${ac_dD} -\${ac_uA}AIX_SMT_EXP\${ac_uB}AIX_SMT_EXP\${ac_uC}-bI:\\\\\\\$export\${ac_uD} -\${ac_eA}AIX_SMT_EXP\${ac_eB}AIX_SMT_EXP\${ac_eC}-bI:\\\\\\\$export\${ac_eD} -" -} - - break - fi -done +if test -f /usr/lpp/X11/bin/smt.exp ; then + +{ +test -n "$verbose" && \ +echo " defining" AIX_SMT_EXP to be "-bI:/usr/lpp/X11/bin/smt.exp" +echo "#define" AIX_SMT_EXP "-bI:/usr/lpp/X11/bin/smt.exp" >> confdefs.h +DEFS="$DEFS -DAIX_SMT_EXP=-bI:/usr/lpp/X11/bin/smt.exp" +ac_sed_defs="${ac_sed_defs}\${ac_dA}AIX_SMT_EXP\${ac_dB}AIX_SMT_EXP\${ac_dC}-bI:/usr/lpp/X11/bin/smt.exp\${ac_dD} +\${ac_uA}AIX_SMT_EXP\${ac_uB}AIX_SMT_EXP\${ac_uC}-bI:/usr/lpp/X11/bin/smt.exp\${ac_uD} +\${ac_eA}AIX_SMT_EXP\${ac_eB}AIX_SMT_EXP\${ac_eC}-bI:/usr/lpp/X11/bin/smt.exp\${ac_eD} +" +} + +elif test -f /usr/bin/X11/smt.exp ; then + +{ +test -n "$verbose" && \ +echo " defining" AIX_SMT_EXP to be "-bI:/usr/bin/X11/smt.exp" +echo "#define" AIX_SMT_EXP "-bI:/usr/bin/X11/smt.exp" >> confdefs.h +DEFS="$DEFS -DAIX_SMT_EXP=-bI:/usr/bin/X11/smt.exp" +ac_sed_defs="${ac_sed_defs}\${ac_dA}AIX_SMT_EXP\${ac_dB}AIX_SMT_EXP\${ac_dC}-bI:/usr/bin/X11/smt.exp\${ac_dD} +\${ac_uA}AIX_SMT_EXP\${ac_uB}AIX_SMT_EXP\${ac_uC}-bI:/usr/bin/X11/smt.exp\${ac_uD} +\${ac_eA}AIX_SMT_EXP\${ac_eB}AIX_SMT_EXP\${ac_eC}-bI:/usr/bin/X11/smt.exp\${ac_eD} +" +} + +fi CFLAGS="$REAL_CFLAGS"
--- a/configure.in Mon Aug 13 09:05:44 2007 +0200 +++ b/configure.in Mon Aug 13 09:06:37 2007 +0200 @@ -2091,7 +2091,9 @@ if test -d /usr/X386/include; then HAVE_XFREE386=yes test -z "${C_SWITCH_X_SITE}" && C_SWITCH_X_SITE="-I/usr/X386/include" - elif test -d /usr/X11R6/include; then + elif test -f /etc/XF86Config -o \ + -f /etc/X11/XF86Config -o \ + -f /usr/X11R6/lib/X11/XF86Config; then HAVE_XFREE386=yes test -z "${C_SWITCH_X_SITE}" && C_SWITCH_X_SITE="-I/usr/X11R6/include" else
--- a/dynodump/Makefile.in.in Mon Aug 13 09:05:44 2007 +0200 +++ b/dynodump/Makefile.in.in Mon Aug 13 09:06:37 2007 +0200 @@ -95,7 +95,7 @@ #endif dynodump.so: ${srcdir}/_dynodump.h $(OBJS) - PATH=/usr/ccs/bin:/bin:$PATH ld -o dynodump.so -G $(OBJS) -lelf -lmapmalloc + PATH=/usr/ccs/bin:/bin:$$PATH ld -o dynodump.so -G $(OBJS) -lelf -lmapmalloc _relocate.o: ${srcdir}/$(ARCH)/_relocate.c $(CC) -c $(ALL_CFLAGS) ${srcdir}/$(ARCH)/_relocate.c
--- a/etc/sample.emacs Mon Aug 13 09:05:44 2007 +0200 +++ b/etc/sample.emacs Mon Aug 13 09:06:37 2007 +0200 @@ -569,24 +569,6 @@ (resize-minibuffer-mode) (setq resize-minibuffer-window-exactly nil) -;; Create a single detached minibuffer used by all frames. -;; Uncomment to try this out. -;(when running-xemacs -; (setq initial-frame-plist '(minibuffer nil)) -; (setq default-frame-plist '(minibuffer nil)) -; (setq default-minibuffer-frame -; (make-frame -; '(minibuffer only -; width 86 -; height 1 -; menubar-visible-p nil -; default-toolbar-visible-p nil -; name "minibuffer" -; top -2 -; left -2 -; has-modeline-p nil))) -; (frame-notice-user-settings)) - ;;; ******************** ;;; W3 is a browser for the World Wide Web, and takes advantage of the very ;;; latest redisplay features in XEmacs. You can access it simply by typing
--- a/etc/viperCard.tex Mon Aug 13 09:05:44 2007 +0200 +++ b/etc/viperCard.tex Mon Aug 13 09:06:37 2007 +0200 @@ -82,7 +82,7 @@ are preserved on all copies. For copies of the GNU Emacs manual, write to the Free Software -Foundation, Inc., 1000 Massachusetts Ave, Cambridge MA 02138. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. \endgroup}
--- a/lib-src/Makefile.in.in Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/Makefile.in.in Mon Aug 13 09:06:37 2007 +0200 @@ -303,13 +303,13 @@ ./make-path ${archlibdir} if [ `(cd ${archlibdir} && /bin/pwd)` != `/bin/pwd` ]; then \ for file in ${UTILITIES}; do \ - (cd ..; $(INSTALL_PROGRAM) lib-src/$$file ${archlibdir}/$$file) ; \ + (cd .. && $(INSTALL_PROGRAM) lib-src/$$file ${archlibdir}/$$file) ; \ done ; \ fi if [ `(cd ${archlibdir} && /bin/pwd)` \ != `(cd ${srcdir} && /bin/pwd)` ]; then \ for file in ${SCRIPTS}; do \ - (cd ..; $(INSTALL_PROGRAM) ${srcdir}/$$file ${archlibdir}/$$file); \ + (cd .. && $(INSTALL_PROGRAM) ${srcdir}/$$file ${archlibdir}/$$file); \ done ; \ fi @@ -319,16 +319,16 @@ @echo @echo "Installing utilities for users to run." for file in ${INSTALLABLES} ; do \ - (cd ..; $(INSTALL_PROGRAM) lib-src/$${file} ${bindir}/$${file}) ; \ + (cd .. && $(INSTALL_PROGRAM) lib-src/$${file} ${bindir}/$${file}) ; \ done for file in ${INSTALLABLE_SCRIPTS} ; do \ - (cd ..; $(INSTALL_PROGRAM) ${srcdir}/$${file} ${bindir}/$${file}) ; \ + (cd .. && $(INSTALL_PROGRAM) ${srcdir}/$${file} ${bindir}/$${file}) ; \ done uninstall: - (cd ${bindir}; \ + (cd ${bindir} && \ rm -f ${INSTALLABLES} ${INSTALLABLE_SCRIPTS}) - (cd ${archlibdir}; \ + (cd ${archlibdir} && \ rm -f ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS}) mostlyclean: @@ -383,7 +383,7 @@ etags: ${srcdir}/etags.c $(GETOPTDEPS) $(REGEXDEPS) ../src/config.h $(CC) ${ALL_CFLAGS} -DVERSION="\"${version}\"" -DETAGS_REGEXPS ${srcdir}/etags.c $(GETOPTOBJS) $(REGEXOBJ) $(LOADLIBES) -o etags -/* We depend on etags to assure that parallel makes don't write two +/* We depend on etags to assure that parallel makes do not write two etags.o files on top of each other. */ ctags: ${srcdir}/etags.c $(GETOPTDEPS) etags $(CC) ${ALL_CFLAGS} -DCTAGS -DVERSION="\"${version}\"" ${srcdir}/etags.c $(GETOPTOBJS) $(LOADLIBES) -o ctags @@ -433,7 +433,7 @@ make-po: ${srcdir}/make-po.c $(CC) ${CPP_CFLAGS} ${srcdir}/make-po.c $(LOADLIBES) -o make-po -/* Why oh why doesn't HP include half of the standard X distribution? */ +/* Why oh why does HP not include half of the standard X distribution? */ #if defined (HAVE_XAUTH) gnuslib.o: ${srcdir}/gnuslib.c ${srcdir}/gnuserv.h ../src/config.h
--- a/lib-src/emacsclient.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/emacsclient.c Mon Aug 13 09:06:37 2007 +0200 @@ -44,7 +44,7 @@ fprintf (stderr, "%s: Sorry, the Emacs server is supported only\n", argv[0]); fprintf (stderr, "on systems with Berkeley sockets or System V IPC.\n"); - exit (1); + return 1; } #else /* HAVE_SOCKETS or HAVE_SYSVIPC */ @@ -321,7 +321,7 @@ strcpy (buf, msgp->mtext); printf ("\n%s\n", buf); - exit (0); + return 0; } #endif /* HAVE_SYSVIPC */
--- a/lib-src/gnudoit.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/gnudoit.c Mon Aug 13 09:06:37 2007 +0200 @@ -45,7 +45,7 @@ #else /* SYSV_IPC || UNIX_DOMAIN_SOCKETS || INTERNET_DOMAIN_SOCKETS */ int -main(int argc, char *argv[]) +main (int argc, char *argv[]) { int qflg = 0; /* don't wait around for * gnu emacs to eval cmd */
--- a/lib-src/tm-au Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tm-au Mon Aug 13 09:06:37 2007 +0200 @@ -1,8 +1,10 @@ #!/bin/sh - # -# $Id: tm-au,v 1.2 1996/12/28 21:02:51 steve Exp $ +# $Id: tm-au,v 1.3 1997/01/11 20:13:51 steve Exp $ # +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + if [ "$TM_TMP_DIR" = "" ]; then TM_TMP_DIR=/tmp export TM_TMP_DIR
--- a/lib-src/tm-file Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tm-file Mon Aug 13 09:06:37 2007 +0200 @@ -1,8 +1,10 @@ #!/bin/sh - # -# $Id: tm-file,v 1.2 1996/12/28 21:02:51 steve Exp $ +# $Id: tm-file,v 1.3 1997/01/11 20:13:51 steve Exp $ # +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + if [ "$TM_TMP_DIR" = "" ]; then TM_TMP_DIR=/tmp export TM_TMP_DIR
--- a/lib-src/tm-html Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tm-html Mon Aug 13 09:06:37 2007 +0200 @@ -1,8 +1,10 @@ #!/bin/sh # -# $Id: tm-html,v 1.2 1996/12/28 21:02:51 steve Exp $ +# $Id: tm-html,v 1.3 1997/01/11 20:13:51 steve Exp $ # +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + if [ "$TM_TMP_DIR" = "" ]; then TM_TMP_DIR=/tmp export TM_TMP_DIR
--- a/lib-src/tm-image Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tm-image Mon Aug 13 09:06:37 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tm-image,v 1.2 1996/12/28 21:02:52 steve Exp $ +# $Id: tm-image,v 1.3 1997/01/11 20:13:51 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc. @@ -19,6 +19,8 @@ # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + if [ "$TM_TMP_DIR" = "" ]; then TM_TMP_DIR=/tmp export TM_TMP_DIR
--- a/lib-src/tm-mpeg Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tm-mpeg Mon Aug 13 09:06:37 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tm-mpeg,v 1.2 1996/12/28 21:02:52 steve Exp $ +# $Id: tm-mpeg,v 1.3 1997/01/11 20:13:51 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc. @@ -19,6 +19,8 @@ # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + if [ "$TM_TMP_DIR" = "" ]; then TM_TMP_DIR=/tmp export TM_TMP_DIR
--- a/lib-src/tm-plain Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tm-plain Mon Aug 13 09:06:37 2007 +0200 @@ -1,8 +1,10 @@ #!/bin/sh - # -# $Id: tm-plain,v 1.2 1996/12/28 21:02:52 steve Exp $ +# $Id: tm-plain,v 1.3 1997/01/11 20:13:52 steve Exp $ # +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + if [ "$TM_TMP_DIR" = "" ]; then TM_TMP_DIR=/tmp export TM_TMP_DIR
--- a/lib-src/tm-ps Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tm-ps Mon Aug 13 09:06:37 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tm-ps,v 1.2 1996/12/28 21:02:52 steve Exp $ +# $Id: tm-ps,v 1.3 1997/01/11 20:13:52 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc. @@ -19,6 +19,8 @@ # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + if [ "$TM_TMP_DIR" = "" ]; then TM_TMP_DIR=/tmp export TM_TMP_DIR
--- a/lib-src/tmdecode Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/tmdecode Mon Aug 13 09:06:37 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tmdecode,v 1.2 1996/12/28 21:02:52 steve Exp $ +# $Id: tmdecode,v 1.3 1997/01/11 20:13:52 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc. @@ -19,6 +19,8 @@ # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. +PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH + trap 'rm -f $2' 0 1 2 3 13 15 case "$3" in
--- a/lib-src/update-autoloads.sh Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/update-autoloads.sh Mon Aug 13 09:06:37 2007 +0200 @@ -1,5 +1,5 @@ #!/bin/sh -### update-autoloads.sh --- update auto-loaddefs.el as necessary +### update-autoloads.sh --- update auto-autoloads.el as necessary set -eu
--- a/lib-src/update-elc.sh Mon Aug 13 09:05:44 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 09:06:37 2007 +0200 @@ -39,8 +39,8 @@ els=/tmp/rcl1.$$ ; elcs=/tmp/rcl2.$$ rm -f $els $elcs trap "rm -f $els $elcs" 0 1 2 3 15 -find lisp/. -name SCCS -prune -o -name '*.el' -print | sort > $els -find lisp/. -name SCCS -prune -o -name '*.elc' -print | sed 's/elc$/el/' | sort > $elcs +find lisp/. $prune_vc -name '*.el' -print | sort > $els +find lisp/. $prune_vc -name '*.elc' -print | sed 's/elc$/el/' | sort > $elcs echo "Deleting .elc files without .el files..." @@ -78,15 +78,14 @@ } make_special vm -make_special ediff elc -make_special viper elc +#make_special ediff elc +#make_special viper elc make_special gnus some make_special w3 -make_special url # really part of w3 make_special hyperbole elc make_special oobr HYPB_ELC='' elc make_special eos -k # not stricly necessary... -make_special ilisp elc -f Makefile +make_special ilisp elc ignore_pattern='' for dir in $ignore_dirs ; do @@ -122,9 +121,9 @@ echo "Compiling files with out-of-date .elc..." -find lisp/. -name CVS -prune -o -name SCCS -prune -o -type d -print | \ +find lisp/* $prune_vc -type d -print | \ sed "$ignore_pattern" | \ - xargs -t $REAL -batch -q -no-site-file -f batch-byte-recompile-directory + xargs -t $BYTECOMP -f batch-byte-recompile-directory echo "Compiling files with out-of-date .elc... Done"
--- a/lisp/ChangeLog Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:06:37 2007 +0200 @@ -1,3 +1,71 @@ +Fri Jan 10 22:27:58 1997 Shane Holder <holder@rsn.hp.com> + + * utils/bench.el: New version. + +Fri Jan 10 13:22:26 1997 Christoph Wedler <wedler@fmi.uni-passau.de> + + * packages/man.el (Manual-entry-switches): New variable. + (Manual-apropos-switches): New variable. + (Manual-run-formatter): Use them. + +Thu Jan 9 22:04:42 1997 Greg Klanderman <greg@alphatech.com> + + * modes/make-mode.el: Allow disabling of suspicious line warnings + allow macro pickup when a macro is entered normally + add the runtime macros to the completion list so confirmation is + not necessary when minibuffer-confirm-incomplete is t. + (these last two only in effect when makefile-electric-keys=t) + +Thu Jan 9 11:44:11 1997 Martin Buchholz <mrb@eng.sun.com> + + * mule/mule-files.el (file-coding-system-alist): Default to 8 bit + on .el and .info files. + +Wed Jan 8 20:57:16 1997 Steven L Baur <steve@altair.xemacs.org> + + * prim/help.el (help-mode-quit): Correct typo in docstring. + (help-mode-quit): Bury help buffer before restoring previous + window configuration. + +Wed Jan 8 20:20:01 1997 Joe Nuspl <nuspl@nvwls.cc.purdue.edu> + + * x11/x-menubar.el (default-menubar): Include enriched.doc in the + samples in the help menu. + +Wed Jan 8 20:09:32 1997 Jens Krinke <krinke@ips.cs.tu-bs.de> + + * x11/x-toolbar.el (toolbar-news-frame-properties): New variable. + (toolbar-news): Use it. + +Wed Jan 8 10:11:35 1997 Steven L Baur <steve@altair.xemacs.org> + + * x11/x-compose.el (global-map): Keysyms use `-' not `_'. + +Mon Jan 6 18:19:03 1997 Steven L Baur <steve@altair.xemacs.org> + + * comint/telnet.el (telnet-initial-filter): Enable + case-fold-search. + (telnet-maximum-count): Bump up to 6, since 4 does not always + appear to be enough. + +Mon Jan 6 08:30:55 1997 Andrew Cohen <cohen@andy.bu.edu> + + * psgml/psgml-parse.el (sgml-compile-dtd): noconv coding system + has been renamed to no-conversion. + (sgml-bdtd-merge): Ditto. + (sgml-push-to-entity): Ditto. + +Sun Jan 5 14:35:30 1997 Steven L Baur <steve@altair.xemacs.org> + + * utils/loadhist.el (symbol-file): Make interactive. + +Sun Jan 5 00:40:02 1997 Bob Weiner <weiner@infodock.com> + + * packages/avoid.el (mouse-avoidance-mode): autoload. + + * x11/x-menubar.el (options-menu-saved-forms): Mouse avoidance + mode option. + Sat Jan 4 12:25:34 1997 Steven L Baur <steve@altair.xemacs.org> * prim/faces.el (init-other-random-faces): Guard against adding
--- a/lisp/comint/telnet.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/comint/telnet.el Mon Aug 13 09:06:37 2007 +0200 @@ -73,7 +73,7 @@ (defvar telnet-program "telnet" "Program to run to open a telnet connection.") -(defvar telnet-initial-count -50 +(defvar telnet-initial-count -75 "Initial value of `telnet-count'. Should be set to the negative of the number of terminal writes telnet will make setting up the host connection.") @@ -130,29 +130,31 @@ (setq comint-prompt-regexp telnet-prompt-pattern)) (defun telnet-initial-filter (proc string) - ;For reading up to and including password; also will get machine type. - (cond ((string-match "No such host" string) - (kill-buffer (process-buffer proc)) - (error "No such host.")) - ((string-match "passw" string) - (telnet-filter proc string) - (let ((password (comint-read-noecho "Password: " t))) - (setq telnet-count 0) - (process-send-string proc (concat password telnet-new-line)))) - (t (telnet-check-software-type-initialize string) + (let ((case-fold-search t)) + ;For reading up to and including password; also will get machine type. + (cond ((string-match "No such host" string) + (kill-buffer (process-buffer proc)) + (error "No such host.")) + ((string-match "passw" string) (telnet-filter proc string) - (cond ((> telnet-count telnet-maximum-count) - ;; (set-process-filter proc 'telnet-filter) - ;; Kludge for shell-fonts -- this is the only mode that - ;; actually changes what its process filter is at run time, - ;; which confuses shell-font. So we special-case that here. - ;; #### Danger, knows an internal shell-font variable name. - (let ((old-filter (process-filter proc))) - (if (eq old-filter 'shell-font-process-filter) - (set (make-local-variable 'shell-font-process-filter) - 'telnet-filter) - (set-process-filter proc 'telnet-filter)))) - (t (setq telnet-count (1+ telnet-count))))))) + (let ((password (comint-read-noecho "Password: " t))) + (setq telnet-count 0) + (process-send-string proc (concat password telnet-new-line)))) + (t (telnet-check-software-type-initialize string) + (telnet-filter proc string) + (cond ((> telnet-count telnet-maximum-count) + ;; (set-process-filter proc 'telnet-filter) Kludge + ;; for shell-fonts -- this is the only mode that + ;; actually changes what its process filter is at + ;; run time, which confuses shell-font. So we + ;; special-case that here. + ;; #### Danger, knows an internal shell-font variable name. + (let ((old-filter (process-filter proc))) + (if (eq old-filter 'shell-font-process-filter) + (set (make-local-variable 'shell-font-process-filter) + 'telnet-filter) + (set-process-filter proc 'telnet-filter)))) + (t (setq telnet-count (1+ telnet-count)))))))) ;; Identical to comint-simple-send, except that it sends telnet-new-line ;; instead of "\n".
--- a/lisp/ediff/Makefile Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/Makefile Mon Aug 13 09:06:37 2007 +0200 @@ -34,10 +34,6 @@ ediff-ptch.elc ediff.elc ediff-hook.elc # ediff-tbar.elc -PRELOADS = -l ./ediff-init.el -l ./ediff-help.el -l ./ediff-diff.el \ - -l ./ediff-wind.el -l ./ediff-merg.el -l ./ediff-mult.el \ - -l ./ediff-util.el -l ./ediff.el -# -l ./ediff-tbar.el all: hello elc goodbye dvi info @@ -80,39 +76,39 @@ ediff-tbar.elc: ediff-tbar.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-tbar.el + $(EMACS) -batch -f batch-byte-compile ediff-tbar.el ediff-diff.elc: ediff-init.el ediff-diff.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-diff.el + $(EMACS) -batch -f batch-byte-compile ediff-diff.el ediff-merg.elc: ediff-init.el ediff-merg.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-merg.el + $(EMACS) -batch -f batch-byte-compile ediff-merg.el ediff-mult.elc: ediff-init.el ediff-mult.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-mult.el + $(EMACS) -batch -f batch-byte-compile ediff-mult.el ediff-vers.elc: ediff-init.el ediff-vers.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-vers.el + $(EMACS) -batch -f batch-byte-compile ediff-vers.el ediff-ptch.elc: ediff-init.el ediff-ptch.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-ptch.el + $(EMACS) -batch -f batch-byte-compile ediff-ptch.el ediff.elc: ediff-init.el ediff.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff.el + $(EMACS) -batch -f batch-byte-compile ediff.el ediff-util.elc: ediff-init.el ediff-util.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-util.el + $(EMACS) -batch -f batch-byte-compile ediff-util.el ediff-wind.elc: ediff-init.el ediff-wind.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile ediff-wind.el + $(EMACS) -batch -f batch-byte-compile ediff-wind.el ediff.dvi: ediff.texi @echo ""
--- a/lisp/ediff/README Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/README Mon Aug 13 09:06:37 2007 +0200 @@ -12,6 +12,7 @@ ediff.el -- Ediff Emacs Lisp code ediff-init.el -- Ediff Emacs Lisp code +ediff-help.el -- Ediff Emacs Lisp code ediff-wind.el -- Ediff Emacs Lisp code ediff-util.el -- Ediff Emacs Lisp code ediff-diff.el -- Ediff Emacs Lisp code
--- a/lisp/ediff/ediff-diff.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-diff.el Mon Aug 13 09:06:37 2007 +0200 @@ -23,6 +23,20 @@ ;;; Code: +(provide 'ediff-diff) + +;; compiler pacifier +(defvar ediff-default-variant) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-util) + (load "ediff-util.el" nil nil 'nosuffix)) + )) +;; end pacifier + (require 'ediff-init) @@ -1204,7 +1218,5 @@ ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: -(provide 'ediff-diff) - ;; ediff-diff.el ends here
--- a/lisp/ediff/ediff-help.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-help.el Mon Aug 13 09:06:37 2007 +0200 @@ -22,17 +22,21 @@ ;; Boston, MA 02111-1307, USA. ;;; Code: - -(require 'ediff-init) + +(provide 'ediff-help) ;; Compiler pacifier start (defvar ediff-multiframe) -(and noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (load-file "ediff-init.el")))) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + )) ;; end pacifier +(require 'ediff-init) + ;; Help messages (defconst ediff-long-help-message-head @@ -178,8 +182,7 @@ "Explain Ediff commands in more detail." (interactive) (ediff-barf-if-not-control-buffer) - (let ((ctl-buf (current-buffer)) - (pos (ediff-event-point last-command-event)) + (let ((pos (ediff-event-point last-command-event)) overl cmd) (if ediff-xemacs-p @@ -306,6 +309,5 @@ ediff-brief-help-message)) (run-hooks 'ediff-display-help-hook)) -(provide 'ediff-help) ;;; ediff-help.el ends here
--- a/lisp/ediff/ediff-hook.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-hook.el Mon Aug 13 09:06:37 2007 +0200 @@ -38,24 +38,31 @@ (defvar epatch-menu) ;; end pacifier +;; allow menus to be set up without ediff-wind.el being loaded +(defvar ediff-window-setup-function) + (defun ediff-xemacs-init-menus () + (setq ediff-window-setup-function + (if (console-on-window-system-p) + 'ediff-setup-windows-multiframe + 'ediff-setup-windows-plain)) (if (featurep 'menubar) (progn -;; (add-menu-button -;; '("Tools") -;; ["Use separate frame for Ediff control buffer" -;; ediff-toggle-multiframe -;; :style toggle -;; :selected (eq ediff-window-setup-function 'ediff-setup-windows-multiframe)] -;; "00-Browser...") -;; (add-menu-button -;; '("Tools") -;; ["Use a toolbar with Ediff control buffer" -;; ediff-menu-toggle-use-toolbar -;; :style toggle -;; :selected (ediff-use-toolbar-p)] -;; "00-Browser...") + (add-menu-button + '("Tools") + ["Use separate frame for Ediff control buffer" + ediff-toggle-multiframe + :style toggle + :selected (eq ediff-window-setup-function 'ediff-setup-windows-multiframe)] + "00-Browser...") + ;;(add-menu-button + ;; '("Tools") + ;; ["Use a toolbar with Ediff control buffer" + ;; ediff-toggle-use-toolbar + ;; :style toggle + ;; :selected (ediff-use-toolbar-p)] + ;; "00-Browser...") (add-submenu '("Tools") ediff-menu "OO-Browser...") (add-submenu @@ -63,7 +70,8 @@ (add-submenu '("Tools") epatch-menu "OO-Browser...") (add-menu-button - '("Tools") "-------" "OO-Browser...") + '("Tools") + ["-------" nil nil] "OO-Browser...") ))) @@ -143,8 +151,8 @@ (define-key menu-bar-ediff-menu [ediff-doc] '("Ediff Manual..." . ediff-documentation)) (define-key menu-bar-ediff-menu [emultiframe] - '("Toggle separate control buffer frame..." - . ediff-toggle-multiframe)) + '("Toggle separate control buffer frame..." + . ediff-toggle-multiframe)) (define-key menu-bar-ediff-menu [eregistry] '("List Ediff Sessions..." . ediff-show-registry)) (define-key menu-bar-ediff-menu [separator-ediff-manual] '("--")) @@ -183,8 +191,8 @@ (define-key menu-bar-ediff-merge-menu [ediff-doc2] '("Ediff Manual..." . ediff-documentation)) (define-key menu-bar-ediff-merge-menu [emultiframe2] - '("Toggle separate control buffer frame..." - . ediff-toggle-multiframe)) + '("Toggle separate control buffer frame..." + . ediff-toggle-multiframe)) (define-key menu-bar-ediff-merge-menu [eregistry2] '("List Ediff Sessions..." . ediff-show-registry)) (define-key @@ -225,10 +233,10 @@ (define-key menu-bar-epatch-menu [ediff-doc3] '("Ediff Manual..." . ediff-documentation)) (define-key menu-bar-epatch-menu [emultiframe3] - '("Toggle separate control buffer frame..." - . ediff-toggle-multiframe)) + '("Toggle separate control buffer frame..." + . ediff-toggle-multiframe)) (define-key menu-bar-epatch-menu [eregistry3] - '("List Ediff Sessions..." . ediff-show-registry)) + '("List Ediff Sessions..." . ediff-show-registry)) (define-key menu-bar-epatch-menu [separator-epatch] '("--")) (define-key menu-bar-epatch-menu [ediff-patch-buffer] '("To a Buffer..." . ediff-patch-buffer)) @@ -337,11 +345,13 @@ "ediff-util" "Toggle the use of separate frame for Ediff control buffer." t) -;;(if (string-match "XEmacs" emacs-version) -;; (autoload 'ediff-toggle-use-toolbar -;; "ediff-tbar" -;; "Toggle the use of Ediff toolbar." -;; t)) + (condition-case nil + (if (string-match "XEmacs" emacs-version) + (autoload 'ediff-toggle-use-toolbar + "ediff-tbar" + "Toggle the use of Ediff toolbar." + t)) + (error)) ) ; if purify-flag
--- a/lisp/ediff/ediff-init.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-init.el Mon Aug 13 09:06:37 2007 +0200 @@ -63,7 +63,7 @@ (ediff-emacs-p (memq (ediff-device-type) '(pc))) (ediff-xemacs-p (memq (ediff-device-type) '(tty pc))))) - + ;; Defines SYMBOL as an advertised local variable. ;; Performs a defvar, then executes `make-variable-buffer-local' on ;; the variable. Also sets the `permanent-local' property, @@ -378,7 +378,7 @@ *** *** Please contact your system administrator. " (if ediff-xemacs-p "X" ""))) - + ;; Selective browsing (ediff-defvar-local ediff-skip-diff-region-function 'ediff-show-all-diffs @@ -513,7 +513,7 @@ ;; Buffer-local variables to be saved then restored during Ediff sessions ;; Buffer-local variables to be saved then restored during Ediff sessions (defconst ediff-protected-variables '( - ;;buffer-read-only + ;;buffer-read-only mode-line-format)) ;; Vector of differences between the variants. Each difference is @@ -1157,6 +1157,7 @@ (car (if ediff-xemacs-p (ange-ftp-ftp-path file-name) (ange-ftp-ftp-name file-name)))) + (defsubst ediff-frame-unsplittable-p (frame) (cdr (assq 'unsplittable (frame-parameters frame)))) @@ -1173,6 +1174,14 @@ (if (ediff-buffer-live-p buf) (kill-buffer (get-buffer buf)))) +(defsubst ediff-background-face (buf-type dif-num) + ;; The value of dif-num is always 1- the one that user sees. + ;; This is why even face is used when dif-num is odd. + (intern (format (if (ediff-odd-p dif-num) + "ediff-even-diff-face-%S" + "ediff-odd-diff-face-%S") + buf-type))) + ;; activate faces on diff regions in buffer (defun ediff-paint-background-regions-in-one-buffer (buf-type unhighlight) @@ -1183,11 +1192,13 @@ (lambda (rec) (setq overl (ediff-get-diff-overlay-from-diff-record rec) diff-num (ediff-overlay-get overl 'ediff-diff-num)) - (ediff-set-overlay-face - overl - (if (not unhighlight) - (ediff-background-face buf-type diff-num)) - ))) + (if (ediff-overlay-buffer overl) + ;; only if overlay is alive + (ediff-set-overlay-face + overl + (if (not unhighlight) + (ediff-background-face buf-type diff-num)))) + )) diff-vector))) @@ -1259,6 +1270,7 @@ (ediff-delete-overlay current-diff-overlay)) (set current-diff-overlay-var nil) ))) + (defsubst ediff-highlight-diff (n) "Put face on diff N. Invoked for X displays only." @@ -1285,14 +1297,6 @@ (ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor) ) -(defsubst ediff-background-face (buf-type dif-num) - ;; The value of dif-num is always 1- the one that user sees. - ;; This is why even face is used when dif-num is odd. - (intern (format (if (ediff-odd-p dif-num) - "ediff-even-diff-face-%S" - "ediff-odd-diff-face-%S") - buf-type))) - ;; arg is a record for a given diff in a difference vector ;; this record is itself a vector @@ -1417,6 +1421,18 @@ ;; Some overlay functions +(defsubst ediff-overlay-start (overl) + (if (ediff-overlayp overl) + (if ediff-emacs-p + (overlay-start overl) + (extent-start-position overl)))) + +(defsubst ediff-overlay-end (overl) + (if (ediff-overlayp overl) + (if ediff-emacs-p + (overlay-end overl) + (extent-end-position overl)))) + (defsubst ediff-empty-overlay-p (overl) (= (ediff-overlay-start overl) (ediff-overlay-end overl))) @@ -1592,17 +1608,17 @@ (defun ediff-convert-standard-filename (fname) - (if ediff-emacs-p + (if (fboundp 'convert-standard-filename) (convert-standard-filename fname) - ;; hopefully, XEmacs adds this functionality fname)) + ;;; Local Variables: ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: - + (provide 'ediff-init)
--- a/lisp/ediff/ediff-merg.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-merg.el Mon Aug 13 09:06:37 2007 +0200 @@ -23,6 +23,24 @@ ;;; Code: +(provide 'ediff-merg) + +;; compiler pacifier +(defvar ediff-window-A) +(defvar ediff-window-B) +(defvar ediff-window-C) +(defvar ediff-merge-window-share) +(defvar ediff-window-config-saved) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-util) + (load "ediff-util.el" nil nil 'nosuffix)) + )) +;; end pacifier + (require 'ediff-init) @@ -270,6 +288,4 @@ ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: -(provide 'ediff-merg) - ;; ediff-merg.el ends here
--- a/lisp/ediff/ediff-mult.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-mult.el Mon Aug 13 09:06:37 2007 +0200 @@ -26,7 +26,7 @@ ;; Users are encouraged to add functionality to this file. ;; The present file contains all the infrastructure needed for that. ;; -;; Generally, to implement a new multisession capability within Ediff, +;; Generally, to to implement a new multisession capability within Ediff, ;; you need to tell it ;; ;; 1. How to display the session group buffer. @@ -90,7 +90,20 @@ ;;; Code: +(provide 'ediff-mult) + +;; compiler pacifier +(eval-when-compile + (let ((load-path (cons (expand-file-name ".") load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-util) + (load "ediff-util.el" nil nil 'nosuffix)) + )) +;; end pacifier + (require 'ediff-init) +(require 'ediff-util) ;; meta-buffer (ediff-defvar-local ediff-meta-buffer nil "") @@ -366,7 +379,7 @@ (ediff-add-slash-if-directory auxdir1 elt))) lis1) auxdir2 (file-name-as-directory dir2) - lis2 (mapcar + lis2 (mapcar (function (lambda (elt) (ediff-add-slash-if-directory auxdir2 elt))) @@ -374,7 +387,7 @@ (if (stringp dir3) (setq auxdir3 (file-name-as-directory dir3) - lis3 (mapcar + lis3 (mapcar (function (lambda (elt) (ediff-add-slash-if-directory auxdir3 elt))) @@ -732,7 +745,7 @@ (feq (ediff-get-file-eqstatus fileinfo)) file-modtime file-size) - (cond ((not (stringp fname)) (setq file-size -2)) ; file doesn't exist + (cond ((not (stringp fname)) (setq file-size -2)) ; file doesn't exits ((not (ediff-file-remote-p fname)) (if (file-exists-p fname) ;; set real size and modtime @@ -1017,7 +1030,6 @@ (meta-buf (ediff-event-buffer last-command-event)) ;; ediff-get-meta-info gives error if meta-buf or pos are invalid (info (ediff-get-meta-info meta-buf pos)) - merge-autostore-dir (session-buf (ediff-get-session-buffer info))) (if (eq (ediff-get-session-status info) ?H) @@ -1198,6 +1210,7 @@ (meta-buf (ediff-event-buffer last-command-event)) ;; ediff-get-meta-info gives error if meta-buf or pos are invalid (info (ediff-get-meta-info meta-buf pos)) + merge-autostore-dir session-buf file1 file2 file3 regexp) (setq session-buf (ediff-get-session-buffer info) @@ -1718,7 +1731,4 @@ ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: -(provide 'ediff-mult) -(require 'ediff-util) - ;;; ediff-mult.el ends here
--- a/lisp/ediff/ediff-ptch.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-ptch.el Mon Aug 13 09:06:37 2007 +0200 @@ -23,6 +23,26 @@ ;;; Code: + +(provide 'ediff-ptch) + +;; compiler pacifier +(defvar ediff-window-A) +(defvar ediff-window-B) +(defvar ediff-window-C) +(defvar ediff-use-last-dir) +(defvar ediff-shell) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff) + (load "ediff.el" nil nil 'nosuffix)) + (or (featurep 'ange-ftp) + (load "ange-ftp" 'noerror)) + )) +;; end pacifier (require 'ediff-init) @@ -540,7 +560,7 @@ (select-window aux-wind) (bury-buffer))) (error "Patch appears to have failed"))) - + ;; If black magic is involved, apply patch to a temp copy of the ;; file. Otherwise, apply patch to the orig copy. If patch is applied ;; to temp copy, we name the result old-name_patched for local files @@ -571,11 +591,11 @@ ;; arrange that the temp copy of orig will be deleted (rename-file (concat true-source-filename ediff-backup-extension) true-source-filename t)) - + ;; make orig buffer read-only (setq startup-hooks (cons 'ediff-set-read-only-in-buf-A startup-hooks)) - + ;; set up a buf for the patched file (setq target-buf (find-file-noselect target-filename)) @@ -625,6 +645,4 @@ ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: -(provide 'ediff-ptch) - ;;; ediff-ptch.el ends here
--- a/lisp/ediff/ediff-util.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-util.el Mon Aug 13 09:06:37 2007 +0200 @@ -22,27 +22,51 @@ ;; Boston, MA 02111-1307, USA. ;;; Code: + +(provide 'ediff-util) -;; Pacify compiler and avoid the need in checking for boundp -(defvar ediff-patch-diagnostics nil) -(defvar ediff-patchbufer nil) -(and noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (load-file "ediff-init.el") - (load-file "ediff-help.el")))) +;; Compiler pacifier +(defvar ediff-patch-diagnostics) +(defvar ediff-patchbufer) +(defvar ediff-toolbar) +(defvar mark-active) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-help) + (load "ediff-help.el" nil nil 'nosuffix)) + (or (featurep 'ediff-mult) + (load "ediff-mult.el" nil nil 'nosuffix)) + (or (featurep 'ediff-wind) + (load "ediff-wind.el" nil nil 'nosuffix)) + (or (featurep 'ediff-diff) + (load "ediff-diff.el" nil nil 'nosuffix)) + (or (featurep 'ediff-merg) + (load "ediff-merg.el" nil nil 'nosuffix)) + (or (featurep 'ediff) + (load "ediff.el" nil nil 'nosuffix)) + (or (featurep 'ediff-tbar) + (load "ediff-tbar.el" 'noerror nil 'nosuffix)) + )) ;; end pacifier (require 'ediff-init) (require 'ediff-help) (require 'ediff-mult) +(require 'ediff-wind) +(require 'ediff-diff) +(require 'ediff-merg) -;;(if ediff-xemacs-p -;; (require 'ediff-tbar) -;; (defun ediff-use-toolbar-p () nil)) -;; -;; for the time being -(defun ediff-use-toolbar-p () nil) + +;; be careful with ediff-tbar +(if ediff-xemacs-p + (condition-case nil + (require 'ediff-tbar) + (error + (defun ediff-use-toolbar-p () nil))) + (defun ediff-use-toolbar-p () nil)) ;;; Functions @@ -83,9 +107,6 @@ (run-hooks 'ediff-mode-hook)) -(require 'ediff-diff) -(require 'ediff-merg) - ;;; Build keymaps @@ -218,8 +239,6 @@ ;;; Setup functions -(require 'ediff-wind) - ;; No longer needed: XEmacs has surrogate minibuffers now. ;;(or (boundp 'synchronize-minibuffers) ;; (defvar synchronize-minibuffers nil)) @@ -501,7 +520,7 @@ (goto-char (point-min)) (skip-chars-forward ediff-whitespace))) - + ;;; Commands for working with Ediff @@ -983,7 +1002,6 @@ (ediff-abbreviate-file-name file) (beep 1))) )))) - ;; checkout if visited file is checked in (defun ediff-maybe-checkout (buf) (let ((file (buffer-file-name buf)) @@ -1160,36 +1178,47 @@ (ediff-eval-in-buffer ctl-buf (setq ediff-window-B nil) ; force update of window config (ediff-recenter 'no-rehighlight))))) - + ;;;###autoload (defun ediff-toggle-multiframe () "Switch from the multiframe display to single-frame display and back. For a permanent change, set the variable `ediff-window-setup-function', which see." (interactive) - (let (set-func) - (or (ediff-window-display-p) - (error "%sEmacs is not running as a window application" - (if ediff-emacs-p "" "X"))) + (let (set-func window-setup-func) + (or (ediff-window-display-p) + (error "%sEmacs is not running as a window application" + (if ediff-emacs-p "" "X"))) - (setq set-func (if (ediff-in-control-buffer-p) 'setq 'setq-default)) + ;;(setq set-func (if (ediff-in-control-buffer-p) 'setq 'setq-default)) (cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe) - (eval - (list - set-func - 'ediff-window-setup-function ''ediff-setup-windows-plain))) + ;; (eval + ;; (list + ;; set-func + ;; 'ediff-window-setup-function ''ediff-setup-windows-plain)) + (setq window-setup-func 'ediff-setup-windows-plain) + ) ((eq ediff-window-setup-function 'ediff-setup-windows-plain) (if (ediff-in-control-buffer-p) (ediff-kill-bottom-toolbar)) - (eval - (list - set-func - 'ediff-window-setup-function ''ediff-setup-windows-multiframe)))) + ;;(eval + ;; (list + ;; set-func + ;; 'ediff-window-setup-function 'ediff-setup-windows-multiframe)) + (setq window-setup-func 'ediff-setup-windows-multiframe) + )) + + ;; change default + (setq-default ediff-window-setup-function window-setup-func) + ;; change in all active ediff sessions + (mapcar (function (lambda(buf) + (ediff-eval-in-buffer buf + (setq ediff-window-setup-function window-setup-func + ediff-window-B nil)))) + ediff-session-registry) (if (ediff-in-control-buffer-p) - (progn - (setq ediff-window-B nil) - (ediff-recenter 'no-rehighlight))))) + (ediff-recenter 'no-rehighlight)))) ;; if was using toolbar, kill it (defun ediff-kill-bottom-toolbar () @@ -1267,7 +1296,7 @@ (narrow-to-region (ediff-overlay-start overl-B) (ediff-overlay-end overl-B))) - (if ediff-3way-comparison-job + (if ediff-3way-job (ediff-eval-in-buffer ediff-buffer-C (narrow-to-region (ediff-overlay-start overl-C) (ediff-overlay-end overl-C)))) @@ -1517,6 +1546,7 @@ (+ ediff-current-difference arg))) regexp-skip) + (ediff-visible-region) (or (>= n ediff-number-of-differences) (setq regexp-skip (funcall ediff-skip-diff-region-function n)) (ediff-install-fine-diff-if-necessary n)) @@ -1553,6 +1583,7 @@ (let ((n (max -1 (- ediff-current-difference arg))) regexp-skip) + (ediff-visible-region) (or (< n 0) (setq regexp-skip (funcall ediff-skip-diff-region-function n)) (ediff-install-fine-diff-if-necessary n)) @@ -2320,9 +2351,10 @@ (ediff-kill-buffer-carefully ediff-fine-diff-buffer) (ediff-kill-buffer-carefully ediff-tmp-buffer) (ediff-kill-buffer-carefully ediff-error-buffer) - (ediff-kill-buffer-carefully ediff-patch-diagnostics) (ediff-kill-buffer-carefully ediff-msg-buffer) (ediff-kill-buffer-carefully ediff-debug-buffer) + (if (boundp 'ediff-patch-diagnostics) + (ediff-kill-buffer-carefully ediff-patch-diagnostics)) (if (and (ediff-window-display-p) (frame-live-p ctl-frame)) (delete-frame ctl-frame)) @@ -2446,8 +2478,9 @@ (buf-A-wind (ediff-get-visible-buffer-window buf-A)) (buf-B-wind (ediff-get-visible-buffer-window buf-B)) (buf-C-wind (ediff-get-visible-buffer-window buf-C)) - (buf-patch ediff-patchbufer) - (buf-patch-diag ediff-patch-diagnostics) + (buf-patch (if (boundp 'ediff-patchbufer) ediff-patchbufer nil)) + (buf-patch-diag (if (boundp 'ediff-patch-diagnostics) + ediff-patch-diagnostics nil)) (buf-err ediff-error-buffer) (buf-diff ediff-diff-buffer) (buf-custom-diff ediff-custom-diff-buffer) @@ -2468,20 +2501,28 @@ (select-window buf-A-wind) (delete-other-windows) (bury-buffer)) - (if (ediff-buffer-live-p buf-A) (bury-buffer buf-A))) + (if (ediff-buffer-live-p buf-A) + (progn + (set-buffer buf-A) + (bury-buffer)))) (if (window-live-p buf-B-wind) (progn (select-window buf-B-wind) (delete-other-windows) (bury-buffer)) - (if (ediff-buffer-live-p buf-B) (bury-buffer buf-B))) + (if (ediff-buffer-live-p buf-B) + (progn + (set-buffer buf-B) + (bury-buffer)))) (if (window-live-p buf-C-wind) (progn (select-window buf-C-wind) (delete-other-windows) (bury-buffer)) - (if (ediff-buffer-live-p buf-C) (bury-buffer buf-C))) - + (if (ediff-buffer-live-p buf-C) + (progn + (set-buffer buf-C) + (bury-buffer)))) )) @@ -2907,16 +2948,19 @@ (let ((answer "") (possibilities (list ?A ?B ?C)) (zmacs-regions t) + (ctl-buf (current-buffer)) quit-now begA begB endA endB bufA bufB) (cond ((ediff-merge-job) (setq bufB ediff-buffer-C) - (while (cond ((memq answer '(?A ?a)) - (setq bufA ediff-buffer-A) + (while (cond ((eq answer ?A) + (setq bufA ediff-buffer-A + possibilities '(?B)) nil) - ((memq answer '(?B ?b)) - (setq bufA ediff-buffer-B) + ((eq answer ?B) + (setq bufA ediff-buffer-B + possibilities '(?A)) nil) ((equal answer "")) (t (beep 1) @@ -2925,7 +2969,7 @@ t)) (let ((cursor-in-echo-area t)) (message "Which buffer to compare to the merge buffer (A/B)? ") - (setq answer (read-char-exclusive))))) + (setq answer (capitalize (read-char-exclusive)))))) ((ediff-3way-comparison-job) (while (cond ((memq answer possibilities) @@ -2965,7 +3009,8 @@ (setq answer (capitalize (read-char-exclusive)))))) (t ; 2way comparison (setq bufA ediff-buffer-A - bufB ediff-buffer-B))) + bufB ediff-buffer-B + possibilities nil))) (ediff-eval-in-buffer bufA (or (mark t) @@ -3011,8 +3056,21 @@ ) ;; (sit-for 0) + ;; At this point, possibilities contains either the window char A/B/C + ;; that was not selected, or it is nil. We delete the window that is not + ;; selected. + (if possibilities + (ediff-eval-in-buffer ctl-buf + (let* ((wind-to-delete (eval + (intern + (format + "ediff-window-%c" (car possibilities))))) + (frame (window-frame wind-to-delete))) + (delete-window wind-to-delete) + (select-frame frame) + (balance-windows)))) (or (y-or-n-p - "Please check the selected regions. Continue? ") + "Please check regions selected for comparison. Continue? ") (setq quit-now t)) (ediff-eval-in-buffer bufA @@ -3020,7 +3078,10 @@ (ediff-eval-in-buffer bufB (widen)) (if quit-now - (error "Thank you. Come back another day...")) + (ediff-eval-in-buffer ctl-buf + (ediff-recenter) + (sit-for 0) + (error "All right. Make up your mind and come back..."))) (ediff-regions-internal bufA begA endA bufB begB endB @@ -3028,8 +3089,8 @@ 'ediff-regions-linewise ; job name nil) ; no word mode )) - - + + (defun ediff-remove-flags-from-buffer (buffer overlay) (ediff-eval-in-buffer buffer @@ -3185,18 +3246,6 @@ (ediff-overlay-put overl 'ediff-diff-num 0) overl)))) -(defsubst ediff-overlay-start (overl) - (if (ediff-overlayp overl) - (if ediff-emacs-p - (overlay-start overl) - (extent-start-position overl)))) - -(defsubst ediff-overlay-end (overl) - (if (ediff-overlayp overl) - (if ediff-emacs-p - (overlay-end overl) - (extent-end-position overl)))) - ;; Like other-buffer, but prefers visible buffers and ignores temporary or ;; other insignificant buffers (those beginning with "^[ *]"). @@ -3595,6 +3644,4 @@ ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: -(provide 'ediff-util) - ;;; ediff-util.el ends here
--- a/lisp/ediff/ediff-vers.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-vers.el Mon Aug 13 09:06:37 2007 +0200 @@ -30,13 +30,13 @@ (defvar cvs-shell) (defvar cvs-program) (defvar cvs-cookie-handle) +(defvar ediff-temp-file-prefix) -(and noninteractive - (eval-when-compile - (load "pcl-cvs" 'noerror) - (load "rcs" 'noerror) - (load "generic-sc" 'noerror) - (load "vc" 'noerror))) +(eval-when-compile + (load "pcl-cvs" 'noerror) + (load "rcs" 'noerror) + (load "generic-sc" 'noerror) + (load "vc" 'noerror)) ;; end pacifier ;; VC.el support @@ -67,7 +67,7 @@ 'ediff-revision))) ;; RCS.el support -(defun ediff-rcs-view-revision (&optional rev) +(defun rcs-ediff-view-revision (&optional rev) ;; View previous RCS revision of current file. ;; With prefix argument, prompts for a revision name. (interactive (list (if current-prefix-arg
--- a/lisp/ediff/ediff-wind.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff-wind.el Mon Aug 13 09:06:37 2007 +0200 @@ -22,11 +22,8 @@ ;; Boston, MA 02111-1307, USA. ;;; Code: - -(require 'ediff-init) -;;(if ediff-xemacs-p -;; (nil) (require 'ediff-tbar) -(defun ediff-compute-toolbar-width () 0) + +(provide 'ediff-wind) ;; Compiler pacifier (defvar icon-title-format) @@ -38,8 +35,31 @@ (defvar right-toolbar-width) (defvar default-menubar) (defvar frame-icon-title-format) +(defvar ediff-diff-status) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-help) + (load "ediff-help.el" nil nil 'nosuffix)) + (or (featurep 'ediff-util) + (load "ediff-util.el" nil nil 'nosuffix)) + (or (featurep 'ediff-tbar) + (load "ediff-tbar.el" 'noerror nil 'nosuffix)) + )) ;; end pacifier +(require 'ediff-init) + +;; be careful with ediff-tbar +(if ediff-xemacs-p + (condition-case nil + (require 'ediff-tbar) + (error + (defun ediff-compute-toolbar-width () 0))) + (defun ediff-compute-toolbar-width () 0)) + (defvar ediff-window-setup-function (if (ediff-window-display-p) 'ediff-setup-windows-multiframe @@ -895,7 +915,7 @@ (modify-frame-parameters ctl-frame adjusted-parameters) (make-frame-visible ctl-frame) (ediff-make-bottom-toolbar) ; no effect if the toolbar is not requested - + ;; This works around a bug in 19.25 and earlier. There, if frame gets ;; iconified, the current buffer changes to that of the frame that ;; becomes exposed as a result of this iconification. @@ -1204,7 +1224,4 @@ ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: -(provide 'ediff-wind) - - ;;; ediff-wind.el ends here
--- a/lisp/ediff/ediff.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/ediff/ediff.el Mon Aug 13 09:06:37 2007 +0200 @@ -6,8 +6,8 @@ ;; Created: February 2, 1994 ;; Keywords: comparing, merging, patching, version control. -(defconst ediff-version "2.63" "The current version of Ediff") -(defconst ediff-date "September 12, 1996" "Date of last update") +(defconst ediff-version "2.64" "The current version of Ediff") +(defconst ediff-date "January 3, 1997" "Date of last update") ;; This file is part of GNU Emacs. @@ -106,17 +106,26 @@ ;;; Code: -(require 'ediff-init) -;; ediff-mult is always required, because of the registry stuff -(require 'ediff-mult) +(provide 'ediff) -(and noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (load-library "dired") - (load-file "ediff-ptch.el") - (load-file "ediff-vers.el") - (load "pcl-cvs" 'noerror)))) +;; Compiler pacifier +(eval-when-compile + (let ((load-path (cons "." load-path))) + (load "dired") + (or (featurep 'ediff-init) + (load "ediff-init.el" nil nil 'nosuffix)) + (or (featurep 'ediff-mult) + (load "ediff-mult.el" nil nil 'nosuffix)) + (or (featurep 'ediff-ptch) + (load "ediff-ptch.el" nil nil 'nosuffix)) + (or (featurep 'ediff-vers) + (load "ediff-vers.el" nil nil 'nosuffix)) + (load "pcl-cvs" 'noerror) + )) +;; end pacifier + +(require 'ediff-init) +(require 'ediff-mult) ; required because of the registry stuff (defvar ediff-use-last-dir nil "*If t, Ediff uses previous directory as default when reading file name.") @@ -693,7 +702,7 @@ (or (y-or-n-p "Directory for saving merges is the same as directory A. Sure? ") (error "Merge of directory revisions aborted"))) - + (setq file-list (ediff-get-directory-files-under-revision jobname regexp dir1 merge-autostore-dir)) @@ -1101,7 +1110,7 @@ ;;;###autoload (defun ediff-merge-revisions-with-ancestor (&optional file startup-hooks) "Run Ediff by merging two revisions of a file with a common ancestor. -The file is the optional FILE argument or the file visited by the current +The file is the the optional FILE argument or the file visited by the current buffer." (interactive) (if (stringp file) (find-file file)) @@ -1273,7 +1282,6 @@ ;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body)) ;;; End: -(provide 'ediff) (require 'ediff-util) ;;; ediff.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/games/decipher.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,1051 @@ +;;; decipher.el --- Cryptanalyze monoalphabetic substitution ciphers +;; +;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. +;; +;; Author: Christopher J. Madsen <ac608@yfn.ysu.edu> +;; Keywords: games +;; +;; 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. + +;;; Quick Start: +;; +;; To decipher a message, type or load it into a buffer and type +;; `M-x decipher'. This will format the buffer and place it into +;; Decipher mode. You can save your work to a file with the normal +;; Emacs save commands; when you reload the file it will automatically +;; enter Decipher mode. +;; +;; I'm not going to discuss how to go about breaking a cipher; try +;; your local library for a book on cryptanalysis. One book you might +;; find is: +;; Cryptanalysis: A study of ciphers and their solution +;; Helen Fouche Gaines +;; ISBN 0-486-20097-3 + +;;; Commentary: +;; +;; This package is designed to help you crack simple substitution +;; ciphers where one letter stands for another. It works for ciphers +;; with or without word divisions. (You must set the variable +;; decipher-ignore-spaces for ciphers without word divisions.) +;; +;; First, some quick definitions: +;; ciphertext The encrypted message (what you start with) +;; plaintext The decrypted message (what you are trying to get) +;; +;; Decipher mode displays ciphertext in uppercase and plaintext in +;; lowercase. You must enter the plaintext in lowercase; uppercase +;; letters are interpreted as commands. The ciphertext may be entered +;; in mixed case; `M-x decipher' will convert it to uppercase. +;; +;; Decipher mode depends on special characters in the first column of +;; each line. The command `M-x decipher' inserts these characters for +;; you. The characters and their meanings are: +;; ( The plaintext & ciphertext alphabets on the first line +;; ) The ciphertext & plaintext alphabets on the second line +;; : A line of ciphertext (with plaintext below) +;; > A line of plaintext (with ciphertext above) +;; % A comment +;; Each line in the buffer MUST begin with one of these characters (or +;; be left blank). In addition, comments beginning with `%!' are reserved +;; for checkpoints; see decipher-make-checkpoint & decipher-restore-checkpoint +;; for more information. +;; +;; While the cipher message may contain digits or punctuation, Decipher +;; mode will ignore these characters. +;; +;; The buffer is made read-only so it can't be modified by normal +;; Emacs commands. +;; +;; Decipher supports Font Lock mode. To use it, you can also add +;; (add-hook 'decipher-mode-hook 'turn-on-font-lock) +;; See the variable `decipher-font-lock-keywords' if you want to customize +;; the faces used. I'd like to thank Simon Marshall for his help in making +;; Decipher work well with Font Lock. + +;;; Things To Do: +;; +;; Email me if you have any suggestions or would like to help. +;; But be aware that I work on Decipher only sporadically. +;; +;; 1. The consonant-line shortcut +;; 2. More functions for analyzing ciphertext + +;;;=================================================================== +;;; Variables: +;;;=================================================================== + +(eval-when-compile + (require 'cl)) + +(defvar decipher-force-uppercase t + "*Non-nil means to convert ciphertext to uppercase. +Nil means the case of the ciphertext is preserved. +This variable must be set before typing `\\[decipher]'.") + +(defvar decipher-ignore-spaces nil + "*Non-nil means to ignore spaces and punctuation when counting digrams. +You should set this to `nil' if the cipher message is divided into words, +or `t' if it is not. +This variable is buffer-local.") +(make-variable-buffer-local 'decipher-ignore-spaces) + +(defvar decipher-undo-limit 5000 + "The maximum number of entries in the undo list. +When the undo list exceeds this number, 100 entries are deleted from +the tail of the list.") + +;; End of user modifiable variables +;;-------------------------------------------------------------------- + +(defvar decipher-font-lock-keywords + '(("^:.*" . font-lock-keyword-face) + ("^>.*" . font-lock-string-face) + ("^%!.*" . font-lock-reference-face) + ("^%.*" . font-lock-comment-face) + ("\\`(\\([a-z]+\\) +\\([A-Z]+\\)" + (1 font-lock-string-face) + (2 font-lock-keyword-face)) + ("^)\\([A-Z ]+\\)\\([a-z ]+\\)" + (1 font-lock-keyword-face) + (2 font-lock-string-face))) + "Expressions to fontify in Decipher mode. +Ciphertext uses `font-lock-keyword-face', plaintext uses +`font-lock-string-face', comments use `font-lock-comment-face', and +checkpoints use `font-lock-reference-face'. You can customize the +display by changing these variables. For best results, I recommend +that all faces use the same background color. +For example, to display ciphertext in the `bold' face, use + (add-hook 'decipher-mode-hook + (lambda () (set (make-local-variable 'font-lock-keyword-face) + 'bold))) +in your `.emacs' file.") + +(defvar decipher-mode-map nil + "Keymap for Decipher mode.") +(if (not decipher-mode-map) + (progn + (setq decipher-mode-map (make-keymap)) + (suppress-keymap decipher-mode-map) + (define-key decipher-mode-map "A" 'decipher-show-alphabet) + (define-key decipher-mode-map "C" 'decipher-complete-alphabet) + (define-key decipher-mode-map "D" 'decipher-digram-list) + (define-key decipher-mode-map "F" 'decipher-frequency-count) + (define-key decipher-mode-map "M" 'decipher-make-checkpoint) + (define-key decipher-mode-map "N" 'decipher-adjacency-list) + (define-key decipher-mode-map "R" 'decipher-restore-checkpoint) + (define-key decipher-mode-map "U" 'decipher-undo) + (define-key decipher-mode-map " " 'decipher-keypress) + (substitute-key-definition 'undo 'decipher-undo + decipher-mode-map global-map) + (substitute-key-definition 'advertised-undo 'decipher-undo + decipher-mode-map global-map) + (let ((key ?a)) + (while (<= key ?z) + (define-key decipher-mode-map (vector key) 'decipher-keypress) + (incf key))))) + +(defvar decipher-stats-mode-map nil + "Keymap for Decipher-Stats mode.") +(if (not decipher-stats-mode-map) + (progn + (setq decipher-stats-mode-map (make-keymap)) + (suppress-keymap decipher-stats-mode-map) + (define-key decipher-stats-mode-map "D" 'decipher-digram-list) + (define-key decipher-stats-mode-map "F" 'decipher-frequency-count) + (define-key decipher-stats-mode-map "N" 'decipher-adjacency-list) + )) + +(defvar decipher-mode-syntax-table nil + "Decipher mode syntax table") + +(if decipher-mode-syntax-table + () + (let ((table (make-syntax-table)) + (c ?0)) + (while (<= c ?9) + (modify-syntax-entry c "_" table) ;Digits are not part of words + (incf c)) + (setq decipher-mode-syntax-table table))) + +(defvar decipher-alphabet nil) +;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR), +;; where PLAIN-CHAR runs from ?a to ?z and CIPHER-CHAR is an uppercase +;; letter or space (which means no mapping is known for that letter). +;; This *must* contain entries for all lowercase characters. +(make-variable-buffer-local 'decipher-alphabet) + +(defvar decipher-stats-buffer nil + "The buffer which displays statistics for this ciphertext. +Do not access this variable directly, use the function +`decipher-stats-buffer' instead.") +(make-variable-buffer-local 'decipher-stats-buffer) + +(defvar decipher-undo-list-size 0 + "The number of entries in the undo list.") +(make-variable-buffer-local 'decipher-undo-list-size) + +(defvar decipher-undo-list nil + "The undo list for this buffer. +Each element is either a cons cell (PLAIN-CHAR . CIPHER-CHAR) or a +list of such cons cells.") +(make-variable-buffer-local 'decipher-undo-list) + +(defvar decipher-pending-undo-list nil) + +;; The following variables are used by the analysis functions +;; and are defined here to avoid byte-compiler warnings. +;; Don't mess with them unless you know what you're doing. +(defvar decipher-char nil + "See the functions decipher-loop-with-breaks and decipher-loop-no-breaks.") +(defvar decipher--prev-char) +(defvar decipher--digram) +(defvar decipher--digram-list) +(defvar decipher--before) +(defvar decipher--after) +(defvar decipher--freqs) + +;;;=================================================================== +;;; Code: +;;;=================================================================== +;; Main entry points: +;;-------------------------------------------------------------------- + +;;;###autoload +(defun decipher () + "Format a buffer of ciphertext for cryptanalysis and enter Decipher mode." + (interactive) + ;; Make sure the buffer ends in a newline: + (goto-char (point-max)) + (or (bolp) + (insert "\n")) + ;; See if it's already in decipher format: + (goto-char (point-min)) + (if (looking-at "^(abcdefghijklmnopqrstuvwxyz \ +ABCDEFGHIJKLMNOPQRSTUVWXYZ -\\*-decipher-\\*-\n)") + (message "Buffer is already formatted, entering Decipher mode...") + ;; Add the alphabet at the beginning of the file + (insert "(abcdefghijklmnopqrstuvwxyz \ +ABCDEFGHIJKLMNOPQRSTUVWXYZ -*-decipher-*-\n)\n\n") + ;; Add lines for the solution: + (let (begin) + (while (not (eobp)) + (if (looking-at "^%") + (forward-line) ;Leave comments alone + (delete-horizontal-space) + (if (eolp) + (forward-line) ;Just leave blank lines alone + (insert ":") ;Mark ciphertext line + (setq begin (point)) + (forward-line) + (if decipher-force-uppercase + (upcase-region begin (point))) ;Convert ciphertext to uppercase + (insert ">\n"))))) ;Mark plaintext line + (delete-blank-lines) ;Remove any blank lines + (delete-blank-lines)) ; at end of buffer + (goto-line 4) + (decipher-mode)) + +;;;###autoload +(defun decipher-mode () + "Major mode for decrypting monoalphabetic substitution ciphers. +Lower-case letters enter plaintext. +Upper-case letters are commands. + +The buffer is made read-only so that normal Emacs commands cannot +modify it. + +The most useful commands are: +\\<decipher-mode-map> +\\[decipher-digram-list] Display a list of all digrams & their frequency +\\[decipher-frequency-count] Display the frequency of each ciphertext letter +\\[decipher-adjacency-list]\ + Show adjacency list for current letter (lists letters appearing next to it) +\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint) +\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" + (interactive) + (kill-all-local-variables) + (setq buffer-undo-list t ;Disable undo + indent-tabs-mode nil ;Do not use tab characters + major-mode 'decipher-mode + mode-name "Decipher") + (if decipher-force-uppercase + (setq case-fold-search nil)) ;Case is significant when searching + (use-local-map decipher-mode-map) + (set-syntax-table decipher-mode-syntax-table) + (decipher-read-alphabet) + (set (make-local-variable 'font-lock-defaults) + '(decipher-font-lock-keywords t)) + ;; Make the buffer writable when we exit Decipher mode: + (make-local-hook 'change-major-mode-hook) + (add-hook 'change-major-mode-hook + (lambda () (setq buffer-read-only nil + buffer-undo-list nil)) + nil t) + (run-hooks 'decipher-mode-hook) + (setq buffer-read-only t)) +(put 'decipher-mode 'mode-class 'special) + +;;-------------------------------------------------------------------- +;; Normal key handling: +;;-------------------------------------------------------------------- + +(defmacro decipher-last-command-char () + ;; Return the char which ran this command (for compatibility with XEmacs) + (if (fboundp 'event-to-character) + '(event-to-character last-command-event) + 'last-command-event)) + +(defun decipher-keypress () + "Enter a plaintext or ciphertext character." + (interactive) + (let ((decipher-function 'decipher-set-map) + buffer-read-only) ;Make buffer writable + (save-excursion + (or (save-excursion + (beginning-of-line) + (let ((first-char (following-char))) + (cond + ((= ?: first-char) + t) + ((= ?> first-char) + nil) + ((= ?\( first-char) + (setq decipher-function 'decipher-alphabet-keypress) + t) + ((= ?\) first-char) + (setq decipher-function 'decipher-alphabet-keypress) + nil) + (t + (error "Bad location"))))) + (let (goal-column) + (previous-line 1))) + (let ((char-a (following-char)) + (char-b (decipher-last-command-char))) + (or (and (not (= ?w (char-syntax char-a))) + (= char-b ?\ )) ;Spacebar just advances on non-letters + (funcall decipher-function char-a char-b))))) + (forward-char)) + +(defun decipher-alphabet-keypress (a b) + ;; Handle keypresses in the alphabet lines. + ;; A is the character in the alphabet row (which starts with '(') + ;; B is the character pressed + (cond ((and (>= a ?A) (<= a ?Z)) + ;; If A is uppercase, then it is in the ciphertext alphabet: + (decipher-set-map a b)) + ((and (>= a ?a) (<= a ?z)) + ;; If A is lowercase, then it is in the plaintext alphabet: + (if (= b ?\ ) + ;; We are clearing the association (if any): + (if (/= ?\ (setq b (cdr (assoc a decipher-alphabet)))) + (decipher-set-map b ?\ )) + ;; Associate the plaintext char with the char pressed: + (decipher-set-map b a))) + (t + ;; If A is not a letter, that's a problem: + (error "Bad character")))) + +;;-------------------------------------------------------------------- +;; Undo: +;;-------------------------------------------------------------------- + +(defun decipher-undo () + "Undo a change in Decipher mode." + (interactive) + ;; If we don't get all the way thru, make last-command indicate that + ;; for the following command. + (setq this-command t) + (or (eq major-mode 'decipher-mode) + (error "This buffer is not in Decipher mode")) + (or (eq last-command 'decipher-undo) + (setq decipher-pending-undo-list decipher-undo-list)) + (or decipher-pending-undo-list + (error "No further undo information")) + (let ((undo-rec (pop decipher-pending-undo-list)) + buffer-read-only ;Make buffer writable + redo-map redo-rec undo-map) + (or (consp (car undo-rec)) + (setq undo-rec (list undo-rec))) + (while (setq undo-map (pop undo-rec)) + (setq redo-map (decipher-get-undo (cdr undo-map) (car undo-map))) + (if redo-map + (setq redo-rec + (if (consp (car redo-map)) + (append redo-map redo-rec) + (cons redo-map redo-rec)))) + (decipher-set-map (cdr undo-map) (car undo-map) t)) + (decipher-add-undo redo-rec)) + (setq this-command 'decipher-undo) + (message "Undo!")) + +(defun decipher-add-undo (undo-rec) + "Add UNDO-REC to the undo list." + (if undo-rec + (progn + (push undo-rec decipher-undo-list) + (incf decipher-undo-list-size) + (if (> decipher-undo-list-size decipher-undo-limit) + (let ((new-size (- decipher-undo-limit 100))) + ;; Truncate undo list to NEW-SIZE elements: + (setcdr (nthcdr (1- new-size) decipher-undo-list) nil) + (setq decipher-undo-list-size new-size)))))) + +(defun decipher-get-undo (cipher-char plain-char) + ;; Return an undo record that will undo the result of + ;; (decipher-set-map CIPHER-CHAR PLAIN-CHAR) + ;; We must use copy-list because the original cons cells will be + ;; modified using setcdr. + (let ((cipher-map (copy-list (rassoc cipher-char decipher-alphabet))) + (plain-map (copy-list (assoc plain-char decipher-alphabet)))) + (cond ((equal ?\ plain-char) + cipher-map) + ((equal cipher-char (cdr plain-map)) + nil) ;We aren't changing anything + ((equal ?\ (cdr plain-map)) + (or cipher-map (cons ?\ cipher-char))) + (cipher-map + (list plain-map cipher-map)) + (t + plain-map)))) + +;;-------------------------------------------------------------------- +;; Mapping ciphertext and plaintext: +;;-------------------------------------------------------------------- + +(defun decipher-set-map (cipher-char plain-char &optional no-undo) + ;; Associate a ciphertext letter with a plaintext letter + ;; CIPHER-CHAR must be an uppercase or lowercase letter + ;; PLAIN-CHAR must be a lowercase letter (or a space) + ;; NO-UNDO if non-nil means do not record undo information + ;; Any existing associations for CIPHER-CHAR or PLAIN-CHAR will be erased. + (setq cipher-char (upcase cipher-char)) + (or (and (>= cipher-char ?A) (<= cipher-char ?Z)) + (error "Bad character")) ;Cipher char must be uppercase letter + (or no-undo + (decipher-add-undo (decipher-get-undo cipher-char plain-char))) + (let ((cipher-string (char-to-string cipher-char)) + (plain-string (char-to-string plain-char)) + case-fold-search ;Case is significant + mapping bound) + (save-excursion + (goto-char (point-min)) + (if (setq mapping (rassoc cipher-char decipher-alphabet)) + (progn + (setcdr mapping ?\ ) + (search-forward-regexp (concat "^([a-z]*" + (char-to-string (car mapping)))) + (decipher-insert ?\ ) + (beginning-of-line))) + (if (setq mapping (assoc plain-char decipher-alphabet)) + (progn + (if (/= ?\ (cdr mapping)) + (decipher-set-map (cdr mapping) ?\ t)) + (setcdr mapping cipher-char) + (search-forward-regexp (concat "^([a-z]*" plain-string)) + (decipher-insert cipher-char) + (beginning-of-line))) + (search-forward-regexp (concat "^([a-z]+ [A-Z]*" cipher-string)) + (decipher-insert plain-char) + (setq case-fold-search t ;Case is not significant + cipher-string (downcase cipher-string)) + (let ((font-lock-fontify-region-function 'ignore)) + ;; insert-and-inherit will pick the right face automatically + (while (search-forward-regexp "^:" nil t) + (setq bound (save-excursion (end-of-line) (point))) + (while (search-forward cipher-string bound 'end) + (decipher-insert plain-char))))))) + +(defun decipher-insert (char) + ;; Insert CHAR in the row below point. It replaces any existing + ;; character in that position. + (let ((col (1- (current-column)))) + (save-excursion + (forward-line) + (or (= ?\> (following-char)) + (= ?\) (following-char)) + (error "Bad location")) + (move-to-column col t) + (or (eolp) + (delete-char 1)) + (insert-and-inherit char)))) + +;;-------------------------------------------------------------------- +;; Checkpoints: +;;-------------------------------------------------------------------- +;; A checkpoint is a comment of the form: +;; %!ABCDEFGHIJKLMNOPQRSTUVWXYZ! Description +;; Such comments are usually placed at the end of the buffer following +;; this header (which is inserted by decipher-make-checkpoint): +;; %--------------------------- +;; % Checkpoints: +;; % abcdefghijklmnopqrstuvwxyz +;; but this is not required; checkpoints can be placed anywhere. +;; +;; The description is optional; all that is required is the alphabet. + +(defun decipher-make-checkpoint (desc) + "Checkpoint the current cipher alphabet. +This records the current alphabet so you can return to it later. +You may have any number of checkpoints. +Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." + (interactive "sCheckpoint description: ") + (or (stringp desc) + (setq desc "")) + (let (alphabet + buffer-read-only ;Make buffer writable + mapping) + (goto-char (point-min)) + (re-search-forward "^)") + (move-to-column 27 t) + (setq alphabet (buffer-substring-no-properties (- (point) 26) (point))) + (if (re-search-forward "^%![A-Z ]+!" nil 'end) + nil ; Add new checkpoint with others + (if (re-search-backward "^% *Local Variables:" nil t) + ;; Add checkpoints before local variables list: + (progn (forward-line -1) + (or (looking-at "^ *$") + (progn (forward-line) (insert ?\n) (forward-line -1))))) + (insert "\n%" (make-string 69 ?\-) + "\n% Checkpoints:\n% abcdefghijklmnopqrstuvwxyz\n")) + (beginning-of-line) + (insert "%!" alphabet "! " desc ?\n))) + +(defun decipher-restore-checkpoint () + "Restore the cipher alphabet from a checkpoint. +If point is not on a checkpoint line, moves to the first checkpoint line. +If point is on a checkpoint, restores that checkpoint. + +Type `\\[decipher-make-checkpoint]' to make a checkpoint." + (interactive) + (beginning-of-line) + (if (looking-at "%!\\([A-Z ]+\\)!") + ;; Restore this checkpoint: + (let ((alphabet (match-string 1)) + buffer-read-only) ;Make buffer writable + (goto-char (point-min)) + (re-search-forward "^)") + (or (eolp) + (delete-region (point) (progn (end-of-line) (point)))) + (insert alphabet) + (decipher-resync)) + ;; Move to the first checkpoint: + (goto-char (point-min)) + (if (re-search-forward "^%![A-Z ]+!" nil t) + (message "Select the checkpoint to restore and type `%s'" + (substitute-command-keys "\\[decipher-restore-checkpoint]")) + (error "No checkpoints in this buffer")))) + +;;-------------------------------------------------------------------- +;; Miscellaneous commands: +;;-------------------------------------------------------------------- + +(defun decipher-complete-alphabet () + "Complete the cipher alphabet. +This fills any blanks in the cipher alphabet with the unused letters +in alphabetical order. Use this when you have a keyword cipher and +you have determined the keyword." + (interactive) + (let ((cipher-char ?A) + (ptr decipher-alphabet) + buffer-read-only ;Make buffer writable + plain-map undo-rec) + (while (setq plain-map (pop ptr)) + (if (equal ?\ (cdr plain-map)) + (progn + (while (rassoc cipher-char decipher-alphabet) + ;; Find the next unused letter + (incf cipher-char)) + (push (cons ?\ cipher-char) undo-rec) + (decipher-set-map cipher-char (car plain-map) t)))) + (decipher-add-undo undo-rec))) + +(defun decipher-show-alphabet () + "Display the current cipher alphabet in the message line." + (interactive) + (message + (mapconcat (lambda (a) + (concat + (char-to-string (car a)) + (char-to-string (cdr a)))) + decipher-alphabet + ""))) + +(defun decipher-resync () + "Reprocess the buffer using the alphabet from the top. +This regenerates all deciphered plaintext and clears the undo list. +You should use this if you edit the ciphertext." + (interactive) + (message "Reprocessing buffer...") + (let (alphabet + buffer-read-only ;Make buffer writable + mapping) + (save-excursion + (decipher-read-alphabet) + (setq alphabet decipher-alphabet) + (goto-char (point-min)) + (and (re-search-forward "^).+" nil t) + (replace-match ")" nil nil)) + (while (re-search-forward "^>.+" nil t) + (replace-match ">" nil nil)) + (decipher-read-alphabet) + (while (setq mapping (pop alphabet)) + (or (equal ?\ (cdr mapping)) + (decipher-set-map (cdr mapping) (car mapping)))))) + (setq decipher-undo-list nil + decipher-undo-list-size 0) + (message "Reprocessing buffer...done")) + +;;-------------------------------------------------------------------- +;; Miscellaneous functions: +;;-------------------------------------------------------------------- + +(defun decipher-read-alphabet () + "Build the decipher-alphabet from the alphabet line in the buffer." + (save-excursion + (goto-char (point-min)) + (search-forward-regexp "^)") + (move-to-column 27 t) + (setq decipher-alphabet nil) + (let ((plain-char ?z)) + (while (>= plain-char ?a) + (backward-char) + (push (cons plain-char (following-char)) decipher-alphabet) + (decf plain-char))))) + +;;;=================================================================== +;;; Analyzing ciphertext: +;;;=================================================================== + +(defun decipher-frequency-count () + "Display the frequency count in the statistics buffer." + (interactive) + (decipher-analyze) + (decipher-display-regexp "^A" "^[A-Z][A-Z]")) + +(defun decipher-digram-list () + "Display the list of digrams in the statistics buffer." + (interactive) + (decipher-analyze) + (decipher-display-regexp "[A-Z][A-Z] +[0-9]" "^$")) + +(defun decipher-adjacency-list (cipher-char) + "Display the adjacency list for the letter at point. +The adjacency list shows all letters which come next to CIPHER-CHAR. + +An adjacency list (for the letter X) looks like this: + 1 1 1 1 1 3 2 1 3 8 +X: 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 * 11 14 9% + 1 1 1 2 1 1 2 5 7 +This says that X comes before D once, and after B once. X begins 5 +words, and ends 3 words (`*' represents a space). X comes before 8 +different letters, after 7 differerent letters, and is next to a total +of 11 different letters. It occurs 14 times, making up 9% of the +ciphertext." + (interactive (list (upcase (following-char)))) + (decipher-analyze) + (let (start end) + (save-excursion + (set-buffer (decipher-stats-buffer)) + (goto-char (point-min)) + (or (re-search-forward (format "^%c: " cipher-char) nil t) + (error "Character `%c' is not used in ciphertext." cipher-char)) + (forward-line -1) + (setq start (point)) + (forward-line 3) + (setq end (point))) + (decipher-display-range start end))) + +;;-------------------------------------------------------------------- +(defun decipher-analyze () + "Perform frequency analysis on the current buffer if necessary." + (cond + ;; If this is the statistics buffer, do nothing: + ((eq major-mode 'decipher-stats-mode)) + ;; If this is the Decipher buffer, see if the stats buffer exists: + ((eq major-mode 'decipher-mode) + (or (and (bufferp decipher-stats-buffer) + (buffer-name decipher-stats-buffer)) + (decipher-analyze-buffer))) + ;; Otherwise: + (t (error "This buffer is not in Decipher mode")))) + +;;-------------------------------------------------------------------- +(defun decipher-display-range (start end) + "Display text between START and END in the statistics buffer. +START and END are positions in the statistics buffer. Makes the +statistics buffer visible and sizes the window to just fit the +displayed text, but leaves the current window selected." + (let ((stats-buffer (decipher-stats-buffer)) + (current-window (selected-window)) + (pop-up-windows t)) + (or (eq (current-buffer) stats-buffer) + (pop-to-buffer stats-buffer)) + (goto-char start) + (or (one-window-p t) + (enlarge-window (- (1+ (count-lines start end)) (window-height)))) + (recenter 0) + (select-window current-window))) + +(defun decipher-display-regexp (start-regexp end-regexp) + "Display text between two regexps in the statistics buffer. + +START-REGEXP matches the first line to display. +END-REGEXP matches the line after that which ends the display. +The ending line is included in the display unless it is blank." + (let (start end) + (save-excursion + (set-buffer (decipher-stats-buffer)) + (goto-char (point-min)) + (re-search-forward start-regexp) + (beginning-of-line) + (setq start (point)) + (re-search-forward end-regexp) + (beginning-of-line) + (or (looking-at "^ *$") + (forward-line 1)) + (setq end (point))) + (decipher-display-range start end))) + +;;-------------------------------------------------------------------- +(defun decipher-loop-with-breaks (func) + "Loop through ciphertext, calling FUNC once for each letter & word division. + +FUNC is called with no arguments, and its return value is unimportant. +It may examine `decipher-char' to see the current ciphertext +character. `decipher-char' contains either an uppercase letter or a space. + +FUNC is called exactly once between words, with `decipher-char' set to +a space. + +See `decipher-loop-no-breaks' if you do not care about word divisions." + (let ((decipher-char ?\ ) + (decipher--loop-prev-char ?\ )) + (save-excursion + (goto-char (point-min)) + (funcall func) ;Space marks beginning of first word + (while (search-forward-regexp "^:" nil t) + (while (not (eolp)) + (setq decipher-char (upcase (following-char))) + (or (and (>= decipher-char ?A) (<= decipher-char ?Z)) + (setq decipher-char ?\ )) + (or (and (equal decipher-char ?\ ) + (equal decipher--loop-prev-char ?\ )) + (funcall func)) + (setq decipher--loop-prev-char decipher-char) + (forward-char)) + (or (equal decipher-char ?\ ) + (progn + (setq decipher-char ?\ ; + decipher--loop-prev-char ?\ ) + (funcall func))))))) + +(defun decipher-loop-no-breaks (func) + "Loop through ciphertext, calling FUNC once for each letter. + +FUNC is called with no arguments, and its return value is unimportant. +It may examine `decipher-char' to see the current ciphertext letter. +`decipher-char' contains an uppercase letter. + +Punctuation and spacing in the ciphertext are ignored. +See `decipher-loop-with-breaks' if you care about word divisions." + (let (decipher-char) + (save-excursion + (goto-char (point-min)) + (while (search-forward-regexp "^:" nil t) + (while (not (eolp)) + (setq decipher-char (upcase (following-char))) + (and (>= decipher-char ?A) + (<= decipher-char ?Z) + (funcall func)) + (forward-char)))))) + +;;-------------------------------------------------------------------- +;; Perform the analysis: +;;-------------------------------------------------------------------- + +(defun decipher-insert-frequency-counts (freq-list total) + "Insert frequency counts in current buffer. +Each element of FREQ-LIST is a list (LETTER FREQ ...). +TOTAL is the total number of letters in the ciphertext." + (let ((i 4) temp-list) + (while (> i 0) + (setq temp-list freq-list) + (while temp-list + (insert (caar temp-list) + (format "%4d%3d%% " + (cadar temp-list) + (/ (* 100 (cadar temp-list)) total))) + (setq temp-list (nthcdr 4 temp-list))) + (insert ?\n) + (setq freq-list (cdr freq-list) + i (1- i))))) + +(defun decipher--analyze () + ;; Perform frequency analysis on ciphertext. + ;; + ;; This function is called repeatedly with decipher-char set to each + ;; character of ciphertext. It uses decipher--prev-char to remember + ;; the previous ciphertext character. + ;; + ;; It builds several data structures, which must be initialized + ;; before the first call to decipher--analyze. The arrays are + ;; indexed with A = 0, B = 1, ..., Z = 25, SPC = 26 (if used). + ;; decipher--after: (initialize to zeros) + ;; A vector of 26 vectors of 27 integers. The first vector + ;; represents the number of times A follows each character, the + ;; second vector represents B, and so on. + ;; decipher--before: (initialize to zeros) + ;; The same as decipher--after, but representing the number of + ;; times the character precedes each other character. + ;; decipher--digram-list: (initialize to nil) + ;; An alist with an entry for each digram (2-character sequence) + ;; encountered. Each element is a cons cell (DIGRAM . FREQ), + ;; where DIGRAM is a 2 character string and FREQ is the number + ;; of times it occurs. + ;; decipher--freqs: (initialize to zeros) + ;; A vector of 26 integers, counting the number of occurrences + ;; of the corresponding characters. + (setq decipher--digram (format "%c%c" decipher--prev-char decipher-char)) + (incf (cdr (or (assoc decipher--digram decipher--digram-list) + (car (push (cons decipher--digram 0) + decipher--digram-list))))) + (and (>= decipher--prev-char ?A) + (incf (aref (aref decipher--before (- decipher--prev-char ?A)) + (if (equal decipher-char ?\ ) + 26 + (- decipher-char ?A))))) + (and (>= decipher-char ?A) + (incf (aref decipher--freqs (- decipher-char ?A))) + (incf (aref (aref decipher--after (- decipher-char ?A)) + (if (equal decipher--prev-char ?\ ) + 26 + (- decipher--prev-char ?A))))) + (setq decipher--prev-char decipher-char)) + +(defun decipher--digram-counts (counts) + "Generate the counts for an adjacency list." + (let ((total 0)) + (concat + (mapconcat (lambda (x) + (cond ((> x 99) (incf total) "XX") + ((> x 0) (incf total) (format "%2d" x)) + (t " "))) + counts + "") + (format "%4d" (if (> (aref counts 26) 0) + (1- total) ;Don't count space + total))))) + +(defun decipher--digram-total (before-count after-count) + "Count the number of different letters a letter appears next to." + ;; We do not include spaces (word divisions) in this count. + (let ((total 0) + (i 26)) + (while (>= (decf i) 0) + (if (or (> (aref before-count i) 0) + (> (aref after-count i) 0)) + (incf total))) + total)) + +(defun decipher-analyze-buffer () + "Perform frequency analysis and store results in statistics buffer. +Creates the statistics buffer if it doesn't exist." + (let ((decipher--prev-char (if decipher-ignore-spaces ?\ ?\*)) + (decipher--before (make-vector 26 nil)) + (decipher--after (make-vector 26 nil)) + (decipher--freqs (make-vector 26 0)) + (total-chars 0) + decipher--digram decipher--digram-list freq-list) + (message "Scanning buffer...") + (let ((i 26)) + (while (>= (decf i) 0) + (aset decipher--before i (make-vector 27 0)) + (aset decipher--after i (make-vector 27 0)))) + (if decipher-ignore-spaces + (progn + (decipher-loop-no-breaks 'decipher--analyze) + ;; The first character of ciphertext was marked as following a space: + (let ((i 26)) + (while (>= (decf i) 0) + (aset (aref decipher--after i) 26 0)))) + (decipher-loop-with-breaks 'decipher--analyze)) + (message "Processing results...") + (setcdr (last decipher--digram-list 2) nil) ;Delete the phony "* " digram + ;; Sort the digram list by frequency and alphabetical order: + (setq decipher--digram-list (sort (sort decipher--digram-list + (lambda (a b) (string< (car a) (car b)))) + (lambda (a b) (> (cdr a) (cdr b))))) + ;; Generate the frequency list: + ;; Each element is a list of 3 elements (LETTER FREQ DIFFERENT), + ;; where LETTER is the ciphertext character, FREQ is the number + ;; of times it occurs, and DIFFERENT is the number of different + ;; letters it appears next to. + (let ((i 26)) + (while (>= (decf i) 0) + (setq freq-list + (cons (list (+ i ?A) + (aref decipher--freqs i) + (decipher--digram-total (aref decipher--before i) + (aref decipher--after i))) + freq-list) + total-chars (+ total-chars (aref decipher--freqs i))))) + (save-excursion + ;; Switch to statistics buffer, creating it if necessary: + (set-buffer (decipher-stats-buffer t)) + ;; This can't happen, but it never hurts to double-check: + (or (eq major-mode 'decipher-stats-mode) + (error "Buffer %s is not in Decipher-Stats mode" (buffer-name))) + (setq buffer-read-only nil) + (erase-buffer) + ;; Display frequency counts for letters A-Z: + (decipher-insert-frequency-counts freq-list total-chars) + (insert ?\n) + ;; Display frequency counts for letters in order of frequency: + (setq freq-list (sort freq-list + (lambda (a b) (> (second a) (second b))))) + (decipher-insert-frequency-counts freq-list total-chars) + ;; Display letters in order of frequency: + (insert ?\n (mapconcat (lambda (a) (char-to-string (car a))) + freq-list nil) + "\n\n") + ;; Display list of digrams in order of frequency: + (let* ((rows (floor (+ (length decipher--digram-list) 9) 10)) + (i rows) + temp-list) + (while (> i 0) + (setq temp-list decipher--digram-list) + (while temp-list + (insert (caar temp-list) + (format "%3d " + (cdar temp-list))) + (setq temp-list (nthcdr rows temp-list))) + (delete-horizontal-space) + (insert ?\n) + (setq decipher--digram-list (cdr decipher--digram-list) + i (1- i)))) + ;; Display adjacency list for each letter, sorted in descending + ;; order of the number of adjacent letters: + (setq freq-list (sort freq-list + (lambda (a b) (> (third a) (third b))))) + (let ((temp-list freq-list) + entry i) + (while (setq entry (pop temp-list)) + (if (equal 0 (second entry)) + nil ;This letter was not used + (setq i (- (car entry) ?A)) + (insert ?\n " " + (decipher--digram-counts (aref decipher--before i)) ?\n + (car entry) + ": 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 *" + (format "%4d %4d %3d%%\n " + (third entry) (second entry) + (/ (* 100 (second entry)) total-chars)) + (decipher--digram-counts (aref decipher--after i)) ?\n)))) + (setq buffer-read-only t) + (set-buffer-modified-p nil) + )) + (message nil)) + +;;==================================================================== +;; Statistics Buffer: +;;==================================================================== + +(defun decipher-stats-mode () + "Major mode for displaying ciphertext statistics." + (interactive) + (kill-all-local-variables) + (setq buffer-read-only t + buffer-undo-list t ;Disable undo + case-fold-search nil ;Case is significant when searching + indent-tabs-mode nil ;Do not use tab characters + major-mode 'decipher-stats-mode + mode-name "Decipher-Stats") + (use-local-map decipher-stats-mode-map) + (run-hooks 'decipher-stats-mode-hook)) +(put 'decipher-stats-mode 'mode-class 'special) + +;;-------------------------------------------------------------------- + +(defun decipher-display-stats-buffer () + "Make the statistics buffer visible, but do not select it." + (let ((stats-buffer (decipher-stats-buffer)) + (current-window (selected-window))) + (or (eq (current-buffer) stats-buffer) + (progn + (pop-to-buffer stats-buffer) + (select-window current-window))))) + +(defun decipher-stats-buffer (&optional create) + "Return the buffer used for decipher statistics. +If CREATE is non-nil, create the buffer if it doesn't exist. +This is guaranteed to return a buffer in Decipher-Stats mode; +if it can't, it signals an error." + (cond + ;; We may already be in the statistics buffer: + ((eq major-mode 'decipher-stats-mode) + (current-buffer)) + ;; See if decipher-stats-buffer exists: + ((and (bufferp decipher-stats-buffer) + (buffer-name decipher-stats-buffer)) + (or (save-excursion + (set-buffer decipher-stats-buffer) + (eq major-mode 'decipher-stats-mode)) + (error "Buffer %s is not in Decipher-Stats mode" + (buffer-name decipher-stats-buffer))) + decipher-stats-buffer) + ;; Create a new buffer if requested: + (create + (let ((stats-name (concat "*" (buffer-name) "*"))) + (setq decipher-stats-buffer + (if (eq 'decipher-stats-mode + (cdr-safe (assoc 'major-mode + (buffer-local-variables + (get-buffer stats-name))))) + ;; We just lost track of the statistics buffer: + (get-buffer stats-name) + (generate-new-buffer stats-name)))) + (save-excursion + (set-buffer decipher-stats-buffer) + (decipher-stats-mode)) + decipher-stats-buffer) + ;; Give up: + (t (error "No statistics buffer")))) + +;;==================================================================== + +(provide 'decipher) + +;;;(defun decipher-show-undo-list () +;;; "Display the undo list (for debugging purposes)." +;;; (interactive) +;;; (with-output-to-temp-buffer "*Decipher Undo*" +;;; (let ((undo-list decipher-undo-list) +;;; undo-rec undo-map) +;;; (save-excursion +;;; (set-buffer "*Decipher Undo*") +;;; (while (setq undo-rec (pop undo-list)) +;;; (or (consp (car undo-rec)) +;;; (setq undo-rec (list undo-rec))) +;;; (insert ?\() +;;; (while (setq undo-map (pop undo-rec)) +;;; (insert (cdr undo-map) (car undo-map) ?\ )) +;;; (delete-backward-char 1) +;;; (insert ")\n")))))) + +;;; decipher.el ends here
--- a/lisp/gnus/Makefile Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/gnus/Makefile Mon Aug 13 09:06:37 2007 +0200 @@ -1,6 +1,6 @@ SHELL = /bin/sh EMACS=emacs -FLAGS=-batch -q -no-site-file -l ./dgnushack.el +FLAGS=-batch -q -no-site-file -l bytecomp -l ./dgnushack.el all: rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile
--- a/lisp/hyperbole/Makefile Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/hyperbole/Makefile Mon Aug 13 09:06:37 2007 +0200 @@ -172,7 +172,7 @@ || (echo "These files will be compiled: " \ && echo "`cat $(ELISP_TO_COMPILE)`" \ && $(EMACS) $(BATCHFLAGS) $(PRELOADS) \ - -f batch-byte-compile `cat $(ELISP_TO_COMPILE)`) + -l bytecomp -f batch-byte-compile `cat $(ELISP_TO_COMPILE)`) @ $(RM) $(ELISP_TO_COMPILE) elc-init:
--- a/lisp/modes/make-mode.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/modes/make-mode.el Mon Aug 13 09:06:37 2007 +0200 @@ -161,6 +161,12 @@ IMPORTANT: Please note that enabling this option causes makefile-mode to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \'it seems necessary\'.") +;;; those suspicious line warnings are really annoying and +;;; seem to be generated for every makefile I've ever seen. +;;; add a simple mechanism to disable them. -gk +(defvar makefile-warn-suspicious-lines-p t + "In non-nil, warn about suspicious lines when saving the makefile") + (defvar makefile-browser-hook '()) ;; @@ -619,7 +625,13 @@ (makefile-pickup-macros) (if (bolp) (call-interactively 'makefile-insert-macro) - (self-insert-command arg))) + (self-insert-command arg) + ;; from here down is new -- if they inserted a macro without using + ;; the electric behavior, pick it up anyway -gk + (save-excursion + (beginning-of-line) + (if (looking-at makefile-macroassign-regex) + (makefile-add-this-line-macro))))) (defun makefile-insert-macro (macro-name) "Prepare definition of a new macro." @@ -719,7 +731,9 @@ (if (not makefile-need-macro-pickup) nil (setq makefile-need-macro-pickup nil) - (setq makefile-macro-table nil) + ;; changed the nil in the next line to makefile-runtime-macros-list + ;; so you don't have to confirm on every runtime macro entered... -gk + (setq makefile-macro-table makefile-runtime-macros-list) (save-excursion (goto-char (point-min)) (while (re-search-forward makefile-macroassign-regex (point-max) t) @@ -1220,7 +1234,8 @@ (defun makefile-warn-suspicious-lines () (let ((dont-save nil)) - (if (eq major-mode 'makefile-mode) + (if (and (eq major-mode 'makefile-mode) + makefile-warn-suspicious-lines-p) ; -gk (let ((suspicious (save-excursion (goto-char (point-min))
--- a/lisp/mule/mule-coding.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/mule/mule-coding.el Mon Aug 13 09:06:37 2007 +0200 @@ -42,12 +42,10 @@ (defun what-coding-system (start end &optional arg) "Show the encoding of text in the region. -With prefix arg, show all possible coding systems. This function is meant to be called interactively; from a Lisp program, use `detect-coding-region' instead." (interactive "r\nP") - (let ((codings (detect-coding-region start end))) - (message "%s" (if (or arg (symbolp codings)) codings (car codings))))) + (princ (detect-coding-region start end))) (defmacro with-string-as-buffer-contents (str &rest body) "With the contents of the current buffer being STR, run BODY.
--- a/lisp/mule/mule-files.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/mule/mule-files.el Mon Aug 13 09:06:37 2007 +0200 @@ -52,8 +52,8 @@ (defvar file-coding-system-alist ;; '(; ("\\.el$" . euc-japan) - '(("\\.el$" . iso-2022-7) - ("\\.info$" . iso-2022-7) + '(("\\.el$" . iso-2022-8) + ("\\.info$" . iso-2022-8) ("\\.\\(gz\\|Z\\)$" . binary) ("/spool/mail/.*$" . convert-mbox-coding-system)) "Alist specifying the coding system used for particular files. @@ -403,8 +403,7 @@ FILENAME, APPEND, VISIT, and CODING-SYSTEM, the same as the corresponding arguments in the call to `write-region'.") -(defun write-region (start end filename &optional append visit lockname - coding-system) +(defun write-region (start end filename &optional append visit lockname coding-system) "Write current region into specified file. When called from a program, takes three arguments: START, END and FILENAME. START and END are buffer positions.
--- a/lisp/packages/avoid.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/packages/avoid.el Mon Aug 13 09:06:37 2007 +0200 @@ -72,6 +72,7 @@ (provide 'avoid) +;;;###autoload (defvar mouse-avoidance-mode nil "Value is t or a symbol if the mouse pointer should avoid the cursor. See function `mouse-avoidance-mode' for possible values. Changing this @@ -366,4 +367,4 @@ ;;;###autoload (add-minor-mode 'mouse-avoidance-mode " Avoid") -;;; End of avoid.el +;;; avoid.el ends here
--- a/lisp/packages/lazy-lock.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/packages/lazy-lock.el Mon Aug 13 09:06:37 2007 +0200 @@ -874,7 +874,9 @@ ;; These fix bugs in `text-property-any' and `text-property-not-all'. They may ;; not work perfectly in 19.11 and below because `next-single-property-change' ;; is also broke and not easily fixable in Lisp. -(if (and lazy-lock-running-xemacs-p (< emacs-minor-version 12)) +(if (and lazy-lock-running-xemacs-p + (= emacs-major-version 19) + (< emacs-minor-version 12)) (progn ;; Loop through property changes until found. This fix includes a work ;; around which prevents a bug in `window-start' causing a barf here. @@ -904,7 +906,9 @@ ;; than `face'. Since `font-lock-unfontify-region' only removes `face', and we ;; have non-font-lock properties hanging about, `text-prop' never gets removed. ;; Unfortunately `font-lock-any-extents-p' is inlined so we can't redefine it. -(if (and lazy-lock-running-xemacs-p (< emacs-minor-version 12)) +(if (and lazy-lock-running-xemacs-p + (= emacs-major-version 19) + (< emacs-minor-version 12)) (add-hook 'font-lock-mode-hook (function (lambda () (remove-hook 'after-change-functions 'font-lock-after-change-function) @@ -921,7 +925,9 @@ ;; Now set `fontified' to t to stop `lazy-lock-fontify-window'. (put-text-property beg end 'fontified t)))))))))) -(if (and lazy-lock-running-xemacs-p (>= emacs-minor-version 12)) +(if (and lazy-lock-running-xemacs-p + (or (> emacs-major-version 19) + (>= emacs-minor-version 12))) ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. (add-hook 'font-lock-after-fontify-buffer-hook 'lazy-lock-after-fontify-buffer))
--- a/lisp/packages/man.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/packages/man.el Mon Aug 13 09:06:37 2007 +0200 @@ -575,17 +575,21 @@ (error (buffer-substring (point) (progn (end-of-line) (point)))))) nil) - +(defvar Manual-entry-switches '("-s") + "Switches for `manual-entry' including switch for section (at the end).") +(defvar Manual-apropos-switches nil + "Additional switches for `Manpage-apropos' excluding switch `-k'.") + (defun Manual-run-formatter (name topic section) (cond ((string-match "roff\\'" Manual-program) ;; kludge kludge (call-process Manual-program nil t nil "-Tman" "-man" name)) - (Manual-section-switch - (call-process Manual-program nil t nil Manual-section-switch - section topic)) (t - (call-process Manual-program nil t nil section topic)))) - + (apply 'call-process Manual-program nil t nil + (append (if apropos-mode + Manual-apropos-switches + Manual-entry-switches) + (list section topic)))))) (defvar Manual-mode-map (let ((m (make-sparse-keymap)))
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:06:37 2007 +0200 @@ -1339,7 +1339,7 @@ (autoload 'ediff-merge-revisions-with-ancestor "ediff" "\ Run Ediff by merging two revisions of a file with a common ancestor. -The file is the optional FILE argument or the file visited by the current +The file is the the optional FILE argument or the file visited by the current buffer." t nil) (autoload 'run-ediff-from-cvs-buffer "ediff" "\ @@ -1776,6 +1776,29 @@ ;;;*** +;;;### (autoloads (decipher-mode decipher) "decipher" "games/decipher.el") + +(autoload 'decipher "decipher" "\ +Format a buffer of ciphertext for cryptanalysis and enter Decipher mode." t nil) + +(autoload 'decipher-mode "decipher" "\ +Major mode for decrypting monoalphabetic substitution ciphers. +Lower-case letters enter plaintext. +Upper-case letters are commands. + +The buffer is made read-only so that normal Emacs commands cannot +modify it. + +The most useful commands are: +\\<decipher-mode-map> +\\[decipher-digram-list] Display a list of all digrams & their frequency +\\[decipher-frequency-count] Display the frequency of each ciphertext letter +\\[decipher-adjacency-list] Show adjacency list for current letter (lists letters appearing next to it) +\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint) +\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" t nil) + +;;;*** + ;;;### (autoloads (dissociated-press) "dissociate" "games/dissociate.el") (autoload 'dissociated-press "dissociate" "\ @@ -3631,7 +3654,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.3 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.4 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4928,7 +4951,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.3 $ +vhdl-mode $Revision: 1.4 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the @@ -5308,6 +5331,12 @@ ;;;### (autoloads (mouse-avoidance-mode) "avoid" "packages/avoid.el") +(defvar mouse-avoidance-mode nil "\ +Value is t or a symbol if the mouse pointer should avoid the cursor. +See function `mouse-avoidance-mode' for possible values. Changing this +variable is NOT the recommended way to change modes; use that function +instead.") + (autoload 'mouse-avoidance-mode "avoid" "\ Set cursor avoidance mode to MODE. MODE should be one of the symbols `banish', `exile', `jump', `animate', @@ -6589,9 +6618,9 @@ If nil, the default personal dictionary, \"~/.ispell_DICTNAME\" is used, where DICTNAME is the name of your default dictionary.") -(defvar ispell-dictionary-alist-1 '((nil "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("british" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "british") nil) ("deutsch" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex") ("deutsch8" "[a-zA-Z,ADV\dv_|(B]" "[^a-zA-Z,ADV\dv_|(B]" "[']" t ("-C" "-d" "deutsch") "~latin1") ("nederlands" "[A-Za-z,A@(B-,AEGH(B-,AOR(B-,AVY(B-,A\`(B-,Aegh(B-,Aoqr(B-,Avy(B-,A|(B]" "[^A-Za-z,A@(B-,AEGH(B-,AOR(B-,AVY(B-,A\`(B-,Aegh(B-,Aoqr(B-,Avy(B-,A|(B]" "[']" t ("-C") nil) ("nederlands8" "[A-Za-z,A@(B-,AEGH(B-,AOR(B-,AVY(B-,A\`(B-,Aegh(B-,Aoqr(B-,Avy(B-,A|(B]" "[^A-Za-z,A@(B-,AEGH(B-,AOR(B-,AVY(B-,A\`(B-,Aegh(B-,Aoqr(B-,Avy(B-,A|(B]" "[']" t ("-C") nil))) - -(defvar ispell-dictionary-alist-2 '(("svenska" "[A-Za-z}{|\\133\\135\\\\]" "[^A-Za-z}{|\\133\\135\\\\]" "[']" nil ("-C") nil) ("svenska8" "[A-Za-z,AedvEDv(B]" "[^A-Za-z,AedvEDv(B]" "[']" nil ("-C" "-d" "svenska") "~list") ("francais7" "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil) ("francais" "[A-Za-z,A@BFGHIJKNOTY[\`bghijknoty{|(B]" "[^A-Za-z,A@BFGHIJKNOTY[\`bghijknoty{|(B]" "[---']" t nil "~list") ("francais-tex" "[A-Za-z,A@BFGHIJKNOTY[\`bghijknoty{|(B\\]" "[^A-Za-z,A@BFGHIJKNOTY[\`bghijknoty{|(B\\]" "[---'^`\"]" t nil "~tex") ("dansk" "[A-Z,AFXE(Ba-z,Afxe(B]" "[^A-Z,AFXE(Ba-z,Afxe(B]" "" nil ("-C") nil))) +(defvar ispell-dictionary-alist-1 '((nil "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil) ("british" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "british") nil) ("deutsch" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex") ("deutsch8" "[a-zA-ZÄÖÜäößü]" "[^a-zA-ZÄÖÜäößü]" "[']" t ("-C" "-d" "deutsch") "~latin1") ("nederlands" "[A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[^A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[']" t ("-C") nil) ("nederlands8" "[A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[^A-Za-zÀ-ÅÇÈ-ÏÒ-ÖÙ-Üà-åçè-ïñò-öù-ü]" "[']" t ("-C") nil))) + +(defvar ispell-dictionary-alist-2 '(("svenska" "[A-Za-z}{|\\133\\135\\\\]" "[^A-Za-z}{|\\133\\135\\\\]" "[']" nil ("-C") nil) ("svenska8" "[A-Za-zåäöÅÄö]" "[^A-Za-zåäöÅÄö]" "[']" nil ("-C" "-d" "svenska") "~list") ("francais7" "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil) ("francais" "[A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü]" "[^A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü]" "[---']" t nil "~list") ("francais-tex" "[A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü\\]" "[^A-Za-zÀÂÆÇÈÉÊËÎÏÔÙÛÜàâçèéêëîïôùûü\\]" "[---'^`\"]" t nil "~tex") ("dansk" "[A-ZÆØÅa-zæøå]" "[^A-ZÆØÅa-zæøå]" "" nil ("-C") nil))) (defvar ispell-dictionary-alist (append ispell-dictionary-alist-1 ispell-dictionary-alist-2) "\ An alist of dictionaries and their associated parameters. @@ -8322,7 +8351,7 @@ This is also a plain text. But, it is explicitly specified as is. --[[text/plain; charset=ISO-2022-JP]] - ...Japanese text here.... + ... Japanese text here ... --[[text/richtext]] <center>This is a richtext.</center> --[[image/gif][base64]]^M...image encoded in base64 here... @@ -8369,59 +8398,6 @@ ;;;*** -;;;### (autoloads (url-retrieve url-cache-expired url-popup-info url-get-url-at-point url-buffer-visiting url-normalize-url url-file-attributes) "url" "url/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-cache-expired "url" "\ -Return t iff a cached file has expired." 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 (defadvice ad-add-advice) "advice" "utils/advice.el") (defvar ad-redefinition-action 'warn "\ @@ -9417,6 +9393,59 @@ ;;;*** +;;;### (autoloads (url-retrieve url-cache-expired 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-cache-expired "url" "\ +Return t iff a cached file has expired." 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-use-hotlist) "w3-hot" "w3/w3-hot.el") (autoload 'w3-use-hotlist "w3-hot" "\ @@ -9517,6 +9546,36 @@ ;;;*** +;;;### (autoloads (widget-delete widget-create) "widget-edit" "w3/widget-edit.el") + +(autoload 'widget-create "widget-edit" "\ +Create widget of TYPE. +The optional ARGS are additional keyword arguments." nil nil) + +(autoload 'widget-delete "widget-edit" "\ +Delete WIDGET." nil nil) + +;;;*** + +;;;### (autoloads (define-widget) "widget" "w3/widget.el") + +(autoload 'define-widget "widget" "\ +Define a new widget type named NAME from CLASS. + +NAME and CLASS should both be symbols, CLASS should be one of the +existing widget types, or nil to create the widget from scratch. + +After the new widget has been defined, the following two calls will +create identical widgets: + +* (widget-create NAME) + +* (apply 'widget-create CLASS ARGS) + +The third argument DOC is a documentation string for the widget." nil nil) + +;;;*** + ;;;### (autoloads (font-menu-weight-constructor font-menu-size-constructor font-menu-family-constructor reset-device-font-menus) "x-font-menu" "x11/x-font-menu.el") (defvar font-menu-ignore-scaled-fonts t "\
--- a/lisp/prim/frame.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/prim/frame.el Mon Aug 13 09:06:37 2007 +0200 @@ -802,6 +802,7 @@ (buffer-substring-no-properties begin end)) (error "CDE functionality not compiled in."))) + ;;; Application-specific frame-management
--- a/lisp/prim/help.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 09:06:37 2007 +0200 @@ -181,11 +181,12 @@ (define-key help-mode-map "q" 'help-mode-quit) (defun help-mode-quit () - "Exits from help mode, possiblely restoring the previous window configuration." + "Exits from help mode, possibly restoring the previous window configuration." (interactive) (cond ((local-variable-p 'help-window-config (current-buffer)) (let ((config help-window-config)) (kill-local-variable 'help-window-config) + (bury-buffer) (set-window-configuration config))) ((one-window-p) (bury-buffer))
--- a/lisp/prim/simple.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/prim/simple.el Mon Aug 13 09:06:37 2007 +0200 @@ -1084,7 +1084,7 @@ ;; (message "Read only text copied to kill ring") (setq this-command 'kill-region) (barf-if-buffer-read-only) - (signal 'text-read-only (list (current-buffer)))) + (signal 'buffer-read-only (list (current-buffer)))) ;; In certain cases, we can arrange for the undo list and the kill ;; ring to share the same string object. This code does that.
--- a/lisp/psgml/psgml-parse.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/psgml/psgml-parse.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,5 +1,5 @@ ;;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support -;; $Id: psgml-parse.el,v 1.2 1997/01/03 03:10:27 steve Exp $ +;; $Id: psgml-parse.el,v 1.3 1997/01/11 20:14:09 steve Exp $ ;; Copyright (C) 1994, 1995 Lennart Staflin @@ -1206,7 +1206,7 @@ (sgml-pop-entity) (erase-buffer) ;; For XEmacs-20.0/Mule - (setq file-coding-system 'noconv) + (setq file-coding-system 'no-conversion) (sgml-write-dtd sgml-dtd-info to-file) t)) @@ -1234,7 +1234,7 @@ "Merge the binary coded dtd in the current buffer with the current dtd. The current dtd is the variable sgml-dtd-info. Return t if mereged was successfull or nil if failed." - (setq file-coding-system 'noconv) + (setq file-coding-system 'no-conversion) (goto-char (point-min)) (sgml-read-sexp) ; skip filev (let ((dependencies (sgml-read-sexp)) @@ -2368,7 +2368,7 @@ ;; (reported by Jeffrey Friedl <jfriedl@nff.ncl.omron.co.jp>) (setq mc-flag nil) ;; For XEmacs 20.0/Mule - (setq file-coding-system 'noconv) + (setq file-coding-system 'no-conversion) (when (eq sgml-scratch-buffer (default-value 'sgml-scratch-buffer)) (make-local-variable 'sgml-scratch-buffer) (setq sgml-scratch-buffer nil))
--- a/lisp/tm/tm-edit.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/tm/tm-edit.el Mon Aug 13 09:06:37 2007 +0200 @@ -6,7 +6,7 @@ ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1994/08/21 renamed from mime.el -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; Keywords: mail, news, MIME, multimedia, multilingual ;; This file is part of tm (Tools for MIME). @@ -96,7 +96,6 @@ ;; This is also a plain text. But, it is explicitly specified as is. ;; ;;--[[text/plain; charset=ISO-2022-JP]] -;; $B$3$l$O(B charset $B$r(B ISO-2022-JP $B$K;XDj$7$?F|K\8l$N(B plain $B%F%-%9%H$G$9(B. ;; ;;--[[text/richtext]] ;; <center>This is a richtext.</center> @@ -120,7 +119,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 1.3 1997/01/03 03:10:30 steve Exp $") + "$Id: tm-edit.el,v 1.4 1997/01/11 20:14:11 steve Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -750,7 +749,7 @@ This is also a plain text. But, it is explicitly specified as is. --[[text/plain; charset=ISO-2022-JP]] - ...Japanese text here.... + ... Japanese text here ... --[[text/richtext]] <center>This is a richtext.</center> --[[image/gif][base64]]^M...image encoded in base64 here...
--- a/lisp/tm/tm-ew-d.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/tm/tm-ew-d.el Mon Aug 13 09:06:37 2007 +0200 @@ -9,7 +9,7 @@ ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'. ;; Renamed: 1993/06/03 to tiny-mime.el. ;; Renamed: 1995/10/03 from tiny-mime.el. (split off encoder) -;; Version: $Revision: 1.1.1.2 $ +;; Version: $Revision: 1.2 $ ;; Keywords: encoded-word, MIME, multilingual, header, mail, news ;; This file is part of tm (Tools for MIME). @@ -35,13 +35,14 @@ (require 'std11) (require 'mel) (require 'tm-def) +(require 'tl-str) ;;; @ version ;;; (defconst tm-ew-d/RCS-ID - "$Id: tm-ew-d.el,v 1.1.1.2 1996/12/21 20:50:42 steve Exp $") + "$Id: tm-ew-d.el,v 1.2 1997/01/11 20:14:11 steve Exp $") (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
--- a/lisp/url/ChangeLog Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1106 +0,0 @@ -Thu Aug 1 13:26:02 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: made url-insert-file-contents interactive - -* url-sysdp.el: -added data-directory to sysdep version of x-library-search-path for -emacs under windows 95/nt - -Tue Jul 23 00:19:22 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: fix for no_proxy checking for local files - -Mon Jul 22 03:22:52 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: added stub for make-local-hook - more Emacs 19.2x lossage. - -Sun Jul 21 20:10:42 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el: Created version 1.0.40 - -* url.el: -In url-after-change-function, don't change buffers if its been killed. - -Fri Jul 19 04:39:08 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el: Created version 1.0.39 - -Thu Jul 18 14:06:54 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el: duh - make url-current-server buffer local. - -Fri Jul 12 06:10:02 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: Only match against the hostname in the URL for the no_proxy checking - -* url-hash.el: removed old aliases for w3-*hash functions - -Thu Jul 11 05:10:47 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: version of valid-color-name-p and device-class for the OS/2 -presentation manager. - -* url.el, url-file.el: handle : in filenames gracefully - -* url-vars.el: Created version 1.0.38 - -Wed Jul 10 23:33:39 1996 William Perry <wmperry@cs.indiana.edu> - -* dist.Makefile: fixed install target - duh - -* url-irc.el: fixed bad variable name - -* mm.el: require cl to avoid stupid compiler errors - -* url.el: new function url-remove-compressed-extensions - -* url-vars.el, mm.el: *** empty log message *** - -* url-cookie.el, url-vars.el: -can now control when/how/if an HTTP cookie is accepted - -Tue Jul 9 21:01:15 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: added more overlay functions - -* url-vars.el: Created version 1.0.37 - -* url-vars.el, dist.Makefile, mm.el: *** empty log message *** - -* url.el: autoload url-nfs - -* url-http.el: *** empty log message *** - -* mm.el: Fixed mm-save-binary-file - -* url-vars.el: fix for mule stuff Emacs vs. XEmacs - -* url-wais.el: *** empty log message *** - -* url.el: turn off url-download-minor-mode stuff - -Mon Jul 1 15:32:13 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added stub for buffer-substring-no-properties - -* url-sysdp.el: Fix to device-or-frame-type to work under Emacs 19.28 - -* url-sysdp.el: Added in stubs for plist-put and plist-get, and an Emacs 19.2x -specific version of facep. everything almost works in 19.28 now. - -Sun Jun 30 18:12:20 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Changed email address info - -Fri Jun 28 16:08:08 1996 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fix for stupid problem in mm-copy-tree - -Wed Jun 26 16:37:12 1996 William Perry <wmperry@cs.indiana.edu> - -* url-news.el, url.el: -Patch from Darrell Kindred <dkindred+@cmu.edu> for news problems - 1. nnheader-init-server-buffer isn't called, so the - first call to nntp-open-server fails. (Patch inserts - a call to nnheader-init-server-buffer in url-news-open-host.) - 2. The `&', '<', and '>' characters don't get turned into - entities in news from lines, subject, body, etc. The result - is that "William Perry <wmperry@monolith.spry.com>" shows up - as "William Perry @monolith.spry.com>". (The patch moves - w3-insert-entities-in-string to url.el and renames it to - url-insert-entities-in-string, then calls it from url-format-news. - 3. When displayed, news articles get an extra, empty - "References" entry. (Patch inserts a `(delete "" ...)' - to remove the trailing empty reference from the list.) - -Tue Jun 25 18:44:30 1996 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Potential fix for cl's version of copy-tree fucking things up in mm.el - -* url-sysdp.el: Added bogus definition of set-marker-insertion-type - -Fri Jun 14 17:45:16 1996 William Perry <wmperry@cs.indiana.edu> - -* url-cookie.el: fixed bug in cookie support - -* url-cookie.el: Require cl for the def. of assoc* - -* url-vars.el, url.el: -Fixes for mule from MORIOKA Tomohiko <morioka@jaist.ac.jp> - -Thu Jun 13 00:20:04 1996 William Perry <wmperry@cs.indiana.edu> - -* url-misc.el, url.el: fixed asynch stuff through a proxy - -Wed Jun 12 04:00:39 1996 William Perry <wmperry@cs.indiana.edu> - -* url-nfs.el: Initial revision - -* url.el: Added 'nfs' url type as per the WebNFS specification - -Tue Jun 11 17:28:53 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el: *** empty log message *** - -* url-irc.el: Fixed bug when no channel was specified in the URL - -* url.el: Added IRC loader - -* url-irc.el: Initial revision - -Mon Jun 10 18:58:03 1996 William Perry <wmperry@cs.indiana.edu> - -* md5.el: compilation warnings removed - -* md5.el: -New version of md5.el that actually incorporates an md5 implementation -in lisp! Whoah. - -Sun Jun 9 17:32:55 1996 William Perry <wmperry@cs.indiana.edu> - -* url-http.el: -protect against malformed HTTP URLs getting passed in via url-retrieve - -* url.el: fixed problem with writing out a history file for the first time - -* url-file.el: fixed problem with ftp links - -* url-sysdp.el, dist.Makefile: Initial revision - -* base64.el, descrip.mms, docomp.el, md5.el, mm.el, ssl.el, url-cookie.el, url-file.el, url-gopher.el, url-hash.el, url-http.el, url-mail.el, url-misc.el, url-news.el, url-parse.el, url-pgp.el, url-vars.el, url-wais.el, url.el, urlauth.el: -Initial rev - -Wed Jun 5 14:31:40 1996 William Perry <wmperry@cs.indiana.edu> - -* url-cookie.el: added :test to list of keywords url-cookie provides - -Mon Jun 3 15:04:57 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el, url-mail.el: -Added stub url-mail function that is just a wrapper around `mail' that -will signal an error if the user says no to cancelling an unsent -message. - -Thu May 30 14:05:07 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added symbol-value-in-buffer - -* url.el: made url-insert-file-contents never be asynch... duh - -* url-sysdp.el: Added insert-file-contents-literally function - -Wed May 29 18:10:31 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: -New 'minor mode' for displaying whether you are downloading a url in the background - -* url-news.el: few fixes - -* url-http.el: *** empty log message *** - -* url-http.el, url-vars.el, url.el: -Few fixes for not sending the user-agent at all if url-privacy-level -dictates so - -* url.el: Make 'nntp' url type synonymous w/'news' - -Tue May 28 04:36:55 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: *** empty log message *** - -* mm.el, url-file.el, url-vars.el, url.el: -Standardize MULE checking between Emacs and XEmacs - use featurep 'mule - -* url.el: fixed problem with detection of process-(get|put) - -* ssl.el: Changed the way to specify the ssl program - -Sat May 25 14:42:53 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: fixed problem in url-open-stream where it would always abort the -connection - have to hate bad variable initialization. - -Fri May 24 18:17:17 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: Asynch callbacks work for file downloads - -* url.el: Changed sit-for to sleep-for to make sure it actually SITS! - -* url.el: Retry connection automatically if you get the infamous 'address -already in use' error. - -* url.el, url-wais.el, url-pgp.el, url-file.el, mm.el: -No longer use mm-insert-file-contents lossage - -* url-file.el: Fix for url-host-is-local-p for urls like file:///blahblah/ - -Thu May 23 14:18:45 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: synching up with XEmacs 19.14's version - -* url-sysdp.el: Added lots more device functions - -* url.el: Fixed url-extract-from-cache so that it wouldn't say 'loading blah' - -Wed May 22 17:07:25 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: Fixed problems with asynch image loading in emacs-w3 - -Sun May 19 02:13:46 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el: *** empty log message *** - -Fri May 17 14:55:16 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el, url-vars.el, url-http.el: -No longer do Session-ID - subsumed by the cookie support - -Mon May 13 15:20:18 1996 William Perry <wmperry@cs.indiana.edu> - -* url-mail.el: *** empty log message *** - -* url.el: If the user does not have a history file already, always default to -using the Emacs-style history instead of prompting for it. - -Fri May 10 23:06:34 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: duh - -* url.el: New url-list-processes function - -Thu May 2 21:34:50 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: When stripping off data from a URL for viewing, leave some indication -that a query was removed if necessary - -* url-http.el: Always send off the attributes of URLs to the http server... - -Wed May 1 15:52:10 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el: fixed docstring of url-inhibit-uncompression - -* mm.el: *** empty log message *** - -* url-http.el: -No longer conditionalize some stuff on after-change-functions - all -Emacs19s support this. - -Tue Apr 30 16:51:07 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added definition of alist-to-plist - -* url-cookie.el: Don't downcase the cookie name stuff - -* mm.el: changed calling of mm-parse-args... 3rd arg now specifies whether or -not to never downcase the name portion of the name/value pairs. - -Tue Apr 23 16:38:24 1996 William Perry <wmperry@cs.indiana.edu> - -* url-cookie.el: Added in the security measures outlined in the cookie spec. - -Mon Apr 22 16:28:00 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: renamed url-cookies.el to url-cookie -now shrinks the error window down if it cannot make a connection, and -kills the buffer afterwards - -* url-http.el, url-cookie.el, dist.Makefile: -renamed url-cookies.el to url-cookie - -* base64.el: Much faster version of base64-decode-region, courtesy of Francesco -Potorti` <F.Potorti@cnuce.cnr.it> - -Fri Apr 12 03:51:20 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el, url-http.el: *** empty log message *** - -Thu Apr 11 21:34:18 1996 William Perry <wmperry@cs.indiana.edu> - -* url-cookie.el: Now cleans up the cookie database when it writes it to disk - -* url.el: *** empty log message *** - -* url-cookie.el: Fixed bad logic in finding matching paths for cookies. - -* url-http.el, url-cookie.el: Now supports netscape-style cookies - -Wed Apr 10 14:52:43 1996 William Perry <wmperry@cs.indiana.edu> - -* dist.Makefile, url-cookie.el: Beginnings of netscape-style cookie support - -* url-cookie.el: Initial revision - -* url-news.el: *** empty log message *** - -* url-file.el: -file:// hrefs now understand using your local hostname instead of -localhost to mean local file access. Sheesh. - -* url-file.el: -Fix for local/remote files with ':' in them getting parsed as full URLs. - -Tue Apr 9 20:44:07 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: -url-truncate-url-for-viewing can now take an optional width parameter. -If an unknown URL type is found, put quotes around it in the error -message so that its easier to know what exactly wasn't recognized. - -Fri Apr 5 14:52:42 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el, url-http.el: removed excess whitespace from user-agent line - -Wed Apr 3 15:55:16 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el, url-vars.el: *** empty log message *** - -* url-http.el: Now supports proxy authentication - -Tue Apr 2 17:16:23 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Some extent functions for emacs19 - -Sun Mar 31 02:38:41 1996 William Perry <wmperry@cs.indiana.edu> - -* base64.el: added data the the LCD stuff - -* dist.Makefile: Initial revision - -* mm.el: *** empty log message *** - -Wed Mar 27 19:51:08 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: Can now read and write the NCSA global history format version 2. - -* base64.el: Fixed _stupid_ problem in base64-decode-region - -Mon Mar 25 14:53:56 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Changed some pointers to ben wing and pearl software. - -Wed Mar 20 14:01:04 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: url-file-attributes will no longer signal an error - -Sun Mar 3 01:59:59 1996 William Perry <wmperry@cs.indiana.edu> - -* base64.el: added base64-decode-region - -Fri Feb 23 01:58:21 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: *** empty log message *** - -Thu Feb 22 14:14:12 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: -Fixed problem writing mosaic and netscape style history lists. D'ohh! - -Wed Feb 21 15:35:04 1996 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added stub for add-minor-mode - -* url-sysdp.el: -Few fixes for #%!@ damn emacsen that don't sanely deal with make-face et. al -on a TTY interface. - -Sun Feb 18 06:26:03 1996 William Perry <wmperry@cs.indiana.edu> - -* url-news.el: *** empty log message *** - -Sat Feb 17 06:10:51 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: Some url expansion problems fixed - -* url.el: fixed autoload for url-news - -* url.el, mm.el: *** empty log message *** - -* url.el: Fixed problem with unescaped . in url-remove-relative-links - D'ohh! - -Tue Jan 23 13:47:43 1996 William Perry <wmperry@cs.indiana.edu> - -* url.el: Don't choke and die if you can't find ange-ftp - -Sun Jan 14 22:41:43 1996 William Perry <wmperry@cs.indiana.edu> - -* url-news.el: Fixed possible problem in recognizing new versions of GNUS - -Fri Jan 5 17:45:31 1996 William Perry <wmperry@cs.indiana.edu> - -* url-parse.el: -Fixed some ftp problems that arose when url-generic-parse-url left a -trailing ':' on the hostname sometimes. - -Wed Jan 3 18:40:54 1996 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el: Fixed doc buglet in url-privacy-level - -* url.el: *** empty log message *** - -* url.el: Now no longer barfs on writing netscape/mosaic history files - -Wed Dec 20 15:08:24 1995 William Perry <wmperry@cs.indiana.edu> - -* url.el: No longer cache viewer information to disk... bad bad bad - -Tue Dec 12 15:21:13 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: -Added stubs for make-face set-face-foreground and set-face-background -for non-X emacsen - -Sun Dec 10 16:27:41 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added stubs for face-property and set-face-property - -Fri Dec 8 15:55:20 1995 William Perry <wmperry@cs.indiana.edu> - -* url.el: Now correctly trims down urls like http://foo.bar.com/../x/y/z - -Wed Dec 6 14:28:43 1995 William Perry <wmperry@cs.indiana.edu> - -* url.el: Fixed problem in url-handle-no-scheme - -* url.el: Added in stuff to do automatic link conversion from something like -'spry' to 'http://www.spry.com/' when typing in links by hand. - -Sun Dec 3 19:06:00 1995 William Perry <wmperry@cs.indiana.edu> - -* url.el: -url-view-url now returns nil instead of "" for documents that don't have -a URL associated with them. - -* url-news.el: Now checks to make sure that you have a correct version of GNUS -installed and reports error messages instead of choking and dying. - -* url-news.el: The news support now requires (ding) GNUS - -Sat Dec 2 16:46:15 1995 William Perry <wmperry@cs.indiana.edu> - -* url-file.el, url-gopher.el, url-news.el: -Removed bogus use of <div1> in generated HTML - -Wed Nov 29 15:06:58 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Define x-font-regexp-foundry-and-family for Emacs 19 - -Fri Nov 24 22:54:09 1995 William Perry <wmperry@cs.indiana.edu> - -* url.texi: -Lots of changes and restructuring - will not compile at all right now - -Sun Nov 19 22:35:20 1995 William Perry <wmperry@cs.indiana.edu> - -* docomp.el: *** empty log message *** - -* mm.el, url-misc.el: Fixed some problems with MULE and code conversion - -* urlauth.el: -Removed bogus call/definition of 'warn' instead of using url-warn. Bleah. - -Fri Nov 17 18:48:16 1995 William Perry <wmperry@cs.indiana.edu> - -* url.el: Fixed writing of the emacs-style global history file - -* url-hash.el: -Fixed hashtable stuff under XEmacs - the key of a hashtable must be -able to compare with 'eq', not 'equal', so had to change it to use -symbols instead of the url string. - -* url.el: Default to using user-mail-address for url-pgp/pem-entity and -url-personal-mail-address - -* url-parse.el: Fixed problem with parsing url fragments - -Wed Nov 15 16:49:31 1995 William Perry <wmperry@cs.indiana.edu> - -* url-file.el: -Fixed some bad HTML that made the new parser break when it implied a -</pre> tag - -Tue Nov 14 01:23:13 1995 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el, url.el: Trying to make OS/2 happy with our CRLF handling - -Fri Nov 10 17:41:39 1995 William Perry <wmperry@cs.indiana.edu> - -* url-gopher.el: Fixed possible screwup in url-grok-gopher-line - -Wed Nov 1 15:21:39 1995 William Perry <wmperry@cs.indiana.edu> - -* url-http.el: -Always default to basic authentication if no www-authenticate header was returned - -* url.el: -Don't leave backup copies of w3-hotlist-file or url-global-history-file - -Sun Oct 29 02:38:49 1995 William Perry <wmperry@cs.indiana.edu> - -* url.el: Don't do cacheing if doing asynchronous retrieval - -* url-parse.el: *** empty log message *** - -* url-file.el: Fixed a typo - -* url-parse.el: Now unescapes the hostname part of a URL if necessary - -Sat Oct 28 04:01:56 1995 William Perry <wmperry@cs.indiana.edu> - -* url-vars.el, url.el: -Now only saves the history list to disk via the timer if the list has -changed since the last time. - -* url.el: *** empty log message *** - -* url-parse.el: Now correctly handles the ;xx=yy attributes on URLs, etc. - -* mm.el: Added some new content-transfer-encodings ala the HTTP/1.1 draft - -Wed Oct 25 22:50:55 1995 William Perry <wmperry@cs.indiana.edu> - -* url.el: Extended url-truncate-url-for-viewing to actually do something. -Really long URLs should no longer look like shit for V/v or mouse -tracking viewing. Could be fairly expensive string/GC wise - -* url-parse.el: -Fixed problem in parsing xxx@yyy hostnames in url-generic-parse-url - -Sun Oct 15 22:17:06 1995 William Perry <wmperry@cs.indiana.edu> - -* url-http.el: *** empty log message *** - -* url-parse.el: No longer hangs on really fucking long URLs - -* url-hash.el: *** empty log message *** - -* url-vars.el: Fixed regexp so it won't blow up in emacs18 - -* url-http.el: *** empty log message *** - -* url-gopher.el: Fixed problem with tn3270 and telnet links from a gopher page. - -* url-misc.el: -Fixed problem with telnet/tn3270/rlogin URLs popping up a bogus `Unkown' buffer - -Tue Oct 10 13:28:40 1995 William Perry <wmperry@cs.indiana.edu> - -* url-mail.el, url-http.el, url-file.el: Fixed header lines - -Mon Oct 9 02:54:32 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -Sun Oct 8 23:27:54 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed bug in mm-parse-args where it would (almost) always tack an -empty/unneeded ("") at the end of the list or argument/value pairs - -* url-sysdp.el: *** empty log message *** - -Mon Oct 2 13:02:40 1995 William Perry <wmperry@cs.indiana.edu> - -* url-http.el: Now sends the "Server" header on all requests, ala HTTP/1.1 - -* url.el: *** empty log message *** - -Thu Sep 28 13:18:17 1995 William Perry <wmperry@cs.indiana.edu> - -* url-file.el, url.el: *** empty log message *** - -Sun Sep 24 17:13:14 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added def of find-face - -* url-vars.el: -New variable url-extensions-header that is the list of http extensions -we support - -* url-http.el: *** empty log message *** - -* url-http.el: -Improved url-parse-viewer-types to only stick something in the accept -list once - -Sat Sep 23 23:13:29 1995 William Perry <wmperry@cs.indiana.edu> - -* docomp.el, url.texi, descrip.mms, url-file.el, url-gopher.el, url-http.el, url-mail.el, url-misc.el, url-news.el, url-pgp.el, url-wais.el, url.el, urlauth.el: -*** empty log message *** - -* url-parse.el: Initial revision - -* url.el, docomp.el: *** empty log message *** - -* docomp.el, url-gopher.el, url-hash.el, url-http.el, url-mail.el, url-misc.el, url-news.el, url-pgp.el, url-vars.el, url-wais.el, url.el, urlauth.el, url-file.el: -Initial revision - -* descrip.mms: *** empty log message *** - -Wed Sep 20 13:46:55 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: *** empty log message *** - -Mon Sep 18 18:13:14 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: *** empty log message *** - -Sun Sep 17 16:54:09 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: *** empty log message *** - -* url-sysdp.el: -make-hashtable now finds the next highest prime for the initial size. - -* url-sysdp.el: Added def of clrhash - -* url-sysdp.el: *** empty log message *** - -* url-sysdp.el: Added hashtable functions - -Sat Sep 16 01:37:18 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Some MULE stuff - -* mm.el: *** empty log message *** - -Mon Sep 11 14:32:40 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: *** empty log message *** - -Sun Sep 10 23:26:47 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added defvar for x-library-search-path - -Sun Sep 3 18:56:21 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: put in appropriate test clauses for the bulitin viewers that have a -'needsx11' tag present. - -* url-sysdp.el: fixed typo in device-mm-width - -Wed Aug 30 20:25:26 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Applied patch from jbw@cs.bu.edu (Joe Wells) for handling invalid -mailcap entries gracefully - -Sat Aug 26 06:21:20 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added split-string - -Fri Aug 25 18:56:55 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added definition of try-font-name - -* url-sysdp.el: *** empty log message *** - -Wed Aug 23 19:51:43 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Added a default mpeg audio player - -Sat Aug 19 23:26:18 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -* mm.el: Some MULE fixes for mm-insert-file-contents - -* mm.el: -Added image/* -> open %s mapping for external viewer if running under NS - -Sat Aug 12 00:54:10 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: -Always set coding-system to *noconv* in MULE when inserting file contents - -Tue Aug 1 15:54:26 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -Mon Jul 31 04:21:42 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Some NeXT viewers added - -Sun Jul 23 17:12:46 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Moved some less standard extensions (.ai -> postscript, etc) to the -end of the list so that they won'tbe picked up as the default -extension when viewing files. - -Thu Jun 29 14:55:14 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: -Various patches from Katsumi Yamaoka <yamaoka@ga.sony.co.jp> Katsumi Yamaoka <yamaoka@ga.sony.co.jp> for MULE stuff -] - -Tue Jun 27 04:18:13 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -Sun Jun 25 20:03:18 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -* url-sysdp.el: Some more device-* functions - -* url-sysdp.el: More NS problems resolved - -* url-sysdp.el: Fixed problem in w3-device-class on NeXTstep - -* mm.el, url-sysdp.el: -Continue movement to using w3-sysdp.el defined functions instead of -url-* funcs - -Mon Jun 19 12:46:46 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: *** empty log message *** - -* url-sysdp.el: Fixed problem in device-class with arg not being optional - -Sun Jun 18 21:41:36 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: -Fixed bug in emacs-19 version of device-class on non-color displays - -* url-sysdp.el: Rewrote device-class -Added device-pixel-width and device-pixel-height - -* url-sysdp.el: *** empty log message *** - -Sat Jun 17 16:35:46 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Few more bugfixes - -* url-sysdp.el: Fixes for nextstep - -* url-sysdp.el: -Fixed definition of device-class so that it won't choke and die under -NeXTstep. - -Fri Jun 16 01:10:44 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Removed scrollbar functions. - -Wed Jun 14 23:30:43 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: -Changed sysdep-defalias to make sure that 'def' is fboundp if its a -symbol, so that bogus defs of make-frame, etc, are not created in -emacs18 - -* url-sysdp.el: More functions added - -* mm.el: Few things to get a nice clean compile using w3-sysdp - -Tue Jun 13 15:38:32 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: *** empty log message *** - -Mon Jun 12 15:09:51 1995 William Perry <wmperry@cs.indiana.edu> - -* descrip.mms: -Added back in the requiring of w3-wemac - just too much different -stuff between it and even 19.10. - -* descrip.mms: -Added the VMS build file from Richard Levitte <levitte@vms.stacken.kth.se> - -* descrip.mms: Initial revision - -Mon May 29 18:10:13 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Removed lots of function documentation and left it as comments. These -functions are not meant to be seen by everyone, and this saves space -in the .elc files. - -Thu May 25 16:55:24 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Added in a bunch of new file extensions. -VRML stuff turned on by default. - -Mon May 8 16:20:30 1995 William Perry <wmperry@cs.indiana.edu> - -* ssl.el: Initial revision - -Sun May 7 15:58:25 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed typo that made mm-play-sound-file always show up as the sound -player. Ack. - -* base64.el: Made a few performance tweaks (macros) - -* mm.el: mm-parse-args can now take an 'allow-math' flag, so that name/value -pairs can look like '*=', etc. - -* base64.el: Removed dependency on url.el - -* mm.el: Now uses the base64.el package to do decoding - -* base64.el: Initial revision - -Sat May 6 17:14:12 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Reorded text/plain viewers again - -Tue Apr 25 17:39:48 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: More content-transfer-encodings - -* mm.el: New function to decode quoted printable - -Wed Apr 19 03:25:01 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Updated to latest version from XEmacs - -* url-sysdp.el: Removed keywords - -Sun Apr 16 05:14:10 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Changes to mm-parse-args to make it more rfc822-y. - -Fri Apr 14 23:48:49 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Changed keywords - -* md5.el: Added keywords - -* mm.el: Reverse 'passed' list in mm-mime-info to get it back in the original -order. Because the loop through the main list puts them in reversed -order. - -* mm.el: Replaced stupid mistake of using w3-dump-to-disk as a function - -Tue Apr 11 23:11:58 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Added some more stuff from chuck - -Mon Apr 10 21:31:13 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: MM will now play sounds internally if in XEmacs and nas-sound or -native-sound is compiled in. - -Tue Mar 28 15:19:18 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed concat'ing of ints - -Sun Mar 26 05:24:03 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Added default dumper for application/octet-stream - -Sat Mar 25 22:23:46 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixes for emacs 18.59 - -* url-sysdp.el: A few new functions for the latest and greatest beta - -Thu Mar 16 16:56:59 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -* mm.el: Fixed viewers once and for all. - -* mm.el: -Fixed unencoding of mime viewers when requesting the entire viewer data. - -* md5.el: Initial revision - -Mon Mar 13 05:51:41 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Lots and lots of doc fixes to meet FSF/GNU guidelines. - -* mm.el: Few doc string fixes - -Sat Mar 11 21:41:47 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: -Fixed mm-mime-info so that it returns the correctly unescaped mime viewer - -Wed Mar 1 16:22:46 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: Removed function call causing problems - -Sat Feb 25 22:23:46 1995 William Perry <wmperry@cs.indiana.edu> - -* url-sysdp.el: -Removed anonymous lambda without 'function' wrapper for WinEmacs and -early versoins of lucid emacs. - -Sat Feb 18 19:15:37 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed a few compilation warnings. - -* url-sysdp.el: Initial revision - -Sun Feb 5 17:12:25 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -* mm.el: Rewrote how viewers are chosen if more than one passes its test. Use -sort, with funky function. Basically, fully-specified MIME types with -lisp viewers take precedence, then lisp-viewers, then fully-specified. - -* mm.el: Added a few more default viewers - -Sat Jan 28 06:49:34 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Added headers for finder package - -Thu Jan 26 04:56:08 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Removed some more dependencies on w3. - -Mon Jan 23 16:15:15 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Few changes to how it writes into mm-mime-data - -Sat Jan 21 17:50:04 1995 William Perry <wmperry@cs.indiana.edu> - -* mm.el: replaced all occurances of htmlplus with html - -Mon Dec 26 05:15:28 1994 William Perry <wmperry@cs.indiana.edu> - -* url.texi: *** empty log message *** - -* mm.el: Updated copyright notices for 1995 - -Sun Dec 25 18:36:53 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Added default viewer for text/enriched. - -* mm.el: Added in checks for windows-nt system-type when figuring out the path -separator char. - -Sat Dec 24 20:11:57 1994 William Perry <wmperry@cs.indiana.edu> - -* url.texi: *** empty log message *** - -Mon Dec 12 05:25:46 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Changed lots of the version variables so that they don't rely on -having the RCS headers in them. - -Sun Dec 11 07:18:44 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Added new function mm-type-to-file that will take a MIME-type as its -argument and return the file spec. - -Mon Nov 28 17:11:38 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: More misc. name changes - -Wed Nov 2 17:02:24 1994 William Perry <wmperry@cs.indiana.edu> - -* url.texi: *** empty log message *** - -* mm.el: Let the variable shell-file-name take precedence over environment -variables and guessing - -* url.texi: Initial revision - -Fri Sep 16 17:18:03 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Lots of little fixes - -Sun Aug 21 14:20:50 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed problem on ms-dos/ms-windows systems where I was still using : -as the path separator instead of ; - -Sun Aug 14 20:11:45 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: More fixes to work under DOS/Windows - -Sat Aug 6 15:51:17 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -* mm.el: New viewer for multipart/* messages. - -Mon Aug 1 13:43:43 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Lots more default mime viewers - -Sun Jul 24 19:32:43 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: New defaults for x-gzip and a few multipart styles. - -* mm.el: Changed mm-possible-viewers to return a sorted list. Favors exact -matches (text/html) before wildcard (text/h* or text/*) - -* mm.el: Changed all references to wmperry@indiana.edu to use w3-bug-address -instead. Changed all copyright notices to use my new email address -also. - -* mm.el: Don't show messages about 'couldn't read xxx' - -Sat Jul 23 19:49:05 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed problem with 'test' clause of mm-mime-info - -Thu Jul 14 03:16:00 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -Wed Jul 13 05:07:38 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -Mon Jul 11 05:27:46 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -Sun Jul 10 18:52:08 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Changed where ~/.mailcap comes in the default MAILCAPS entry, so that -it takes precedence over the others in mm-mime-data - -Mon Jul 4 17:38:52 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Various patches from Alastair Burt - -Sat May 28 12:03:42 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: mm-mime-info now favors the embedded lisp functions/lists when -retrieving mailcap data. This way things will go into -w3-prepare-buffer even if text/html is redefined in the mailcap file. - -Fri May 27 13:44:56 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed problem with mm-unescape-mime-test when it tried to take a -symbol or list as a parameter. - -Wed May 25 11:48:20 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Downcase a file extension before looking in the assoc list for it. - -* mm.el: Always add new viewers onto the list, but don't replace them. - -Wed May 18 18:53:17 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Fixed problem with passing nil to mm-mime-info - -Tue May 17 20:55:51 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Properly unescape \; in viewers/composers/etc. - -* mm.el: Lots of changes, especially regarding mm-unescape-mime-tester - -Sun May 15 18:50:37 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: *** empty log message *** - -* mm.el: Added a few more default content-type bindings - -* mm.el: Added in extension-to-mime parsing/mapping. Also put in some decent -defaults for the common mime types. - -* mm.el: *** empty log message *** - -* mm.el: Correctly checks for the default info if no viewer is matching -content-type is found - -Sat May 14 20:33:50 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Lots of little tweaks. - -Fri May 13 22:06:10 1994 William Perry <wmperry@cs.indiana.edu> - -* mm.el: Initial revision -
--- a/lisp/url/Makefile Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,120 +0,0 @@ -# Temp file to use to build .elc files -ELISP-TO-COMPILE = /tmp/elc-url-${USER} - -# what emacs is called on your system -EMACS = emacs - -# where the Info file should go -INFODIR = . - -# where the lisp files will be installed. -LISPDIR = $$HOME/lisp - -# Change this to be where your .emacs file is stored -DOTEMACS = $$HOME/.emacs - -# Change this to be how to convert texinfo files into info files -# examples: -# MAKEINFO = $(EMACS) -batch -q -f batch-texinfo-format -# MAKEINFO = makeinfo -MAKEINFO = makeinfo - -# Where your version of 'install' lives -INSTALL = install - -# Various other stuff used -RM = rm -f -CP = cp -############## no user servicable parts beyond this point ################### -MAJOR=1 -MINOR=0 - -# Have to preload a few things to get a nice clean compile -DEPS = -l ./url-vars.el -l ./docomp.el - -# compile with noninteractive and relatively clean environment -BATCHFLAGS = -batch -q -no-site-file - -# What type of version this is - beta or normal -VTYPE = p -DIRNAME = url - -.SUFFIXES: .elc .el .el,v - -.el.elc: - $(EMACS) $(BATCHFLAGS) $(DEPS) -f batch-byte-compile $< - -OBJECTS = \ - url-file.elc \ - url-nfs.elc \ - url-cookie.elc \ - url-irc.elc \ - url-parse.elc \ - url-gopher.elc \ - url-hash.elc \ - url-http.elc \ - url-mail.elc \ - url-misc.elc \ - url-news.elc \ - url-pgp.elc \ - url-vars.elc \ - url-wais.elc \ - urlauth.elc \ - mm.elc \ - md5.elc \ - ssl.elc \ - base64.elc \ - url.elc - -SOURCES = \ - docomp.el \ - url-nfs.el \ - url-sysdp.el \ - url-file.el \ - url-cookie.el \ - url-parse.el \ - url-irc.el \ - url-gopher.el \ - url-hash.el \ - url-http.el \ - url-mail.el \ - url-misc.el \ - url-news.el \ - url-pgp.el \ - url-vars.el \ - url-wais.el \ - urlauth.el \ - mm.el \ - md5.el \ - ssl.el \ - base64.el \ - url.el - -DISTFILES = $(SOURCES) descrip.mms - -url: docomp.el $(OBJECTS) - @echo Build of url complete... - -clean: - rm -f $(OBJECTS) - -url.html: url.texi - @texi2html -menu -split_node -verbose url.texi - -url.info: url.texi - @$(MAKEINFO) url.texi - -url.dvi: url.texi - @tex url.texi - @texindex url.cp url.fn url.ky url.pg url.tp url.vr - @tex url.texi - @rm -f url.cp url.fn url.ky url.pg url.tp url.vr \ - url.cps url.fns url.kys url.pgs url.tps url.vrs \ - url.log url.toc url.aux - -install: url - @echo Installing in $(LISPDIR) - $(INSTALL) -d $(LISPDIR) - $(INSTALL) -m 644 $(SOURCES) $(OBJECTS) $(LISPDIR) -# $(INSTALL) -d $(INFODIR) -# $(INSTALL) -m 644 url.info* $(INFODIR)
--- a/lisp/url/base64.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,171 +0,0 @@ -;;; base64.el,v --- Base64 encoding functions -;; Author: wmperry -;; Created: 1996/04/22 15:08:08 -;; Version: 1.7 -;; Keywords: extensions - -;;; LCD Archive Entry: -;;; base64.el|William M. Perry|wmperry@spry.com| -;;; Package for encoding/decoding base64 data (MIME)| -;;; 1996/04/22 15:08:08|1.7|Location Undetermined -;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Base 64 encoding functions -;;; This code was converted to lisp code by me from the C code in -;;; ftp://cs.utk.edu/pub/MIME/b64encode.c -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar base64-code-string - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" - "Character set used for base64 decoding") - -(defvar base64-decode-vector - (let ((vec (make-vector 256 nil)) - (i 0) - (case-fold-search nil)) - (while (< i 256) - (aset vec i (string-match (regexp-quote (char-to-string i)) - base64-code-string)) - (setq i (1+ i))) - vec)) - -(defvar base64-max-line-length 64) - -;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63))) -;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63))) -;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63))) -;(defun b3 (x) (aref base64-code-string (logand x 63))) - -(defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63)))) -(defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63)))) -(defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63)))) -(defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63)))) - -(defun base64-encode (str) - "Do base64 encoding on string STR and return the encoded string. -This code was converted to lisp code by me from the C code in -ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns a string that is -broken into `base64-max-line-length' byte lines." - (or str (setq str (buffer-string))) - (let ((x (base64-encode-internal str)) - (y "")) - (while (> (length x) base64-max-line-length) - (setq y (concat y (substring x 0 base64-max-line-length) "\n") - x (substring x base64-max-line-length nil))) - (setq y (concat y x)) - y)) - -(defun base64-encode-internal (str) - "Do base64 encoding on string STR and return the encoded string. -This code was converted to lisp code by me from the C code in -ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns the entire string, -not broken up into `base64-max-line-length' byte lines." - (let ( - (word 0) ; The word to translate - w1 w2 w3 - ) - (cond - ((> (length str) 3) - (concat - (base64-encode-internal (substring str 0 3)) - (base64-encode-internal (substring str 3 nil)))) - ((= (length str) 3) - (setq w1 (aref str 0) - w2 (aref str 1) - w3 (aref str 2) - word (logior - (lsh (logand w1 255) 16) - (lsh (logand w2 255) 8) - (logand w3 255))) - (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word))) - ((= (length str) 2) - (setq w1 (aref str 0) - w2 (aref str 1) - word (logior - (lsh (logand w1 255) 16) - (lsh (logand w2 255) 8) - 0)) - (format "%c%c%c=" (b0 word) (b1 word) (b2 word))) - ((= (length str) 1) - (setq w1 (aref str 0) - word (logior - (lsh (logand w1 255) 16) - 0)) - (format "%c%c==" (b0 word) (b1 word))) - (t "")))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Base64 decoding functions -;;; Most of the decoding code is courtesy Francesco Potorti` -;;; <F.Potorti@cnuce.cnr.it> -;;; this is much faster than my original code - thanks! -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun base64-decode-region (beg end) - (interactive "r") - (barf-if-buffer-read-only) - (let - ((exchange (= (point) beg)) - (endchars 0) - (list) (code)) - (goto-char beg) - (while (< (point) end) - (setq list (mapcar - (function - (lambda (c) - (cond - ((aref base64-decode-vector c)) - ((char-equal c ?=) - (setq endchars (1+ endchars)) - 0) - (nil - (error - "Character %c does not match Mime base64 coding" c))))) - (buffer-substring (point) (+ (point) 4)))) - (setq code (+ (nth 3 list) (lsh (nth 2 list) 6) - (lsh (nth 1 list) 12) (lsh (car list) 18))) - (delete-char 4) - (cond - ((zerop endchars) - (insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256))) - ((= endchars 1) - (insert (% (lsh code -16) 256) (% (lsh code -8) 256)) - (setq end (point))) - ((= endchars 2) - (insert (% (lsh code -16) 256)) - (setq end (point)))) - (if (char-equal (following-char) ?\n) - (progn (delete-char 1) - (setq end (- end 2))) - (setq end (1- end)))) - )) -; (if exchange -; (exchange-point-and-mark)))) - -(defun base64-decode (st &optional nd) - "Do base64 decoding on string STR and return the original string. -If given buffer positions, destructively decodes that area of the -current buffer." - (let ((replace-p nil) - (retval nil)) - (if (stringp st) - nil - (setq st (prog1 - (buffer-substring st (or nd (point-max))) - (delete-region st (or nd (point-max)))) - replace-p t)) - (setq retval - (save-excursion - (set-buffer (get-buffer-create " *b64decode*")) - (erase-buffer) - (insert st) - (goto-char (point-min)) - (while (re-search-forward "\r*\n" nil t) - (replace-match "")) - (goto-char (point-min)) - (base64-decode-region (point-min) (point-max)) - (buffer-string))) - (if replace-p (insert retval)) - retval)) - -(provide 'base64)
--- a/lisp/url/docomp.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,42 +0,0 @@ -(setq load-path (cons (expand-file-name "./") load-path)) - -(defun url-declare-variables (&rest args) - (while args - (eval (list 'defvar (car args) nil "")) - (setq args (cdr args)))) - -;; Various internals -(url-declare-variables 'proxy-info 'mm-mime-data - 'mm-content-transfer-encodings) - -;; For Emacs 19 -(url-declare-variables 'track-mouse 'menu-bar-help-menu) - -;; For MULE -(url-declare-variables '*noconv* '*autoconv* '*euc-japan* '*internal* - 'file-coding-system-for-read 'file-coding-system) - -;; For Mailcrypt -(url-declare-variables 'mc-pgp-path 'mc-pgp-key-begin-line 'mc-ripem-pubkeyfile - 'mc-default-scheme 'mc-flag) - -;; For NNTP -(url-declare-variables 'nntp-server-buffer 'nntp-server-process - 'nntp/connection 'gnus-nntp-server - 'nntp-server-name 'nntp-version - 'gnus-default-nntp-server) - -;; For ps-print -(url-declare-variables 'ps-bold-faces 'ps-italic-faces 'ps-print-version) - -;; For xpm-button -(url-declare-variables 'x-library-search-path) - -(url-declare-variables 'command-line-args-left 'standard-display-table) - -(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)) - -(require 'url-vars)
--- a/lisp/url/md5.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,409 +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 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) - (or shell-file-name "/bin/sh") - t (current-buffer) nil - "-c" 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. - (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@spry.com -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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) - (or shell-file-name "/bin/sh") - t buffer nil - "-c" 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 (kill-buffer buffer) nil)))) - -(provide 'md5) - -;;; md5.el ends here ----------------------------------------------------------
--- a/lisp/url/mm.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1270 +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 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, 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)) - -(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) - -;;; This is so we can use a consistent method of checking for mule support -;;; Emacs-based mule uses (boundp 'MULE), but XEmacs-based mule uses -;;; (featurep 'mule) - I choose to use the latter. - -(if (boundp 'MULE) - (provide 'mule)) - -(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" . ( - ("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"))) - ("x-www-pem-reply" . - (("viewer" . (w3-decode-pgp/pem "pem")) - ("test" . (fboundp 'w3-decode-pgp/pem)) - ("type" . "application/x-www-pem-reply") - )) - ("x-www-pgp-reply" . - (("viewer" . (w3-decode-pgp/pem "pgp")) - ("test" . (fboundp 'w3-decode-pgp/pem)) - ("type" . "application/x-www-pgp-reply"))) - )) - ("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) - ("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 "/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)))) - -(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) - (if (featurep 'mule) - (let ((mc-flag t)) - (write-region (point-min) (point-max) file nil nil *noconv*)) - (write-region (point-min) (point-max) file)) - (kill-buffer (current-buffer)))) - (fset 'mm-save-binary-file 'w3-save-binary-file)) - -(if (not (fboundp 'w3-maybe-eval)) - (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))) - (fset 'mm-maybe-eval 'w3-maybe-eval)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; 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 (concat "/etc/mailcap:/usr/etc/mailcap:" - "/usr/local/etc/mailcap:" - (expand-file-name "~/.mailcap"))))) - (let ((fnames (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))) - 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 "/bin/sh" nil nil nil "-c" 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") - (".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 (concat (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 (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 (= (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 (or shell-file-name - (getenv "ESHELL") (getenv "SHELL") "/bin/sh") - nil (if usef nil buff) nil "-c" 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 - (if (featurep 'mule) - (write-region (point-min) (point-max) fname nil nil *noconv*) - (write-region (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)) - (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)))))))))))) - -;; 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)
--- a/lisp/url/ssl.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -;;; ssl.el,v --- ssl functions for emacsen without them builtin -;; Author: wmperry -;; Created: 1996/05/28 01:20:06 -;; Version: 1.2 -;; Keywords: comm - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar ssl-program-name "ssl %s %s" - "*The program to run in a subprocess to open an SSL connection. -This is run through `format' with two strings, the hostname and port # -to connect to.") - -(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." - (let ((proc (start-process name buffer - "/bin/sh" - "-c" - (format ssl-program-name host - (if (stringp service) - service - (int-to-string service)))))) - (process-kill-without-query proc) - proc)) - -(provide 'ssl)
--- a/lisp/url/url-cookie.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,350 +0,0 @@ -;;; url-cookie.el,v --- Netscape Cookie support -;; Author: wmperry -;; Created: 1996/06/05 14:31:40 -;; Version: 1.9 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@spry.com) ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'timezone) -(require 'cl) - -(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)) - -(defvar url-cookie-storage nil "Where cookies are stored.") -(defvar url-cookie-secure-storage nil "Where secure cookies are stored.") -(defvar url-cookie-file nil "*Where cookies are stored on disk.") - -(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))) - -(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)))))) - -(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)) - -(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.") - -(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))) - -(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-current-server)) - (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-current-file))) - (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) "]"))) - (cond - ((and (listp url-privacy-level) (memq 'cookies url-privacy-level)) - ;; user never wants cookies - nil) - ((and url-cookie-confirmation - (not (funcall url-confirmation-func - (format "Allow %s to set a cookie? " - url-current-server)))) - ;; user wants to be asked, and declined. - nil) - ((url-cookie-host-can-set-p url-current-server domain) - ;; Cookie is accepted by the user, and passes our security checks - (while rest - (url-cookie-store (car (car rest)) (cdr (car rest)) - expires domain path secure) - (setq rest (cdr rest)))) - (t - (url-warn 'url (format - (concat "%s tried to set a cookie for domain %s\n" - "Permission denied - cookie rejected.\n" - "Set-Cookie: %s") - url-current-server domain str)))))) - -(provide 'url-cookie)
--- a/lisp/url/url-file.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,313 +0,0 @@ -;;; url-file.el,v --- File retrieval code -;; Author: wmperry -;; Created: 1996/05/28 02:46:51 -;; Version: 1.12 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'url-vars) -(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 - (if (featurep 'mule) - *noconv*))) - (setq compressed - (cond - ((file-exists-p fname) nil) - ((file-exists-p (concat fname ".Z")) - (setq fname (concat fname ".Z"))) - ((file-exists-p (concat fname ".gz")) - (setq fname (concat fname ".gz"))) - ((file-exists-p (concat fname ".z")) - (setq fname (concat fname ".z"))) - (t - (error "File not found %s" fname)))) - (if (or (not compressed) url-inhibit-uncompression) - (apply 'insert-file-contents fname args) - (let* ((extn (url-file-extension fname)) - (code (cdr-safe (assoc extn url-uncompressor-alist))) - (decoder (cdr-safe (assoc code mm-content-transfer-encodings)))) - (cond - ((null decoder) - (apply 'insert-file-contents fname args)) - ((stringp decoder) - (apply 'insert-file-contents fname args) - (message "Decoding...") - (call-process-region (point-min) (point-max) decoder t t nil) - (message "Decoding... done.")) - ((listp decoder) - (apply 'call-process-region (point-min) (point-max) - (car decoder) t t t (cdr decoder))) - ((and (symbolp decoder) (fboundp decoder)) - (apply 'insert-file-contents fname args) - (message "Decoding...") - (funcall decoder (point-min) (point-max)) - (message "Decoding... done.")) - (t - (error "Malformed entry for %s in `mm-content-transfer-encodings'" - code)))))) - (set-buffer-modified-p nil)) - -(defun url-format-directory (dir) - ;; Format the files in DIR into hypertext - (let ((files (directory-files dir nil)) file - div attr mod-time size typ title) - (if (and url-directory-index-file - (file-exists-p (expand-file-name url-directory-index-file dir)) - (file-readable-p (expand-file-name url-directory-index-file dir))) - (save-excursion - (set-buffer url-working-buffer) - (erase-buffer) - (insert-file-contents-literally - (expand-file-name url-directory-index-file dir))) - (save-excursion - (if (string-match "/\\([^/]+\\)/$" dir) - (setq title (concat ".../" (url-match dir 1) "/")) - (setq title "/")) - (setq div (1- (length files))) - (set-buffer url-working-buffer) - (erase-buffer) - (insert "<html>\n" - " <head>\n" - " <title>" title "</title>\n" - " </head>\n" - " <body>\n" - " <div>\n" - " <h1 align=center> Index of " title "</h1>\n" - (if url-forms-based-ftp - " <form method=mget enctype=application/batch-fetch>\n" - "") - " <pre>\n" - " Name Last modified Size\n</pre>" - "<hr>\n <pre>\n") - (while files - (url-lazy-message "Building directory list... (%d%%)" - (/ (* 100 (- div (length files))) div)) - (setq file (expand-file-name (car files) dir) - attr (file-attributes file) - file (car files) - mod-time (nth 5 attr) - size (nth 7 attr) - typ (or (mm-extension-to-mime (url-file-extension file)) "")) - (setq file (url-hexify-string file)) - (if (equal '(0 0) mod-time) ; Set to null if unknown or - (setq mod-time "Unknown ") - (setq mod-time (current-time-string mod-time))) - (if (or (equal size 0) (equal size -1) (null size)) - (setq size " -") - (setq size - (cond - ((< size 1024) (concat " " "1K")) - ((< size 1048576) (concat " " - (int-to-string - (max 1 (/ size 1024))) "K")) - (t - (let* ((megs (max 1 (/ size 1048576))) - (kilo (/ (- size (* megs 1048576)) 1024))) - (concat " " (int-to-string megs) - (if (> kilo 0) - (concat "." (int-to-string kilo)) - "") "M")))))) - (cond - ((or (equal "." (car files)) - (equal "/.." (car files))) - nil) - ((equal ".." (car files)) - (if (not (= ?/ (aref file (1- (length file))))) - (setq file (concat file "/"))) - (insert (if url-forms-based-ftp " " "") - "[DIR] <a href=\"" file "\">Parent directory</a>\n")) - ((stringp (nth 0 attr)) ; Symbolic link handling - (insert (if url-forms-based-ftp " " "") - "[LNK] <a href=\"./" file "\">" (car files) "</a>" - (make-string (max 0 (- 25 (length (car files)))) ? ) - mod-time size "\n")) - ((nth 0 attr) ; Directory handling - (insert (if url-forms-based-ftp " " "") - "[DIR] <a href=\"./" file "/\">" (car files) "</a>" - (make-string (max 0 (- 25 (length (car files)))) ? ) - mod-time size "\n")) - ((string-match "image" typ) - (insert (if url-forms-based-ftp - (concat "<input type=checkbox name=file value=\"" - (car files) "\">") - "") - "[IMG] <a href=\"./" file "\">" (car files) "</a>" - (make-string (max 0 (- 25 (length (car files)))) ? ) - mod-time size "\n")) - ((string-match "application" typ) - (insert (if url-forms-based-ftp - (concat "<input type=checkbox name=file value=\"" - (car files) "\">") - "") - "[APP] <a href=\"./" file "\">" (car files) "</a>" - (make-string (max 0 (- 25 (length (car files)))) ? ) - mod-time size "\n")) - ((string-match "text" typ) - (insert (if url-forms-based-ftp - (concat "<input type=checkbox name=file value=\"" - (car files) "\">") - "") - "[TXT] <a href=\"./" file "\">" (car files) "</a>" - (make-string (max 0 (- 25 (length (car files)))) ? ) - mod-time size "\n")) - (t - (insert (if url-forms-based-ftp - (concat "<input type=checkbox name=file value=\"" - (car files) "\">") - "") - "[UNK] <a href=\"./" file "\">" (car files) "</a>" - (make-string (max 0 (- 25 (length (car files)))) ? ) - mod-time size "\n"))) - (setq files (cdr files))) - (insert " </pre>\n" - (if url-forms-based-ftp - (concat " <input type=submit value=\"Copy files\">\n" - " </form>\n") - "") - " </div>\n" - " </body>\n" - "</html>\n" - "<!-- Automatically generated by URL v" url-version - " -->\n"))))) - -(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 (url) - ;; Find a file - (let* ((urlobj (url-generic-parse-url url)) - (user (url-user 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))) - - (if (and file (url-host-is-local-p site) - (memq system-type '(ms-windows ms-dos windows-nt os2))) - (let ((x (1- (length file))) - (y 0)) - (while (<= y x) - (if (= (aref file y) ?\\ ) - (aset file y ?/)) - (setq y (1+ y))))) - - (url-clear-tmp-buffer) - (cond - ((file-directory-p filename) - (if url-use-hypertext-dired - (progn - (if (string-match "/$" filename) - nil - (setq filename (concat filename "/"))) - (if (string-match "/$" file) - nil - (setq file (concat file "/"))) - (url-set-filename urlobj file) - (url-format-directory filename)) - (progn - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (find-file filename)))) - ((and (boundp 'w3-dump-to-disk) (symbol-value 'w3-dump-to-disk)) - (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 - (error "File not found %s" filename))) - (cond - ((url-host-is-local-p site) - (copy-file - filename - (read-file-name "Save to: " nil (url-basepath filename t)) t)) - ((featurep 'ange-ftp) - (ange-ftp-copy-file-internal - filename - (expand-file-name - (read-file-name "Save to: " nil (url-basepath filename t))) t - nil t nil t)) - ((or (featurep 'efs) (featurep 'efs-auto)) - (let ((new (expand-file-name - (read-file-name "Save to: " nil - (url-basepath filename t))))) - (efs-copy-file-internal filename (efs-ftp-path filename) - new (efs-ftp-path new) - t nil 0 nil 0 nil))) - (t (copy-file - filename - (read-file-name "Save to: " nil (url-basepath filename t)) t))) - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer))) - (t - (let ((viewer (mm-mime-info - (mm-extension-to-mime (url-file-extension file)))) - (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)))))))) - (setq url-current-type (if site "ftp" "file") - url-current-object urlobj - url-find-this-link dest - url-current-user user - url-current-server site - url-current-mime-type (mm-extension-to-mime - (url-file-extension file)) - url-current-file file))) - -(fset 'url-ftp 'url-file) - -(provide 'url-file)
--- a/lisp/url/url-gopher.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,476 +0,0 @@ -;;; url-gopher.el,v --- Gopher Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1995/12/02 16:46:12 -;; Version: 1.5 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, 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 ?&) "&") - ((= x ?<) "<"); - ((= x ?>) ">"); - (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-current-file) - (string= "1/" url-current-file) - (string= "1" url-current-file)) - (concat "Gopher root at " url-current-server)) - ((string-match (format "^[%s]+/" url-gopher-types) - url-current-file) - (substring url-current-file 2 nil)) - (t url-current-file)) - "</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) - (setq url-current-file selector - url-current-port port - url-current-server host - url-current-type "gopher") - (if (> (length selector) 0) - (setq selector (substring selector 1 nil))) - (if (stringp proc) - (message "%s" proc) - (save-excursion - (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 "Read %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)) - (url-replace-regexp "\n*Connection closed.*\n*" "") - (url-replace-regexp "\n*Process .*gopher.*\n*" "") - (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> <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) - url-current-file file - url-current-port port - url-current-server host - url-current-type "gopher"))) - -(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 - (string-to-char (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)
--- a/lisp/url/url-hash.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ -;;; url-hash.el,v --- Hashtable functions -;; Author: wmperry -;; Created: 1995/11/17 16:43:12 -;; Version: 1.3 -;; Keywords: lisp - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Hash tables -(cond - ((and (fboundp 'maphash) (subrp (symbol-function 'maphash))) - ;; Builtins! - (defun url-puthash (key val table) - (let ((sym (if (stringp key) (intern key) key))) - (puthash sym val table))) - - (defun url-gethash (key table &optional default) - (let ((sym (if (stringp key) (intern-soft key) key))) - (if (not sym) - default - (gethash sym table)))) - - (mapcar (function - (lambda (sym) - (let ((new-sym (intern (format "url-%s" sym)))) - (defalias new-sym sym)))) - '(make-hashtable - make-key-weak-hashtable - make-value-weak-hashtable - make-weak-hashtable - hashtablep - clrhash - maphash - copy-hashtable))) - (t - (defconst url-hashtable-primes - '(13 29 37 47 59 71 89 107 131 163 197 239 293 353 431 521 631 761 919 - 1103 1327 1597 1931 2333 2801 3371 4049 4861 5839 7013 8419 10103 - 12143 14591 17519 21023 25229 30293 36353 43627 52361 62851 75431 - 90523 108631 130363 156437 187751 225307 270371 324449 389357 467237 - 560689 672827 807403 968897 1162687 1395263 1674319 2009191 2411033 - 2893249) - "A list of some good prime #s to use as sizes for hashtables.") - - (defun url-make-hashtable (size) - "Make a hashtable of initial size SIZE" - (if (not size) (setq size 37)) - (if (not (memq size url-hashtable-primes)) - ;; Find a suitable prime # to use as the hashtable size - (let ((primes url-hashtable-primes)) - (while (<= (car primes) size) - (setq primes (cdr primes))) - (setq size (car primes)))) - (make-vector (or size 2893249) 0)) - - (fset 'url-make-key-weak-hashtable 'url-make-hashtable) - (fset 'url-make-value-weak-hashtable 'url-make-hashtable) - (fset 'url-make-weak-hashtable 'url-make-hashtable) - - (defun url-hashtablep (obj) - "Return t if OBJ is a hashtable, else nil." - (vectorp obj)) - - (defun url-puthash (key val table) - "Hash KEY to VAL in TABLE." - (let ((sym (intern (if (stringp key) key (prin1-to-string key)) table))) - (put sym 'val val) - (put sym 'key key))) - - (defun url-gethash (key table &optional default) - "Find hash value for KEY in TABLE. -If there is no corresponding value, return DEFAULT (defaults to nil)." - (let ((sym (intern-soft (if (stringp key) key (prin1-to-string key)) table))) - (and sym (get sym 'val)))) - - (put 'url-gethash 'sysdep-defined-this t) - - (defun url-clrhash (table) - "Flush TABLE" - (fillarray table 0)) - - (defun url-maphash (function table) - "Map FUNCTION over entries in TABLE, calling it with two args, -each key and value in the table." - (mapatoms - (function - (lambda (sym) - (funcall function (get sym 'key) (get sym 'val)))) table)) - - (defun url-copy-hashtable (old-table) - "Make a new hashtable which contains the same keys and values -as the given table. The keys and values will not themselves be copied." - (copy-sequence old-table)) - )) - -(provide 'url-hash)
--- a/lisp/url/url-http.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,634 +0,0 @@ -;;; url-http.el,v --- HTTP Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1996/05/29 15:07:01 -;; Version: 1.19 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, 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)))) - (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 url-current-server "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 url-current-server - fname - (string-match "https" - url-current-type)) - (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." - (or time (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-extract-from-cache (url-create-cached-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 - ((or (equal "pem" type) (equal "pgp" type)) - (if (string-match "entity=\"\\([^\"]+\\)\"" y) - (url-fetch-with-pgp url-current-file - (url-match y 1) (intern type)) - (error "Could not find entity in %s!" type))) - ((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)) - (url-basic-auth-storage url-proxy-basic-authentication) - (type (downcase (if (string-match "[ \t]" y) - (substring y 0 (match-beginning 0)) - y)))) - (cond - ((or (equal "pem" type) (equal "pgp" type)) - (if (string-match "entity=\"\\([^\"]+\\)\"" y) - (url-fetch-with-pgp url-current-file - (url-match y 1) (intern type)) - (error "Could not find entity in %s!" type))) - ((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) - (setq url-current-type (if (boundp 'url-this-is-ssl) - "https" "http")) - (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 proxy-info - (let ((x (url-generic-parse-url url))) - (setq url-current-server (url-host urlobj) - url-current-port (url-port urlobj) - url-current-file (url-filename urlobj) - url-find-this-link (url-target urlobj) - request (url-create-mime-request file ref-url))) - (setq url-current-server server - url-current-port port - url-current-file file - url-find-this-link dest - request (url-create-mime-request file ref-url))) - (if (or (not (member port url-bad-port-list)) - (funcall url-confirmation-func - (concat - "Warning! Trying to connect to port " - port - " - continue? "))) - (progn - (url-lazy-message "Contacting %s:%s" server port) - (let ((process - (url-open-stream "WWW" url-working-buffer server - (string-to-int port)))) - (if (stringp process) - (progn - (set-buffer url-working-buffer) - (erase-buffer) - (setq url-current-mime-type "text/html" - url-current-mime-viewer - (mm-mime-info "text/html" nil 5)) - (insert "<title>ERROR</title>\n" - "<h1>ERROR - Could not establish connection</h1>" - "<p>" - "The browser could not establish a connection " - (format "to %s:%s.<P>" server port) - "The server is either down, or the URL" - (format "(%s) is malformed.<p>" (url-view-url t))) - (message "%s" process)) - (progn - (process-kill-without-query process) - (process-send-string process request) - (url-lazy-message "Request sent, waiting for response...") - (if url-show-http2-transfer - (progn - (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-shttp (url) - ;; Retrieve a URL via Secure-HTTP - (error "Secure-HTTP not implemented yet.")) - -(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)
--- a/lisp/url/url-irc.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ -;;; url-irc.el --- IRC URL interface -;; Author: wmperry -;; Created: 1996/05/29 15:07:01 -;; Version: 1.19 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'url-vars) -(require 'url-parse) - -(defvar 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") - -(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))) -
--- a/lisp/url/url-mail.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,151 +0,0 @@ -;;; url-mail.el,v --- Mail Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1996/06/03 15:04:49 -;; Version: 1.5 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, 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") - (or (apply 'mail args) - (error "Mail aborted"))) - -(defun url-mailto (url) - ;; Send mail to someone - (if (not (string-match "mailto:/*\\(.*\\)" url)) - (error "Malformed mailto link: %s" url)) - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (let ((to (url-unhex-string - (substring url (match-beginning 1) (match-end 1)))) - (url (url-view-url t))) - (if (fboundp url-mail-command) (funcall url-mail-command) (mail)) - (mail-to) - (insert (concat to "\nX-URL-From: " url)) - (mail-subject) - (if (not url-request-data) - nil ; Not automatic posting - (insert "Automatic submission from " - url-package-name "/" url-package-version) - (if url-request-extra-headers - (progn - (goto-char (point-min)) - (insert - (mapconcat - (function - (lambda (x) - (concat (capitalize (car x)) ": " (cdr x) "\n"))) - 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)) - (mail-to) - (insert (concat rfc822-addr - (if (and url (not (string= url ""))) - (concat "\nX-URL-From: " url) "") - "\nX-User-Agent: " url-package-name "/" - url-package-version)) - (mail-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) - (concat (capitalize (car x)) ": " (cdr x) "\n"))) - 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)
--- a/lisp/url/url-misc.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,312 +0,0 @@ -;;; url-misc.el,v --- Misc Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1995/11/19 18:46:45 -;; Version: 1.4 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'url-vars) -(require 'url-parse) -(autoload 'Info-goto-node "info" "" t) - -(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 (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 (stringp proc) - (message "%s" proc) - (process-kill-without-query proc) - (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-rlogin (url) - ;; Open up an rlogin connection - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (or (string-match "rlogin:/*\\(.*@\\)*\\([^/]*\\)/*" url) - (error "Malformed RLOGIN URL.")) - (let* ((server (substring url (match-beginning 2) (match-end 2))) - (name (if (match-beginning 1) - (substring url (match-beginning 1) (1- (match-end 1))) - nil)) - (title (format "%s%s" (if name (concat name "@") "") server)) - (thebuf (string-match ":" server)) - (port (if thebuf - (prog1 - (substring server (1+ thebuf) nil) - (setq server (substring server 0 thebuf))) "23"))) - (cond - ((not (eq (device-type) 'tty)) - (apply 'start-process - "htmlsub" - nil - (url-string-to-tokens - (format url-xterm-command title - (if (and url-gateway-local-host-regexp - (string-match url-gateway-local-host-regexp - server)) - url-local-rlogin-prog - url-remote-rlogin-prog) server - (concat "-l " name)) ? ))) - (url-use-transparent - (require 'transparent) - (sit-for 1) - (transparent-window (get-buffer-create - (format "%s%s:%s" (if name (concat name "@") "") - server port)) - (if (and url-gateway-local-host-regexp - (string-match url-gateway-local-host-regexp - server)) - url-local-rlogin-prog - url-remote-rlogin-prog) - (list server "-l" name) nil - "Press any key to return to emacs")) - (t - (terminal-emulator - (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "") - server port)) - (if (and url-gateway-local-host-regexp - (string-match url-gateway-local-host-regexp - server)) - url-local-rlogin-prog - url-remote-rlogin-prog) - (list server "-l" name)))))) - -(defun url-telnet (url) - ;; Open up a telnet connection - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (or (string-match "telnet:/*\\(.*@\\)*\\([^/]*\\)/*" url) - (error "Malformed telnet URL: %s" url)) - (let* ((server (substring url (match-beginning 2) (match-end 2))) - (name (if (match-beginning 1) - (substring url (match-beginning 1) (1- (match-end 1))) - nil)) - (title (format "%s%s" (if name (concat name "@") "") server)) - (thebuf (string-match ":" server)) - (port (if thebuf - (prog1 - (substring server (1+ thebuf) nil) - (setq server (substring server 0 thebuf))) "23"))) - (cond - ((not (eq (device-type) 'tty)) - (apply 'start-process - "htmlsub" - nil - (url-string-to-tokens - (format url-xterm-command title - (if (and url-gateway-local-host-regexp - (string-match url-gateway-local-host-regexp - server)) - url-local-telnet-prog - url-remote-telnet-prog) server port) ? )) - (if name (message "Please log in as %s" name))) - (url-use-transparent - (require 'transparent) - (if name (message "Please log in as %s" name)) - (sit-for 1) - (transparent-window (get-buffer-create - (format "%s%s:%s" (if name (concat name "@") "") - server port)) - (if (and url-gateway-local-host-regexp - (string-match url-gateway-local-host-regexp - server)) - url-local-telnet-prog - url-remote-telnet-prog) - (list server port) nil - "Press any key to return to emacs")) - (t - (terminal-emulator - (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "") - server port)) - (if (and url-gateway-local-host-regexp - (string-match url-gateway-local-host-regexp - server)) - url-local-telnet-prog - url-remote-telnet-prog) - (list server port)) - (if name (message "Please log in as %s" name)))))) - -(defun url-tn3270 (url) - ;; Open up a tn3270 connection - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (string-match "tn3270:/*\\(.*@\\)*\\([^/]*\\)/*" url) - (let* ((server (substring url (match-beginning 2) (match-end 2))) - (name (if (match-beginning 1) - (substring url (match-beginning 1) (1- (match-end 1))) - nil)) - (thebuf (string-match ":" server)) - (title (format "%s%s" (if name (concat name "@") "") server)) - (port (if thebuf - (prog1 - (substring server (1+ thebuf) nil) - (setq server (substring server 0 thebuf))) "23"))) - (cond - ((not (eq (device-type) 'tty)) - (start-process "htmlsub" nil url-xterm-command - "-title" title - "-ut" "-e" url-tn3270-emulator server port) - (if name (message "Please log in as %s" name))) - (url-use-transparent - (require 'transparent) - (if name (message "Please log in as %s" name)) - (sit-for 1) - (transparent-window (get-buffer-create - (format "%s%s:%s" (if name (concat name "@") "") - server port)) - url-tn3270-emulator - (list server port) nil - "Press any key to return to emacs")) - (t - (terminal-emulator - (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "") - server port)) - url-tn3270-emulator - (list server port)) - (if name (message "Please log in as %s" name)))))) - -(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)) - (proxyobj (url-generic-parse-url url-using-proxy))) - (url-http url-using-proxy url) - (setq url-current-type (url-type urlobj) - url-current-user (url-user urlobj) - url-current-port (or (url-port urlobj) - (cdr-safe (assoc url-current-type - url-default-ports))) - url-current-server (url-host urlobj) - url-current-file (url-filename urlobj)))) - -(defun url-x-exec (url) - ;; Handle local execution of scripts. - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (string-match "x-exec:/+\\([^/]+\\)\\(/.*\\)" url) - (let ((process-environment process-environment) - (executable (url-match url 1)) - (path-info (url-match url 2)) - (query-string nil) - (safe-paths url-local-exec-path) - (found nil) - (y nil) - ) - (setq url-current-server executable - url-current-file path-info) - (if (string-match "\\(.*\\)\\?\\(.*\\)" path-info) - (setq query-string (url-match path-info 2) - path-info (url-match path-info 1))) - (while (and safe-paths (not found)) - (setq y (expand-file-name executable (car safe-paths)) - found (and (file-exists-p y) (file-executable-p y) y) - safe-paths (cdr safe-paths))) - (if (not found) - (url-retrieve (concat "www://error/nofile/" executable)) - (setq process-environment - (append - (list - "SERVER_SOFTWARE=x-exec/1.0" - (concat "SERVER_NAME=" (system-name)) - "GATEWAY_INTERFACE=CGI/1.1" - "SERVER_PROTOCOL=HTTP/1.0" - "SERVER_PORT=" - (concat "REQUEST_METHOD=" url-request-method) - (concat "HTTP_ACCEPT=" - (mapconcat - (function - (lambda (x) - (cond - ((= x ?\n) (setq y t) "") - ((= x ?:) (setq y nil) ",") - (t (char-to-string x))))) url-mime-accept-string - "")) - (concat "PATH_INFO=" (url-unhex-string path-info)) - (concat "PATH_TRANSLATED=" (url-unhex-string path-info)) - (concat "SCRIPT_NAME=" executable) - (concat "QUERY_STRING=" (url-unhex-string query-string)) - (concat "REMOTE_HOST=" (system-name))) - (if (assoc "content-type" url-request-extra-headers) - (concat "CONTENT_TYPE=" (cdr - (assoc "content-type" - url-request-extra-headers)))) - (if url-request-data - (concat "CONTENT_LENGTH=" (length url-request-data))) - process-environment)) - (and url-request-data (insert url-request-data)) - (setq y (call-process-region (point-min) (point-max) found t t)) - (goto-char (point-min)) - (delete-region (point) (progn (skip-chars-forward " \t\n") (point))) - (cond - ((url-mime-response-p) nil) ; Its already got an HTTP/1.0 header - ((null y) ; Weird exit status, whassup? - (insert "HTTP/1.0 404 Not Found\n" - "Server: " url-package-name "/x-exec\n")) - ((= 0 y) ; The shell command was successful - (insert "HTTP/1.0 200 Document follows\n" - "Server: " url-package-name "/x-exec\n")) - (t ; Non-zero exit status is bad bad bad - (insert "HTTP/1.0 404 Not Found\n" - "Server: " url-package-name "/x-exec\n")))))) - -(provide 'url-misc)
--- a/lisp/url/url-news.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,290 +0,0 @@ -;;; url-news.el,v --- News Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1996/05/29 15:48:29 -;; Version: 1.9 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'url-vars) -(require 'url-parse) - -(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")) - (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)))) - (setq url-current-file "" - url-current-type "") - (if (or (not (string-match "text/" typ)) - (string-match "text/html" typ)) - nil ; Let natural content-type take over - (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 "September" 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 article (1- (length article)))) - 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) - (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))) - (setq url-current-type "news" - url-current-server host - url-current-user (url-user urlobj) - url-current-port port - url-current-file article))) - -(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))) - (setq url-current-type "news" - url-current-server host - url-current-user (url-user urlobj) - url-current-port port - url-current-file article))) - -(provide 'url-news)
--- a/lisp/url/url-nfs.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -;;; url-nfs.el --- NFS URL interface -;; Author: wmperry -;; Created: 1996/05/29 15:07:01 -;; Version: 1.19 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, 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)))) -
--- a/lisp/url/url-parse.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,189 +0,0 @@ -;;; url-parse.el,v --- Uniform Resource Locator parser -;; Author: wmperry -;; Created: 1996/01/05 17:45:31 -;; Version: 1.8 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, 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 [protocol username password hostname portnumber file reference]" - (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*")) - (erase-buffer) - (insert url) - (goto-char (point-min)) - (set-syntax-table url-mailserver-syntax-table) - (let ((save-pos (point)) - (prot nil) - (user nil) - (pass nil) - (host nil) - (port nil) - (file nil) - (refs nil) - (attr nil) - (full nil)) - (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 "^/") - (downcase-region save-pos (point)) - (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 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)
--- a/lisp/url/url-pgp.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,173 +0,0 @@ -;;; url-pgp.el,v --- PGP Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1996/05/24 15:27:10 -;; Version: 1.3 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'url-vars) -(require 'url-parse) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; UUencoding -;;; ---------- -;;; These functions are needed for the (RI)PEM encoding. PGP can -;;; handle binary data, but (RI)PEM requires that it be uuencoded -;;; first, or it will barf severely. How rude. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-uuencode-buffer (&optional buff) - "UUencode buffer BUFF, with a default of the current buffer." - (setq buff (or buff (current-buffer))) - (save-excursion - (set-buffer buff) - (url-lazy-message "UUencoding...") - (call-process-region (point-min) (point-max) - url-uuencode-program t t nil "url-temp-file") - (url-lazy-message "UUencoding... done."))) - -(defun url-uudecode-buffer (&optional buff) - "UUdecode buffer BUFF, with a default of the current buffer." - (setq buff (or buff (current-buffer))) - (let ((newname (url-generate-unique-filename))) - (save-excursion - (set-buffer buff) - (goto-char (point-min)) - (re-search-forward "^begin [0-9][0-9][0-9] \\(.*\\)$" nil t) - (replace-match (concat "begin 600 " newname)) - (url-lazy-message "UUdecoding...") - (call-process-region (point-min) (point-max) url-uudecode-program) - (url-lazy-message "UUdecoding...") - (erase-buffer) - (insert-file-contents-literally newname) - (url-lazy-message "UUdecoding... done.") - (condition-case () - (delete-file newname) - (error nil))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Decoding PGP/PEM responses -;;; -------------------------- -;;; A PGP/PEM encrypted/signed response contains all the real headers, -;;; so this is just a quick decrypt-then-reparse hack. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-decode-pgp/pem (arg) - "Decode a pgp/pem response from an HTTP/1.0 server. -This expects the decoded message to contain all the necessary HTTP/1.0 headers -to correctly act on the decoded message (new content-type, etc)." - (mc-decrypt-message) - (url-parse-mime-headers)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; PGP/PEM Encryption -;;; ------------------ -;;; This implements the highly secure PGP/PEM encrypted requests, as -;;; specified by NCSA and CERN. -;;; -;;; The complete online spec of this scheme was done by Tony Sanders -;;; <sanders@bsdi.com>, and can be seen at -;;; http://www.bsdi.com/HTTP:TNG/ripem-http.txt -;;; -;;; This section of code makes use of the EXCELLENT mailcrypt.el -;;; package by Jin S Choi (jsc@mit.edu) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun url-public-key-exists (entity scheme) - "Return t iff a key for ENTITY exists using public key system SCHEME. -ENTITY is the username/hostname combination we are checking for. -SCHEME is a symbol representing what public key encryption program to use. - Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are - recognized." - (let (retval) - (save-excursion - (cond - ((eq 'pgp scheme) ; PGP encryption - (set-buffer (get-buffer-create " *keytmp*")) - (erase-buffer) - (call-process mc-pgp-path nil t nil "+batchmode" "-kxaf" entity) - (goto-char (point-min)) - (setq retval (search-forward mc-pgp-key-begin-line nil t))) - ((eq 'pem scheme) ; PEM encryption - (set-buffer (find-file-noselect mc-ripem-pubkeyfile)) - (goto-char (point-min)) - (setq retval (search-forward entity nil t))) - (t - (url-warn 'security - (format - "Bad value for SCHEME in url-public-key-exists %s" - scheme)))) - (kill-buffer (current-buffer))) - retval)) - -(defun url-get-server-keys (entity &optional scheme) - "Make sure the key for ENTITY exists using SCHEME. -ENTITY is the username/hostname combination to get the info for. - This should be a string you could pass to 'finger'. -SCHEME is a symbol representing what public key encryption program to use. - Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are - recognized." - (or scheme (setq scheme mc-default-scheme)) - (save-excursion - (cond - ((url-public-key-exists entity scheme) nil) - (t - (string-match "\\([^@]+\\)@\\(.*\\)" entity) - (let ((url-working-buffer " *url-get-keys*")) - (url-retrieve (format "gopher://%s:79/0%s/w" (url-match entity 1) - (url-match entity 2))) - (mc-snarf-keys) - (kill-buffer url-working-buffer)))))) - -(defun url-fetch-with-pgp (url recipient type) - "Retrieve a document with public-key authentication. - URL is the url to request from the server. -RECIPIENT is the server's entity name (usually webmaster@host) - TYPE is a symbol representing what public key encryption program to use. - Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are - recognized." - (or noninteractive (require 'mailcrypt)) - (let ((request (url-create-mime-request url "PGP-Redirect")) - (url-request-data nil) - (url-request-extra-headers nil)) - (save-excursion - (url-get-server-keys recipient type) - (set-buffer (get-buffer-create " *url-encryption*")) - (erase-buffer) - (insert "\n\n" mail-header-separator "\n" request) - (mc-encrypt-message recipient type) - (goto-char (point-min)) - (if (re-search-forward (concat "\n" mail-header-separator "\n") nil t) - (delete-region (point-min) (point))) - (setq url-request-data (buffer-string) - url-request-extra-headers - (list (cons "Authorized" (format "%s entity=\"%s\"" - (cond - ((eq type 'pgp) "PGP") - ((eq type 'pem) "PEM")) - url-pgp/pem-entity)) - (cons "Content-type" (format "application/x-www-%s-reply" - (cond - ((eq type 'pgp) "pgp") - ((eq type 'pem) "pem"))))))) - (kill-buffer " *url-encryption*") - (url-retrieve (url-expand-file-name "/") t))) - -(provide 'url-pgp)
--- a/lisp/url/url-sysdp.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,986 +0,0 @@ -;;; sysdep.el --- consolidate Emacs-version dependencies in one file. - -;; Copyright (C) 1995 Ben Wing. - -;; Author: Ben Wing <wing@666.com> -;; Keywords: lisp, tools -;; Version: 0.001 - -;; 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. - -;; DO NOT load this file with `require'. -;; DO NOT put a `provide' statement in this file. - -;; 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.002") - -(if (and (boundp 'sysdep-version) - (not (string-lessp sysdep-version sysdep-potential-version))) - ;; if a more recent version of sysdep was already loaded, - ;; or if the same package is loaded again, don't load. - nil - -(defconst sysdep-version sysdep-potential-version) - -;; 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 ((or (not (fboundp (quote (, function)))) - (get (quote (, function)) 'sysdep-defined-this)) - (put (quote (, function)) 'sysdep-defined-this t) - (defun (, function) (,@ everything-else)))))) - -(defmacro sysdep-defvar (function &rest everything-else) - (` (cond ((or (not (boundp (quote (, function)))) - (get (quote (, function)) 'sysdep-defined-this)) - (put (quote (, function)) 'sysdep-defined-this t) - (defvar (, function) (,@ everything-else)))))) - -(defmacro sysdep-defconst (function &rest everything-else) - (` (cond ((or (not (boundp (quote (, function)))) - (get (quote (, function)) 'sysdep-defined-this)) - (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 (or (not (fboundp (, function))) - (get (, function) 'sysdep-defined-this)) - (, def)) - (put (, function) 'sysdep-defined-this t) - (fset (, function) (, def)))))) - -(defmacro sysdep-defalias (function def) - (` (cond ((and (or (not (fboundp (, function))) - (get (, function) 'sysdep-defined-this)) - (, 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 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 facep (face) - "Return t if X is a face name or an internal face vector." - ;; CAUTION!!! This is Emacs 19.x, for x <= 28, specific - ;; I know of no version of Lucid Emacs or XEmacs that did not have - ;; facep. Even if they did, they are unsupported, so big deal. - (and (or (internal-facep face) - (and (symbolp face) (assq face global-face-data))) - t)) - -(sysdep-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))) - -(sysdep-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))) - -;; 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." - (car-safe (cdr-safe (memq prop plist)))) - -;; Device functions -;; By wmperry@cs.indiana.edu -;; 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. - -(sysdep-defalias 'selected-device 'ignore) -(sysdep-defalias 'device-or-frame-p 'framep) -(sysdep-defalias 'device-console 'ignore) -(sysdep-defalias 'device-sound-enabled-p 'ignore) -(sysdep-defalias 'device-live-p 'frame-live-p) -(sysdep-defalias 'devicep 'framep) -(sysdep-defalias 'frame-device 'identity) -(sysdep-defalias 'redisplay-device 'redraw-frame) -(sysdep-defalias 'redraw-device 'redraw-frame) -(sysdep-defalias 'select-device 'select-frame) -(sysdep-defalias 'set-device-class 'ignore) - -(sysdep-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 display props)) - ((eq type 'x) - (make-frame props)) - ((eq type 'tty) - nil) - (t - (error "Unsupported device-type: %s" type)))) - -(sysdep-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 a 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)) - -(sysdep-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))) - -(sysdep-defun make-x-device (&optional display) - (make-device 'x display)) - -(sysdep-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)) - -(sysdep-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)) - -(sysdep-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))) - -(sysdep-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)))) - -(sysdep-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)) - -(sysdep-defalias 'get-device 'find-device) - -(sysdep-defun device-baud-rate (&optional device) - "Return the output baud rate of DEVICE." - baud-rate) - -(sysdep-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)) - -(sysdep-defun device-name (&optional device) - "Return the name of the specified device." - ;; doesn't handle the 19.29 multiple X display stuff yet - ;; doesn't handle NeXTStep either - (cond - ((null window-system) "stdio") - ((getenv "DISPLAY") - (let ((str (getenv "DISPLAY")) - (x (1- (length (getenv "DISPLAY")))) - (y 0)) - (while (/= y x) - (if (or (= (aref str y) ?:) - (= (aref str y) ?.)) - (aset str y ?-)) - (setq y (1+ y))) - str)) - (t "stdio"))) - -(sysdep-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")) - -(sysdep-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)))))) -(sysdep-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)) - -(sysdep-defvar delete-device-hook nil - "Function or functions to call when a device is deleted. -One argument, the to-be-deleted device.") - -(sysdep-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))))) - -(sysdep-defalias 'device-color-cells - (cond - ((null window-system) 'ignore) - ((fboundp 'display-color-cells) 'display-color-cells) - ((fboundp 'x-display-color-cells) 'x-display-color-cells) - ((fboundp 'ns-display-color-cells) 'ns-display-color-celles) - (t 'ignore))) - -(sysdep-defun try-font-name (fontname &rest args) - (car-safe (x-list-fonts fontname))) - -(sysdep-defalias 'device-pixel-width - (cond - ((and (eq window-system 'x) (fboundp 'x-display-pixel-width)) - 'x-display-pixel-width) - ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-width)) - 'ns-display-pixel-width) - (t 'ignore))) - -(sysdep-defalias 'device-pixel-height - (cond - ((and (eq window-system 'x) (fboundp 'x-display-pixel-height)) - 'x-display-pixel-height) - ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-height)) - 'ns-display-pixel-height) - (t 'ignore))) - -(sysdep-defalias 'device-mm-width - (cond - ((and (eq window-system 'x) (fboundp 'x-display-mm-width)) - 'x-display-mm-width) - ((and (eq window-system 'ns) (fboundp 'ns-display-mm-width)) - 'ns-display-mm-width) - (t 'ignore))) - -(sysdep-defalias 'device-mm-height - (cond - ((and (eq window-system 'x) (fboundp 'x-display-mm-height)) - 'x-display-mm-height) - ((and (eq window-system 'ns) (fboundp 'ns-display-mm-height)) - 'ns-display-mm-height) - (t 'ignore))) - -(sysdep-defalias 'device-bitplanes - (cond - ((and (eq window-system 'x) (fboundp 'x-display-planes)) - 'x-display-planes) - ((and (eq window-system 'ns) (fboundp 'ns-display-planes)) - 'ns-display-planes) - (t 'ignore))) - -(sysdep-defalias 'device-class - (cond - ;; First, Xwindows - ((and (eq window-system 'x) (fboundp 'x-display-visual-class)) - (function - (lambda (&optional device) - (let ((val (symbol-name (x-display-visual-class device)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))))) - ;; Now, Presentation-Manager under OS/2 - ((and (eq window-system 'pm) (fboundp 'pm-display-visual-class)) - (function - (lambda (&optional device) - (let ((val (symbol-name (pm-display-visual-class device)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))))) - ;; A slightly different way of doing it under OS/2 - ((and (eq window-system 'pm) (fboundp 'pm-display-color-p)) - (function - (lambda (&optional device) - (if (pm-display-color-p) - 'color - 'mono)))) - ((fboundp 'number-of-colors) - (function - (lambda (&optional device) - (if (= 2 (number-of-colors)) - 'mono - 'color)))) - ((and (eq window-system 'x) (fboundp 'x-color-p)) - (function - (lambda (&optional device) - (if (x-color-p) - 'color - 'mono)))) - ((and (eq window-system 'ns) (fboundp 'ns-display-visual-class)) - (function - (lambda (&optional device) - (let ((val (symbol-name (ns-display-visual-class)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))))) - (t (function (lambda (&optional device) 'mono))))) - -(sysdep-defun device-class-list () - "Returns a list of valid device classes." - (list 'color 'grayscale 'mono)) - -(sysdep-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))) - -(sysdep-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." - (if (or (cdr-safe (assq 'display (frame-parameters device-or-frame))) - (cdr-safe (assq 'window-id (frame-parameters device-or-frame)))) - window-system - 'tty)) - -(sysdep-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' for a Windows-NT window, -'pm' for an OS/2 Presentation Manager window, -'intuition' for an Amiga screen" - (device-or-frame-type device)) - -(sysdep-defun device-type-list () - "Return a list of valid console types." - (if window-system - (list window-system 'tty) - (list 'tty))) - -(sysdep-defun valid-device-type-p (type) - "Given a TYPE, return t if it is valid." - (memq type (device-type-list))) - - -;; 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. -(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 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) - (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))) - -;; this parenthesis closes the if statement at the top of the file. - -) - -;; DO NOT put a provide statement here. This file should never be -;; loaded with `require'. Use `load-library' instead. - -;;; 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:
--- a/lisp/url/url-vars.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,580 +0,0 @@ -;;; url-vars.el,v --- Variables for Uniform Resource Locator tool -;; Author: wmperry -;; Created: 1996/06/03 15:04:57 -;; Version: 1.13 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst url-version (let ((x "p1.0.41")) - (if (string-match "State: \\([^ \t\n]+\\)" x) - (substring x (match-beginning 1) (match-end 1)) - x)) - "Version # of URL package.") - - -;;; This is so we can use a consistent method of checking for mule support -;;; Emacs-based mule uses (boundp 'MULE), but XEmacs-based mule uses -;;; (featurep 'mule) - I choose to use the latter. - -(if (boundp 'MULE) - (provide 'mule)) - -(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-file - url-current-isindex - url-current-mime-encoding - url-current-mime-headers - url-current-mime-type - url-current-mime-viewer - url-current-object - url-current-port - url-current-referer - url-current-server - url-current-type - url-current-user - )) - -(defvar url-default-retrieval-proc 'url-default-callback - "*The default action to take when an asynchronous retrieval completes.") - -(defvar 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.") - -(defvar url-emacs-minor-version - (if (boundp 'emacs-minor-version) - (symbol-value '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)) - "What minor version of emacs we are using.") - -(defvar url-inhibit-mime-parsing nil - "Whether to parse out (and delete) the MIME headers from a message.") - -(defvar url-forms-based-ftp nil - "*If non-nil, local and remote file access of directories will be shown -as an HTML 3.0 form, allowing downloads of multiple files at once.") - -(defvar url-automatic-caching nil - "*If non-nil, all documents will be automatically cached to the local -disk.") - -(defvar 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.") - -(defvar url-check-md5s nil - "*Whether to check md5s of retrieved documents or not.") - -(defvar url-expected-md5 nil "What md5 we expect to see.") - -(defvar url-broken-resolution nil - "*Whether to use [ange|efs]-ftp-nslookup-host.") - -(defvar url-bug-address "wmperry@spry.com" "Where to send bug reports.") - -(defvar url-cookie-confirmation nil - "*If non-nil, confirmation by the user is required before accepting any -HTTP cookies.") - -(defvar url-personal-mail-address nil - "*Your full email address. This is what is sent to HTTP/1.0 servers as -the FROM field. If not set when url-do-setup is run, it defaults to -the value of url-pgp/pem-entity.") - -(defvar url-mule-retrieval-coding-system (if (featurep 'mule) - (if (boundp '*euc-japan*) - *euc-japan* - 'euc-japan-unix) - nil) - "Coding system for retrieval, used before hexified.") - -(defvar url-mule-no-coding-system (cond - ((and (featurep 'mule) - (string-match "XEmacs" emacs-version)) - 'no-conversion) - ((featurep 'mule) - '*noconv*) - (t nil)) - "*Variable containing a symbol that specifies no coding system is to be used. -Only used if you are in a Mule-enabled Emacsen.") - -(defvar 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 -automatically creating the directory listing.") - -(defvar url-pgp/pem-entity nil - "*The users PGP/PEM id - usually their email address.") - -(defvar url-privacy-level 'none - "*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. -") - -(defvar url-uudecode-program "uudecode" "*The UUdecode executable.") - -(defvar url-uuencode-program "uuencode" "*The UUencode executable.") - -(defvar url-history-list nil "List of urls visited this session.") - -(defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.") - -(defvar 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.") - -(defvar 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.") - -(defvar url-xterm-command "xterm -title %s -ut -e %s %s %s" - "*Command used to start an xterm window.") - -(defvar url-tn3270-emulator "tn3270" - "The client to run in a subprocess to connect to a tn3270 machine.") - -(defvar url-use-transparent nil - "*Whether to use the transparent package by Brian Tompsett instead of -the builtin telnet functions. Using transparent allows you to have full -vt100 emulation in the telnet and tn3270 links.") - -(defvar 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.") - -(defvar url-local-exec-path nil - "*A list of possible locations for x-exec scripts.") - -(defvar url-proxy-services nil - "*An assoc list of access types and servers that gateway them. -Looks like ((\"http\" . \"url://for/proxy/server/\") ....) This is set up -from the ACCESS_proxy environment variables in url-do-setup.") - -(defvar 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.") - -(defvar 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.") - -(defvar url-global-history-timer nil) - -(defvar 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.") - -(defvar 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.") - -(defvar 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" . "ℑ") - ("I" . "ℑ") - ("s" . "&audio;")) - "*An assoc list of gopher types and the graphic entity references to -show when possible.") - -(defvar url-standalone-mode nil "*Rely solely on the cache?") -(defvar url-working-buffer " *URL*" "The buffer to do all the processing in.") -(defvar url-current-annotation nil "URL of document we are annotating...") -(defvar url-current-referer nil "Referer of this page.") -(defvar url-current-content-length nil "Current content length.") -(defvar url-current-file nil "Filename of current document.") -(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-nntp-server nil "What nntp server currently opened.") -(defvar url-current-passwd-count 0 "How many times password has failed.") -(defvar url-current-port nil "Port # of the current document.") -(defvar url-current-server nil "Server of the current document.") -(defvar url-current-user nil "Username for ftp login.") -(defvar url-current-type nil "We currently in http or file mode?") -(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.") - -(defvar 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.") - -(defvar 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.") - -(defvar 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.") -(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.") - -(defvar url-mime-language-string "*/*" - "String to send to the server in the Accept-language: field in -HTTP/1.0 requests.") - -(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.") - -(defvar url-max-password-attempts 5 - "*Maximum number of times a password will be prompted for when a -protected document is denied by the server.") - -(defvar url-wais-to-mime - '( - ("WSRC" . "application/x-wais-source") ; A database description - ("TEXT" . "text/plain") ; plain text - ) - "An assoc list of wais doctypes and their corresponding MIME -content-types.") - -(defvar url-waisq-prog "waisq" - "*Name of the waisq executable on this system. This should be the -waisq program from think.com's wais8-b5.1 distribution.") - -(defvar url-wais-gateway-server "www.ncsa.uiuc.edu" - "*The machine name where the WAIS gateway lives.") - -(defvar url-wais-gateway-port "8001" - "*The port # of the WAIS gateway.") - -(defvar url-temporary-directory "/tmp" "*Where temporary files go.") - -(defvar 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.") - -(defvar url-using-proxy nil - "Either nil or the fully qualified proxy URL in use, e.g. -http://www.domain.com/") - -(defvar 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.") - -(defvar 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.") - -(defvar 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.") - -(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.") - -(defvar url-configuration-directory nil - "*Where the URL configuration files can be found.") - -(defvar 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.") - -(defvar url-connection-retries 5 - "*# of times to try for a connection before bailing. -If for some reason url-open-stream cannot make a connection to a host -right away, it will sit for 1 second, then try again, up to this many -tries.") - -(defvar url-find-this-link nil "Link to go to within a document.") - -(defvar url-show-http2-transfer t - "*Whether to show the total # of bytes, size of file, and percentage -transferred when retrieving a document over HTTP/1.0 and it returns a -valid content-length header. This can mess up some people behind -gateways.") - -(defvar 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: -'program :: Run a program in a subprocess to connect - (examples are itelnet, an expect script, etc) -'native :: Use the native open-network-stream in emacs -'tcp :: Use the excellent tcp.el package from gnus. - This simply does a (require 'tcp), then sets - url-gateway-method to be 'native.") - -(defvar url-gateway-shell-is-telnet nil - "*Whether the login shell of the remote host is telnet.") - -(defvar url-gateway-program-interactive nil - "*Whether url needs to hand-hold the login program on the remote machine.") - -(defvar url-gateway-handholding-login-regexp "ogin:" - "*Regexp for when to send the username to the remote process.") - -(defvar url-gateway-handholding-password-regexp "ord:" - "*Regexp for when to send the password to the remote process.") - -(defvar url-gateway-host-prompt-pattern "^[^#$%>;]*[#$%>;] *" - "*Regexp used to detect when the login is finished on the remote host.") - -(defvar url-gateway-telnet-ready-regexp "Escape character is .*" - "*A regular expression that signifies url-gateway-telnet-program is -ready to accept input.") - -(defvar url-local-rlogin-prog "rlogin" - "*Program for local telnet connections.") - -(defvar url-remote-rlogin-prog "rlogin" - "*Program for remote telnet connections.") - -(defvar url-local-telnet-prog "telnet" - "*Program for local telnet connections.") - -(defvar url-remote-telnet-prog "telnet" - "*Program for remote telnet connections.") - -(defvar url-running-xemacs (string-match "XEmacs" emacs-version) - "*In XEmacs?.") - -(defvar url-gateway-telnet-program "itelnet" - "*Program to run in a subprocess when using gateway-method 'program.") - -(defvar url-gateway-local-host-regexp nil - "*If a host being connected to matches this regexp then the -connection is done natively, otherwise the process is started on -`url-gateway-host' instead.") - -(defvar url-use-hypertext-dired t - "*How to format directory listings. - -If value is non-nil, use directory-files to list them out and -transform them into a hypertext document, then pass it through the -parse like any other document. - -If value nil, just pass the directory off to dired using find-file.") - -(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-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) - -;;; Make OS/2 happy - yeeks -(defvar tcp-binary-process-input-services nil - "*Make OS/2 happy with our CRLF pairs...") - -(provide 'url-vars)
--- a/lisp/url/url-wais.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,249 +0,0 @@ -;;; url-wais.el,v --- WAIS Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1996/05/24 15:27:12 -;; Version: 1.3 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'url-vars) -(require 'url-parse) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; WAIS support -;;; ------------ -;;; Here are even more gross hacks that I call native WAIS support. -;;; This code requires a working waisq program that is fully -;;; compatible with waisq from think.com -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-create-wais-source (server port dbase) - ;; Create a temporary wais source description file. Returns the - ;; file name the description is in. - (let ((x (url-generate-unique-filename)) - (y (get-buffer-create " *waisq-tmp*"))) - (save-excursion - (set-buffer y) - (erase-buffer) - (insert - (format - (concat "(:source\n:version 3\n" - ":ip-name \"%s\"\n:tcp-port %s\n" - ":database-name \"%s\"\n)") - server (if (equal port "") "210" port) dbase)) - (write-region (point-min) (point-max) x nil nil) - (kill-buffer y)) - x)) - -(defun url-wais-stringtoany (str) - ;; Return a wais subelement that specifies STR in any database - (concat "(:any :size " (length str) " :bytes #( " - (mapconcat 'identity str " ") - " ) )")) - -;(defun url-retrieve-wais-docid (server port dbase local-id) -; (call-process "waisretrieve" nil url-working-buffer nil -; (format "%s:%s@%s:%s" (url-unhex-string local-id) -; dbase server port))) - -;(url-retrieve-wais-docid "quake.think.com" "210" "directory-of-servers" -; "0 2608 /proj/wais/wais-sources/vpiej-l.src") -(defun url-retrieve-wais-docid (server port dbase local-id) - ;; Retrieve a wais document. - ;; SERVER is the server the database is on (:ip-name in source description) - ;; PORT is the port number to contact (:tcp-port in the source description) - ;; DBASE is the database name (:database-name in the source description) - ;; LOCAL-ID is the document (:original-local-id in the question description) - (let* ((dbf (url-create-wais-source server port dbase)) - (qstr (format - (concat "(:question :version 2\n" - " :result-documents\n" - " ( (:document-id\n" - " :document\n" - " (:document\n" - " :headline \"\"\n" - " :doc-id\n" - " (:doc-id :original-database %s\n" - " :original-local-id %s )\n" - " :number-of-bytes -1\n" - " :type \"\"\n" - " :source\n" - " (:source-id :filename \"%s\") ) ) ) )") - (url-wais-stringtoany dbase) - (url-wais-stringtoany (url-unhex-string local-id)) - dbf)) - (qf (url-generate-unique-filename))) - (set-buffer (get-buffer-create url-working-buffer)) - (insert qstr) - (write-region (point-min) (point-max) qf nil nil) - (erase-buffer) - (call-process url-waisq-prog nil url-working-buffer nil "-f" qf "-v" "1") - (save-excursion - (set-buffer url-working-buffer) - (setq url-current-file (url-unhex-string local-id))) - (condition-case () - (delete-file dbf) - (error nil)) - (condition-case () - (delete-file qf) - (error nil)))) - -;(url-perform-wais-query "quake.think.com" "210" "directory-of-servers" "SGML") -(defun url-perform-wais-query (server port dbase search) - ;; Perform a wais query. - ;; SERVER is the server the database is on (:ip-name in source description) - ;; PORT is the port number to contact (:tcp-port in the source description) - ;; DBASE is the database name (:database-name in the source description) - ;; SEARCH is the search term (:seed-words in the question description)" - (let ((dbfname (url-create-wais-source server port dbase)) - (qfname (url-generate-unique-filename)) - (results 'url-none-gotten)) - (save-excursion - (url-clear-tmp-buffer) - (insert - (format - (concat "(:question\n" - " :version 2\n" - " :seed-words \"%s\"\n" - " :sourcepath \"" url-temporary-directory "\"\n" - " :sources\n" - " ( (:source-id\n" - " :filename \"%s\"\n" - " )\n" - " )\n" - " :maximum-results 100)\n") - search dbfname)) - (write-region (point-min) (point-max) qfname nil nil) - (erase-buffer) - (call-process url-waisq-prog nil url-working-buffer nil "-g" "-f" qfname) - (set-buffer url-working-buffer) - (erase-buffer) - (setq url-current-server server - url-current-port port - url-current-file dbase) - (insert-file-contents-literally qfname) - (goto-char (point-min)) - (if (re-search-forward "(:question" nil t) - (delete-region (point-min) (match-beginning 0))) - (url-replace-regexp "Process.*finished.*" "") - (subst-char-in-region (point-min) (point-max) 35 32) - (goto-char (point-min)) - (message "Done reading info - parsing results...") - (if (re-search-forward ":result-documents[^(]+" nil t) - (progn - (goto-char (match-end 0)) - (while (eq results 'url-none-gotten) - (condition-case () - (setq results (read (current-buffer))) - (error (progn - (setq results 'url-none-gotten) - (goto-char (match-end 0)))))) - (erase-buffer) - (insert "<title>Results of WAIS search</title>\n" - "<h1>Searched " dbase " for " search "</h1>\n" - "<hr>\n" - "Found <b>" (int-to-string (length results)) - "</b> matches.\n" - "<ol>\n<li>" - (mapconcat 'url-parse-wais-doc-id results "\n<li>") - "\n</ol>\n<hr>\n")) - (message "No results")) - (setq url-current-mime-type "text/html") - (condition-case () - (delete-file qfname) - (error nil)) - (condition-case () - (delete-file dbfname) - (error nil))))) - -(defun url-wais-anytostring (x) - ;; Convert a (:any ....) wais construct back into a string. - (mapconcat 'char-to-string (car (cdr (memq ':bytes x))) "")) - -(defun url-parse-wais-doc-id (x) - ;; Return a list item that points at the doc-id specified by X - (let* ((document (car (cdr (memq ':document x)))) - (doc-id (car (cdr (memq ':doc-id document)))) - (score (car (cdr (memq ':score x)))) - (title (car (cdr (memq ':headline document)))) - (type (car (cdr (memq ':type document)))) - (size (car (cdr (memq ':number-of-bytes document)))) - (server (car (cdr (memq ':original-server doc-id)))) - (dbase (car (cdr (memq ':original-database doc-id)))) - (localid (car (cdr (memq ':original-local-id doc-id)))) - (dist-server (car (cdr (memq ':distributor-server doc-id)))) - (dist-dbase (car (cdr (memq ':distributor-database doc-id)))) - (dist-id (car (cdr (memq ':distributor-local-id doc-id)))) - (copyright (or (car (cdr (memq ':copyright-disposition doc-id))) 0))) - (format "<a href=\"wais://%s:%s/%s/%s/%d/1=%s;2=%s;3=%s;4=%s;5=%s;6=%s;7=%d;\">%s (Score = %s)</a>" - url-current-server url-current-port url-current-file - type size - (url-hexify-string (url-wais-anytostring server)) - (url-hexify-string (url-wais-anytostring dbase)) - (url-hexify-string (url-wais-anytostring localid)) - (url-hexify-string (url-wais-anytostring dist-server)) - (url-hexify-string (url-wais-anytostring dist-dbase)) - (url-hexify-string (url-wais-anytostring dist-id)) - copyright title score))) - -(defun url-grok-wais-href (url) - "Return a list of server, port, database, search-term, doc-id" - (if (string-match "wais:/+\\([^/:]+\\):*\\([^/]*\\)/+\\(.*\\)" url) - (let ((host (url-match url 1)) - (port (url-match url 2)) - (data (url-match url 3))) - (list host port data)) - (make-list 3 nil))) - -(defun url-wais (url) - ;; Retrieve a document via WAIS - (if (and url-wais-gateway-server url-wais-gateway-port) - (url-retrieve - (format "http://%s:%s/%s" - url-wais-gateway-server - url-wais-gateway-port - (substring url (match-end 0) nil))) - (let ((href (url-grok-wais-href url))) - (url-clear-tmp-buffer) - (setq url-current-type "wais" - url-current-server (nth 0 href) - url-current-port (nth 1 href) - url-current-file (nth 2 href)) - (cond - ((string-match "2=\\(.*\\);3=\\([^ ;]+\\)" (nth 2 href)); full link - (url-retrieve-wais-docid (nth 0 href) (nth 1 href) - (url-match (nth 2 href) 1) - (url-match (nth 2 href) 2))) - ((string-match "\\([^\\?]+\\)\\?\\(.*\\)" (nth 2 href)) ; stored query - (url-perform-wais-query (nth 0 href) (nth 1 href) - (url-match (nth 2 href) 1) - (url-match (nth 2 href) 2))) - (t - (insert "<title>WAIS search</title>\n" - "<h1>WAIS search of " (nth 2 href) "</h1>" - "<hr>\n" - (format "<form action=\"%s\" enctype=\"application/x-w3-wais\">\n" url) - "Enter search term: <input name=\"internal-wais\">\n" - "</form>\n" - "<hr>\n")))))) - -(provide 'url-wais) -
--- a/lisp/url/url.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2430 +0,0 @@ -;;; url.el,v --- Uniform Resource Locator retrieval tool -;; Author: wmperry -;; Created: 1996/05/30 13:25:47 -;; Version: 1.52 -;; Keywords: comm, data, processes, hypermedia - -;;; LCD Archive Entry: -;;; url|William M. Perry|wmperry@spry.com| -;;; Major mode for manipulating URLs| -;;; 1996/05/30 13:25:47|1.52|Location Undetermined -;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com) ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(require 'url-vars) -(require 'url-parse) -(require 'urlauth) -(require 'url-cookie) -(require 'mm) -(require 'md5) -(require 'base64) -(require 'url-hash) -(or (featurep 'efs) - (featurep 'efs-auto) - (condition-case () - (require 'ange-ftp) - (error nil))) - -(load-library "url-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-info "url-misc") -(autoload 'url-shttp "url-http") -(autoload 'url-https "url-http") -(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-x-exec "url-misc") -(autoload 'url-news "url-news") -(autoload 'url-nntp "url-news") -(autoload 'url-decode-pgp/pem "url-pgp") -(autoload 'url-wais "url-wais") - -(autoload 'url-save-newsrc "url-news") -(autoload 'url-news-generate-reply-form "url-news") -(autoload 'url-parse-newsrc "url-news") -(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") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; 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 - ((and (string-match "XEmacs\\|Lucid" emacs-version) - (< url-emacs-minor-version 11)) ; Don't load in lemacs 19.10 - nil) - (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 nntp-after-change-function (&rest args) - (save-excursion - (set-buffer nntp-server-buffer) - (message "Read %d bytes" (point-max)))) - -(defun url-percentage (x y) - (if (fboundp 'float) - (round (* 100 (/ x (float y)))) - (/ (* x 100) y))) - -(defun url-after-change-function (&rest args) - ;; The nitty gritty details of messaging the HTTP/1.0 status messages - ;; in the minibuffer." - (if (get-buffer url-working-buffer) - (save-excursion - (set-buffer url-working-buffer) - (let (status-message) - (if url-current-content-length - nil - (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)))))) - (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)))) - (goto-char (point-min)) - (if (re-search-forward "^status:\\([^\r]*\\)" url-current-isindex t) - (progn - (setq status-message (buffer-substring (match-beginning 1) - (match-end 1))) - (replace-match (concat "btatus:" status-message)))) - (goto-char (point-max)) - (cond - (status-message (url-lazy-message "%s" status-message)) - ((and url-current-content-length (> url-current-content-length 1) - url-current-mime-type) - (url-lazy-message "Read %d of %d bytes (%d%%) [%s]" - (point-max) url-current-content-length - (url-percentage (point-max) - url-current-content-length) - url-current-mime-type)) - ((and url-current-content-length (> url-current-content-length 1)) - (url-lazy-message "Read %d of %d bytes (%d%%)" - (point-max) url-current-content-length - (url-percentage (point-max) - url-current-content-length))) - ((and (/= 1 (point-max)) url-current-mime-type) - (url-lazy-message "Read %d bytes. [%s]" (point-max) - url-current-mime-type)) - ((/= 1 (point-max)) - (url-lazy-message "Read %d bytes." (point-max))) - (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: - & ==> & - < ==> < - > ==> > - \" ==> "" - (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)) - '((?\" . """) - (?& . "&") - (?< . "<") - (?> . ">"))))) - (delete-char 1)) - (buffer-string)) - string)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Information information -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar url-process-lookup-table nil) - -(defun url-setup-process-get () - (let ((x nil) - (nativep t)) - (condition-case () - (progn - (setq x (start-process "Test" nil "/bin/sh")) - (get x 'command)) - (error (setq nativep nil))) - (cond - ((fboundp 'process-get) ; Emacs 19.31 w/my hacks - (defun url-process-get (proc prop &optional default) - (or (process-get proc prop) default))) - (nativep ; XEmacs 19.14 w/my hacks - (fset 'url-process-get 'get)) - (t - (defun url-process-get (proc prop &optional default) - (or (plist-get (cdr-safe (assq proc url-process-lookup-table)) prop) - default)))) - (cond - ((fboundp 'process-put) ; Emacs 19.31 w/my hacks - (fset 'url-process-put 'process-put)) - (nativep - (fset 'url-process-put 'put)) - (t - (defun url-process-put (proc prop val) - (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))))))) - (and (processp x) (delete-process x)))) - -(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-list-processes () - (interactive) - (url-gc-process-lookup-table) - (let ((processes (process-list)) - proc len type) - (set-buffer (get-buffer-create "URL Status Display")) - (display-buffer (current-buffer)) - (erase-buffer) - (insert - (eval-when-compile (format "%-40s%-10s%-25s" "URL" "Size" "Type")) "\n" - (eval-when-compile (make-string 75 ?-)) "\n") - (while processes - (setq proc (car processes) - processes (cdr processes)) - (if (url-process-get proc 'url) - (progn - (save-excursion - (set-buffer (process-buffer proc)) - (setq len url-current-content-length - type url-current-mime-type)) - (insert - (format "%-40s%-10d%-25s" (url-process-get proc 'url) - len type))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; 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" - (url-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-current-file)) - 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) - (url-retrieve url) - (setq-default url-be-asynchronous old-asynch))) - (insert-buffer url-working-buffer) - (setq buffer-file-name url) - (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) - (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)) - (if (condition-case () - (string-match "\\(.*\\)#" url) - (error nil)) - (setq url (url-match url 1))) - (while (and bufs (not found)) - (save-excursion - (set-buffer (car bufs)) - (setq found (if (and - (not (equal (buffer-name (car bufs)) - url-working-buffer)) - (memq major-mode '(url-mode w3-mode)) - (equal (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))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Gateway Support -;;; --------------- -;;; Fairly good/complete gateway support -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-kill-process (proc) - "Kill the process PROC - knows about all the various gateway types, -and acts accordingly." - (cond - ((eq url-gateway-method 'native) (delete-process proc)) - ((eq url-gateway-method 'program) (kill-process proc)) - (t (error "Unknown url-gateway-method %s" url-gateway-method)))) - -(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" - (cond - ((memq url-gateway-method '(native ssl program)) (process-status proc)) - (t (error "Unkown url-gateway-method %s" url-gateway-method)))) - -(defun url-open-stream (name buffer host service) - "Open a stream to a host" - (let ((tmp-gateway-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)) - (tcp-binary-process-output-services (if (stringp service) - (list service) - (list service - (int-to-string service))))) - (and (eq url-gateway-method 'tcp) - (require 'tcp) - (setq url-gateway-method 'native - tmp-gateway-method 'native)) - (cond - ((eq tmp-gateway-method 'ssl) - (open-ssl-stream name buffer host service)) - ((eq tmp-gateway-method 'native) - (if url-broken-resolution - (setq host - (cond - ((featurep 'ange-ftp) (ange-ftp-nslookup-host host)) - ((featurep 'efs) (efs-nslookup-host host)) - ((featurep 'efs-auto) (efs-nslookup-host host)) - (t host)))) - (let ((max-retries url-connection-retries) - (cur-retries 0) - (retry t) - (errobj nil) - (conn nil)) - (while (and (not conn) retry) - (condition-case errobj - (setq conn (open-network-stream name buffer host service)) - (error - (url-save-error errobj) - (save-window-excursion - (save-excursion - (switch-to-buffer-other-window " *url-error*") - (shrink-window-if-larger-than-buffer) - (goto-char (point-min)) - (if (and (re-search-forward "in use" nil t) - (< cur-retries max-retries)) - (progn - (setq retry t - cur-retries (1+ cur-retries)) - (sleep-for 0.5)) - (setq cur-retries 0 - retry (funcall url-confirmation-func - (concat "Connection to " host - " failed, retry? ")))) - (kill-buffer (current-buffer))))))) - (if conn - (progn - (if (featurep 'mule) - (save-excursion - (set-buffer (get-buffer-create buffer)) - (setq mc-flag nil) - (if (not url-running-xemacs) - (set-process-coding-system conn *noconv* *noconv*) - (set-process-input-coding-system conn 'no-conversion) - (set-process-output-coding-system conn 'no-conversion)))) - conn) - (error "Unable to connect to %s:%s" host service)))) - ((eq tmp-gateway-method 'program) - (let ((proc (start-process name buffer url-gateway-telnet-program host - (int-to-string service))) - (tmp nil)) - (save-excursion - (set-buffer buffer) - (setq tmp (point)) - (while (not (progn - (goto-char (point-min)) - (re-search-forward - url-gateway-telnet-ready-regexp nil t))) - (url-accept-process-output proc)) - (delete-region tmp (point)) - (goto-char (point-min)) - (if (re-search-forward "connect:" nil t) - (progn - (condition-case () - (delete-process proc) - (error nil)) - (url-replace-regexp ".*connect:.*" "") - nil) - proc)))) - (t (error "Unknown url-gateway-method %s" url-gateway-method))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; 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) - ((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") - ((and (eq system-type 'vax-vms) (device-type)) - "VMS; X11") - ((eq system-type 'vax-vms) "VMS; TTY") - ((eq (device-type) 'x) "X11") - ((eq (device-type) 'ns) "NeXTStep") - ((eq (device-type) 'pm) "OS/2") - ((eq (device-type) 'win32) "Windows; 32bit") - ((eq (device-type) 'tty) "(Unix?); TTY") - (t "UnkownPlatform"))) - - ;; Set up the entity definition for PGP and PEM authentication - (setq url-pgp/pem-entity (or url-pgp/pem-entity - user-mail-address - (format "%s@%s" (user-real-login-name) - (system-name)))) - - (setq url-personal-mail-address (or url-personal-mail-address - url-pgp/pem-entity - user-mail-address)) - - (if (or (memq url-privacy-level '(paranoid high)) - (and (listp url-privacy-level) - (memq 'email url-privacy-level))) - (setq url-personal-mail-address nil)) - - (if (or (eq url-privacy-level 'paranoid) - (and (listp url-privacy-level) - (memq 'os url-privacy-level))) - (setq url-os-type nil) - (let ((vers (emacs-version))) - (if (string-match "(\\([^, )]+\\))$" vers) - (setq url-os-type (url-match vers 1)) - (setq url-os-type (symbol-name system-type)))))) - -(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))) - (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) - ;; Decide what type of process-get to use - ;(url-setup-process-get) - - ;; 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 'rlogin) - (url-register-protocol 'shttp nil nil "80") - (url-register-protocol 'telnet) - (url-register-protocol 'tn3270) - (url-register-protocol 'wais) - (url-register-protocol 'x-exec) - (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 "~/.w3cookies"))) - - (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 "~/.mosaic-global-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 url-use-transparent with decent defaults - (if (not (eq (device-type) 'tty)) - (setq url-use-transparent nil)) - (and url-use-transparent (require 'transparent)) - - ;; 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 - ((boundp '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 - "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))) - -(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-prepare-cache-for-file (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." - - ;; COMMENT: We don't delete directories because that requires - ;; recursively deleting the directories's contents, which might - ;; eliminate a substantial portion of the cache. - - (cond - ((url-cache-file-writable-p file) - t) - ((file-directory-p file) - nil) - (t - (catch 'upcff-tag - (let ((dir (file-name-directory file)) - dir-parent dir-last-component) - (if (string-equal dir file) - ;; *** Should I have a warning here? - ;; FILE must match a pattern like /foo/bar/, indicating it is a - ;; name only suitable for a directory. So presume we won't be - ;; able to overwrite FILE and return nil. - (throw 'upcff-tag nil)) - - ;; Make sure the containing directory exists, or throw a failure - ;; if we can't create it. - (if (file-directory-p dir) - nil - (or (fboundp 'make-directory) - (throw 'upcff-tag nil)) - (make-directory dir t) - ;; make-directory silently fails if there is an obstacle, so - ;; we must verify its results. - (if (file-directory-p dir) - nil - ;; Look at prefixes of the path to find the obstacle that is - ;; stopping us from making the directory. Unfortunately, there - ;; is no portable function in Emacs to find the parent directory - ;; of a *directory*. So this code may not work on VMS. - (while (progn - (if (eq ?/ (aref dir (1- (length dir)))) - (setq dir (substring dir 0 -1)) - ;; Maybe we're on VMS where the syntax is different. - (throw 'upcff-tag nil)) - (setq dir-parent (file-name-directory dir)) - (not (file-directory-p dir-parent))) - (setq dir dir-parent)) - ;; We have found the longest path prefix that exists as a - ;; directory. Deal with any obstacles in this directory. - (if (file-exists-p dir) - (condition-case nil - (delete-file dir) - (error (throw 'upcff-tag nil)))) - (if (file-exists-p dir) - (throw 'upcff-tag nil)) - ;; Try making the directory again. - (setq dir (file-name-directory file)) - (make-directory dir t) - (or (file-directory-p dir) - (throw 'upcff-tag nil)))) - - ;; The containing directory exists. Let's see if there is - ;; something in the way in this directory. - (if (url-cache-file-writable-p file) - (throw 'upcff-tag t) - (condition-case nil - (delete-file file) - (error (throw 'upcff-tag nil)))) - - ;; The return value, if we get this far. - (url-cache-file-writable-p file)))))) - -(defun url-store-in-cache (&optional buff) - "Store buffer BUFF in the cache" - (if (or (not (get-buffer buff)) - (member url-current-type '("www" "about" "https" "shttp" - "news" "mailto")) - (and (member url-current-type '("file" "ftp" nil)) - (not url-current-server)) - ) - nil - (save-excursion - (and buff (set-buffer buff)) - (let* ((fname (url-create-cached-filename (url-view-url t))) - (fname-hdr (concat (if (memq system-type '(ms-windows ms-dos os2)) - (url-file-extension fname t) - fname) ".hdr")) - (info (mapcar (function (lambda (var) - (cons (symbol-name var) - (symbol-value var)))) - '( url-current-content-length - url-current-file - url-current-isindex - url-current-mime-encoding - url-current-mime-headers - url-current-mime-type - url-current-port - url-current-server - url-current-type - url-current-user - )))) - (cond ((and (url-prepare-cache-for-file fname) - (url-prepare-cache-for-file 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))) - ((numberp x) (int-to-string x)) - (t "'???")) "\n"))) - info) - (insert ")\n") - (write-region (point-min) (point-max) fname-hdr nil 5))))))) - - -(defun url-is-cached (url) - "Return non-nil if the URL is cached." - (let* ((fname (url-create-cached-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-create-cached-filename-using-md5 (url) - (if url - (expand-file-name (md5 url) - (concat url-temporary-directory "/" - (user-real-login-name))))) - -(defun url-create-cached-filename (url) - "Return a filename in the local cache for URL" - (if url - (let* ((url url) - (urlobj (if (vectorp url) - url - (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 - (mm-string-to-tokens - (or hostname "localhost") ?.)))))) - (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 "")))) - - (if (and fname (memq system-type '(ms-windows ms-dos windows-nt)) - (string-match "\\([A-Za-z]\\):[/\\]" fname)) - (setq fname (concat (url-match fname 1) "/" - (substring fname (match-end 0))))) - - (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)))) - - ;; Honor hideous 8.3 filename limitations on dos and windows - ;; we don't have to worry about this in Windows NT/95 (or OS/2?) - (if (and fname (memq system-type '(ms-windows ms-dos))) - (let ((base (url-file-extension fname t)) - (ext (url-file-extension fname nil))) - (setq fname (concat (substring base 0 (min 8 (length base))) - (substring ext 0 (min 4 (length ext))))) - (setq host-components - (mapcar - (function - (lambda (x) - (if (> (length x) 8) - (concat - (substring x 0 8) "." - (substring x 8 (min (length x) 11))) - x))) - host-components)))) - - (and fname - (expand-file-name fname - (expand-file-name - (mapconcat 'identity host-components "/") - url-temporary-directory)))))) - -(defun url-extract-from-cache (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-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 ((filename-chars "%.?@a-zA-Z0-9---()_/:~=&") 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 (string-match (concat "[" filename-chars "]") - (char-to-string (following-char))) - (progn - (skip-chars-backward filename-chars) - (setq start (point)) - (skip-chars-forward filename-chars)) - (setq start (point))) - (setq url (if (fboundp 'buffer-substring-no-properties) - (buffer-substring-no-properties start (point)) - (buffer-substring start (point))))) - (if (string-match "^URL:" url) - (setq url (substring url 4 nil))) - (if (string-match "\\.$" url) - (setq url (substring url 0 -1))) - (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 (= x ?\n) "" (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)) - ((and (null 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)))) - -(defun url-hexify-string (str) - "Escape characters in a string" - (if (and (featurep 'mule) str) - (setq str (code-convert-string - str *internal* url-mule-retrieval-coding-system))) - (setq str (mapconcat - (function - (lambda (char) - (if (or (> char ?z) - (< char ?-) - (and (< char ?a) - (> char ?Z)) - (and (< char ?@) - (>= char ?:))) - (if (< char 16) - (upcase (format "%%0%x" char)) - (upcase (format "%%%x" char))) - (char-to-string char)))) 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-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun url-unhex-string (str) - "Remove %XXX embedded spaces, etc in a url" - (setq str (or str "")) - (let ((tmp "")) - (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) - (if (or (= code ?\n) (= code ?\r)) " " (char-to-string code))) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - -(defun url-clean-text () - "Clean up a buffer, removing any excess garbage from a gateway mechanism, -and decoding any MIME content-transfer-encoding used." - (set-buffer url-working-buffer) - (goto-char (point-min)) - (url-replace-regexp "Connection closed by.*" "") - (goto-char (point-min)) - (url-replace-regexp "Process WWW.*" "")) - -(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* ((extn (url-file-extension url-current-file)) - (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))) - (code-3 (and (not code-1) (not code-2) - (cdr-safe (assoc extn url-uncompressor-alist)))) - (done nil) - (default-process-coding-system - (if (featurep 'mule) (cons *noconv* *noconv*)))) - (mapcar - (function - (lambda (code) - (setq decoder (and (not (member code done)) - (cdr-safe - (assoc code mm-content-transfer-encodings))) - done (cons code done)) - (cond - ((null decoder) nil) - ((stringp decoder) - (message "Decoding...") - (call-process-region (point-min) (point-max) decoder t t nil) - (message "Decoding... done.")) - ((listp decoder) - (apply 'call-process-region (point-min) (point-max) - (car decoder) t t nil (cdr decoder))) - ((and (symbolp decoder) (fboundp decoder)) - (message "Decoding...") - (funcall decoder (point-min) (point-max)) - (message "Decoding... done.")) - (t - (error "Bad entry for %s in `mm-content-transfer-encodings'" - code))))) - (list code-1 code-2 code-3)))) - (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) - (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)))))) - ((fboundp 'w3-sentinel) - (set-variable 'w3-working-buffer buf) - (w3-sentinel)) - (t - (message "Retrieval for %s complete." buf)))) - -(defun url-sentinel (proc string) - (if (buffer-name (process-buffer proc)) - (save-excursion - (set-buffer (get-buffer (process-buffer proc))) - (remove-hook 'after-change-functions 'url-after-change-function) - (let ((status nil) - (url-working-buffer (current-buffer))) - (if url-be-asynchronous - (progn - (widen) - (url-clean-text) - (cond - ((and (null proc) (not (get-buffer 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 (mm-extension-to-mime - (url-file-extension - url-current-file)))))) - (if (member status '(401 301 302 303 204)) - nil - (funcall url-default-retrieval-proc (buffer-name))))) - (url-warn 'url (format "Process %s completed with no buffer!" proc)))) - -(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) - (let ((url "")) - (cond - ((equal url-current-type "gopher") - (setq url (format "%s://%s%s/%s" - url-current-type url-current-server - (if (or (null url-current-port) - (string= "70" url-current-port)) "" - (concat ":" url-current-port)) - url-current-file))) - ((equal url-current-type "news") - (setq url (concat "news:" - (if (not (equal url-current-server - url-news-server)) - (concat "//" url-current-server - (if (or (null url-current-port) - (string= "119" url-current-port)) - "" - (concat ":" url-current-port)) "/")) - url-current-file))) - ((equal url-current-type "about") - (setq url (concat "about:" url-current-file))) - ((member url-current-type '("http" "shttp" "https")) - (setq url (format "%s://%s%s/%s" url-current-type url-current-server - (if (or (null url-current-port) - (string= "80" url-current-port)) - "" - (concat ":" url-current-port)) - (if (and url-current-file - (= ?/ (string-to-char url-current-file))) - (substring url-current-file 1 nil) - url-current-file)))) - ((equal url-current-type "ftp") - (setq url (format "%s://%s%s/%s" url-current-type - (if (and url-current-user - (not (string= "anonymous" url-current-user))) - (concat url-current-user "@") "") - url-current-server - (if (and url-current-file - (= ?/ (string-to-char url-current-file))) - (substring url-current-file 1 nil) - url-current-file)))) - ((and (member url-current-type '("file" nil)) url-current-file) - (setq url (format "file:%s" url-current-file))) - ((equal url-current-type "www") - (setq url (format "www:/%s/%s" url-current-server url-current-file))) - (t - (setq url nil))) - (if (not no-show) (message "%s" url) url))) - -(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 (url-make-hashtable 131)) - ;; 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) - (url-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 (url-make-hashtable 131)) - (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) - (url-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 (url-make-hashtable 131)) - (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) - (url-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 (url-make-hashtable 131) - url-history-changed-since-last-save t) - (mapcar (function - (lambda (x) - (url-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)) - (url-maphash (function - (lambda (key value) - (setq count (1+ count)) - (insert "(url-puthash " - (if (stringp key) - (prin1-to-string key) - (concat "\"" (symbol-name 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 (url-make-hashtable %d))\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") - (url-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 (concat (if (stringp url) - url - (symbol-name 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") - (url-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 (concat (if (stringp url) - url - (symbol-name 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") - (url-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 (concat (if (stringp url) - url - (symbol-name 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))) - -(defvar url-external-retrieval-program "www" - "*Name of the external executable to run to retrieve URLs.") - -(defvar url-external-retrieval-args '("-source") - "*A list of arguments to pass to `url-external-retrieval-program' to -retrieve a URL by its HTML source.") - -(defun url-retrieve-externally (url &optional no-cache) - (if (get-buffer 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) - (if (and type urlobj) - (setq url-current-server (url-host urlobj) - url-current-type (url-type urlobj) - url-current-port (url-port urlobj) - url-current-file (url-filename urlobj))) - (if (member url-current-file '("/" "")) - (setq url-current-mime-type "text/html"))))) - -(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)) - "]"))))) - -;;;###autoload -(defun url-cache-expired (url mod) - "Return t iff a cached file has expired." - (if (not (string-match url-nonrelative-link url)) - t - (let* ((urlobj (url-generic-parse-url url)) - (type (url-type urlobj))) - (cond - (url-standalone-mode - (not (file-exists-p (url-create-cached-filename urlobj)))) - ((string= type "http") - (if (not url-standalone-mode) t - (not (file-exists-p (url-create-cached-filename urlobj))))) - ((not (fboundp 'current-time)) - 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))))) - -(defun url-retrieve-internally (url &optional no-cache) - (if (get-buffer url-working-buffer) - (save-excursion - (set-buffer url-working-buffer) - (erase-buffer) - (setq url-current-can-be-cached (not no-cache)) - (set-buffer-modified-p nil))) - (let* ((urlobj (url-generic-parse-url url)) - (type (url-type urlobj)) - (url-using-proxy (and - (url-host urlobj) - (if (assoc "no_proxy" url-proxy-services) - (not (string-match - (cdr - (assoc "no_proxy" url-proxy-services)) - (url-host urlobj))) - t) - (cdr (assoc type url-proxy-services)))) - (handler nil) - (original-url url) - (cached nil) - (tmp url-current-file)) - (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-extract-from-cache - (car-safe - (cdr-safe (assoc (or type "auto") - url-registered-protocols)))) - url (if cached (url-create-cached-filename url) url)) - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-can-be-cached (not no-cache))) -; (if url-be-asynchronous -; (url-download-minor-mode t)) - (if (and handler (fboundp handler)) - (funcall handler url) - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-file tmp) - (erase-buffer) - (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, please " - "<a href=\"mailto://" url-bug-address "\">send me mail.</a>" - "<p><address>William Perry</address><br>" - "<address>" url-bug-address "</address>") - (setq url-current-file "error.html")) - (if (and - (not url-be-asynchronous) - (get-buffer url-working-buffer)) - (progn - (set-buffer url-working-buffer) - (if (not url-current-object) - (setq url-current-object urlobj)) - (url-clean-text))) - (cond - ((equal type "wais") nil) - ((and url-be-asynchronous (not cached) (member type '("http" "proxy"))) - nil) - (url-be-asynchronous - (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"))) - (not url-current-mime-type)) - (if (url-buffer-is-hypertext) - (setq url-current-mime-type "text/html") - (setq url-current-mime-type (mm-extension-to-mime - (url-file-extension - url-current-file))))) - (if (and url-automatic-caching url-current-can-be-cached - (not url-be-asynchronous)) - (save-excursion - (url-store-in-cache url-working-buffer))) - (if (not (url-hashtablep url-global-history-hash-table)) - (setq url-global-history-hash-table (url-make-hashtable 131))) - (if (not (string-match "^about:" original-url)) - (progn - (setq url-history-changed-since-last-save t) - (url-puthash original-url (current-time) - url-global-history-hash-table))) - cached)) - -;;;###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) - (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))) - (if (and expected-md5 url-check-md5s) - (let ((cur-md5 (md5 (current-buffer)))) - (if (not (string= cur-md5 expected-md5)) - (and (not (funcall url-confirmation-func - "MD5s do not match, use anyway? ")) - (error "MD5 error."))))) - 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 (url-recreate-url urlobj)) - url-proxy-services)) - (message "Using a proxy for %s..." protocol))))) - -(provide 'url)
--- a/lisp/url/urlauth.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,305 +0,0 @@ -;;; urlauth.el,v --- Uniform Resource Locator authorization modules -;; Author: wmperry -;; Created: 1995/11/19 01:02:26 -;; Version: 1.3 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.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, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com) ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(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 (or (url-host href) url-current-server)) - (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 (or (url-host href) url-current-server)) - (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.") - -(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))))) - -(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)
--- a/lisp/utils/bench.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/utils/bench.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,8 +1,16 @@ -;;; bench.el --- a crude benchmark for emacsen +;;; bench.el --- benchmarking utility for emacsen + ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. +;; $Id: bench.el,v 1.2 1997/01/11 20:14:12 steve Exp $ +;; $Source: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/utils/Attic/bench.el,v $ +;; $Revision: 1.2 $ +;; $Author: steve $ +;; $Date: 1997/01/11 20:14:12 $ ;; Author: Shane Holder <holder@rsn.hp.com> ;; Adapted-By: Steve Baur <steve@altair.xemacs.org> +;; Further adapted by: Shane Holder <holder@rsn.hp.com> +;; Keywords: internal, maint ;; This file is part of XEmacs. @@ -23,33 +31,332 @@ ;;; Commentary: +;; Adapted from Shane Holder's bench.el by steve@altair.xemacs.org. + ;; To run -;; Extract the shar file in /tmp, or modify bench-large-lisp-file to -;; point to the gnus-bench.el file. -;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or -;; site-file +;; Extract the shar file in /tmp, or modify bench-lisp-file to +;; point to the gnus.el file. +;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or site-file ;; M-x byte-compile-file "/tmp/bench.el" ;; M-x load-file "/tmp/bench.elc" ;; In the scratch buffer (bench 1) + +;; All bench marks must be named bench-mark-<something> +;; Results are put in bench-mark-<something-times which is a list of +;; times for the runs. +;; If the bench mark is not simple then there needs to be a +;; corresponding bench-handler-<something> + ;;; Code: ;; Use elp to profile benchmarks -(require 'elp) -(eval-when-compile (require 'cl)) ; Emacs doesn't have when and cdar +(require 'cl) ;Emacs doesn't have when and cdar + +;----------------------------------------------------------------------------- +(defvar bench-mark-hanoi-times nil) + +(defun bench-handler-hanoi (times) + (let ((start-time)) + (while (> times 0) +; (setq start-time (bench-get-time)) + (bench-mark-hanoi) +; (setq bench-mark-hanoi-times (cons (- (bench-get-time) start-time ) bench-mark-hanoi-times )) + (setq times (- times 1)))) +) + +(defun bench-mark-hanoi () + "How long to complete the tower of hanoi." + (hanoi 4)) + +;----------------------------------------------------------------------------- +(defvar bench-mark-font-lock-buffer nil "buffer used for bench-mark-fontlock") + +(defun bench-handler-font-lock (times) + (setq bench-mark-font-lock-buffer (find-file bench-lisp-file)) + (while (> times 0) + (bench-mark-font-lock) + (font-lock-mode) ; Turn it off + (setq times (- times 1))) + (kill-buffer bench-mark-font-lock-buffer) +) + +(defun bench-mark-font-lock () + "How long to fonitfy a large file." + (font-lock-fontify-buffer) +) + +;----------------------------------------------------------------------------- +(defvar bench-mark-scrolling-buffer nil "buffer used for bench-mark-scrolling") + +(defun bench-handler-scrolling (times) + (setq bench-mark-scrolling-buffer (find-file bench-lisp-file)) + (set-buffer bench-mark-scrolling-buffer) +; (setq scroll-step 1) + (font-lock-mode -1) + (goto-char (point-min)) ;Start at point min + (let ((temp-times times)) + (while (> temp-times 0) + (bench-mark-scrolling-down) + (bench-mark-scrolling-up) + (setq temp-times (- temp-times 1)))) + + (font-lock-fontify-buffer) + + (goto-char (point-min)) ;Start at point min + (let ((temp-times times)) + (while (> temp-times 0) + (bench-mark-scrolling-down-fontified) + (bench-mark-scrolling-up-fontified) + (setq temp-times (- temp-times 1)))) + (kill-buffer bench-mark-scrolling-buffer) +) + +(defun bench-mark-scrolling-down () + "How long does it take to scroll down through a large file. +Expect point to be at point min" + (let ((buffer-read-only t)) + (while (< (point) (point-max)) + (next-line 1) + (sit-for 0)))) -(defconst bench-version 1.0) +(defun bench-mark-scrolling-up () + "How long does it take to scroll up through a large fontified ile." + (let ((buffer-read-only t)) + (while (> (point) (point-min)) + (previous-line 1) + (sit-for 0)))) + +(defun bench-mark-scrolling-down-fontified () + "How long does it take to scroll down through a large fontified file." + (let ((buffer-read-only t)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (next-line 1) + (sit-for 0)))) + +(defun bench-mark-scrolling-up-fontified () + "How long does it take to scroll up through a large fontified ile." + (let ((buffer-read-only t)) + (while (> (point) (point-min)) + (previous-line 1) + (sit-for 0)))) + +;----------------------------------------------------------------------------- + +(defun bench-handler-make-frames (times) + (let ((temp-times times) + (frame)) + (while (> temp-times 0) + (setq frame (bench-mark-make-frame)) ;Make frame + (bench-mark-delete-frame frame) ;Delete frame + (setq temp-times (- temp-times 1)))) + + (let ((temp-times times) + (frames)) + (while (> temp-times 0) + (setq frames (cons (bench-mark-make-multiple-frames) frames)) ;Make frames + (setq temp-times (- temp-times 1))) + + (setq temp-times times) + + (while (> temp-times 0) + (bench-mark-delete-multiple-frames (car frames)) ;Delete frames + (setq frames (cdr frames)) + (setq temp-times (- temp-times 1)))) + +) + +(defun bench-mark-make-frame () + "How quickly can emacs create a new frame." + (make-frame)) + +(defun bench-mark-delete-frame (frame) + "How quickly can emacs create a new frame." + (delete-frame frame)) + +(defun bench-mark-make-multiple-frames () + "How quickly can emacs create a new frame." + (make-frame)) + +(defun bench-mark-delete-multiple-frames (frame) + "How quickly can emacs create a new frame." + (delete-frame frame)) + + +;----------------------------------------------------------------------------- +(defconst bench-mark-make-words-buffer nil) +(defconst bench-mark-make-words-buffer-name "*bench-mark-make-words*") +(defconst bench-mark-make-words-number-of-words 10000) + +(defun bench-handler-make-words (times) + (setq bench-mark-make-words-buffer (get-buffer-create bench-mark-make-words-buffer-name)) + (set-buffer bench-mark-make-words-buffer) + (while (> times 0) + (bench-mark-make-words) + (erase-buffer) + (setq times (- times 1))) + (kill-buffer bench-mark-make-words-buffer) +) -(defconst bench-large-lisp-file "/usr/local/lib/gnus-bench.el" - "Large lisp file to use in benchmarks. -Grab `ftp://ftp.xemacs.org/pub/beta/contrib/gnus-bench.el.gz' for a good -version. Don't install this file with Emacs/XEmacs.") +(defun bench-mark-make-words () + "How long does it take to generate lots of random words." + (let ((tmp-words bench-mark-make-words-number-of-words)) + (while (not (= tmp-words 0)) + (let ((word-len (random 10))) + (while (not (= word-len 0)) + (insert (+ ?a (random 25))) + (setq word-len (- word-len 1)))) + (insert "\n") + (setq tmp-words (- tmp-words 1))))) + +;----------------------------------------------------------------------------- +(defconst bench-mark-sort-words-buffer-name "*bench-mark-sort-words*") +(defconst bench-mark-sort-words-buffer nil) +(defconst bench-mark-sort-words-number-words 10000) + +(defun bench-handler-sort-words (times) + (setq bench-mark-sort-words-buffer (get-buffer-create bench-mark-sort-words-buffer-name)) + (switch-to-buffer bench-mark-sort-words-buffer) + (while (> times 0) + (bench-pre-sort-words) ;Generate the random words + (bench-mark-sort-words) ;Sort those puppies + (erase-buffer) + (setq times (- times 1))) + (kill-buffer bench-mark-sort-words-buffer) +) + +(defun bench-pre-sort-words () + "How long does it take to generate lots of random words." + (let ((tmp-words bench-mark-sort-words-number-words)) + (while (not (= tmp-words 0)) + (let ((word-len (random 10))) + (while (not (= word-len 0)) + (insert (+ ?a (random 25))) + (setq word-len (- word-len 1)))) + (insert "\n") + (setq tmp-words (- tmp-words 1))))) + +(defun bench-mark-sort-words () + (sort-lines nil (point-min) (point-max)) +) + +;----------------------------------------------------------------------------- +; Byte compile a file +(defun bench-handler-byte-compile (times) + (while (> times 0) + (bench-mark-byte-compile) + (setq times (- times 1))) +) + +(defun bench-mark-byte-compile () + "How long does it take to byte-compile a large lisp file" + (byte-compile-file bench-lisp-file) +) + +;----------------------------------------------------------------------------- +; Run through a loop + +(defconst bench-mark-loop-count 250000) + +(defun bench-handler-loop (times) + (while (> times 0) + (bench-mark-loop) + (setq times (- times 1))) +) + +(defun bench-mark-loop () + "How long does it take to run through a loop." + (let ((count bench-mark-loop-count)) + (let ((i 0) (gcount 0)) + (while (< i count) + (increment) + (setq i (1+ i))) + (message "gcount = %d" gcount)))) + +(defun increment () + "Increment a variable for bench-mark-loop." + (setq gcount (1+ gcount))) -(defconst bench-sort-buffer "*Sort*" - "File to be used in the sort benchmark") +;----------------------------------------------------------------------------- +(defconst bench-mark-large-list-list-size 500000 + "Size of list to use in small list creation/garbage collection") +(defconst bench-mark-large-list-num-lists 10) + +(defun bench-handler-large-list (times) + (let ((tmp-foo bench-mark-large-list-num-lists)) + (while (> tmp-foo 0) + (bench-mark-large-list) + (setq tmp-foo (- tmp-foo 1)))) +) + +(defun bench-mark-large-list () + (make-list bench-mark-large-list-list-size '1) +) + +;----------------------------------------------------------------------------- +(defun bench-mark-large-list-garbage-collect (times) + (garbage-collect) +) + +;----------------------------------------------------------------------------- +(defconst bench-mark-small-list-list-size 10 + "Size of list to use in small list creation/garbage collection") + +(defconst bench-mark-small-list-num-lists 100000 + "Number of lists to use in small list creation/garbage collections") + +(defun bench-handler-small-list (times) + (let ((tmp-foo bench-mark-small-list-num-lists)) + (while (> tmp-foo 0) + (bench-mark-small-list) + (setq tmp-foo (- tmp-foo 1))) +)) + +(defun bench-mark-small-list () + (make-list bench-mark-small-list-list-size '1) +) -(defconst bench-sort-number-words 10000 - "Number of words to use in sort benchmark") +;----------------------------------------------------------------------------- +(defun bench-mark-small-list-garbage-collect (times) + (garbage-collect) +) + +;----------------------------------------------------------------------------- +(defconst bench-mark-insert-into-empty-buffer-num-words 100000) + +(defun bench-handler-insert-into-empty-buffer () + (set-buffer (get-buffer-create "*tmp*")) + (bench-mark-insert-into-empty-buffer) + (erase-buffer) + (kill-buffer "*tmp*") +) + +(defun bench-mark-insert-into-empty-buffer () + (let ((a bench-mark-insert-into-empty-buffer-num-words)) + (while (> a 0) + (insert "0123456789\n") + (setq a (1- a)))) +) + +;============================================================================= +(defconst bench-version (let ((rcsvers "$Revision: 1.2 $")) + (substring rcsvers 11 (- (length rcsvers) 2))) + "*Version number of bench.el") + +(defconst temp-dir (file-name-as-directory + (or (getenv "TMPDIR") + (getenv "TMP") + (getenv "TEMP") + "/tmp/"))) + +(defconst bench-large-lisp-file (concat temp-dir "./bench-large.el") + "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el") + +(defconst bench-small-lisp-file (concat temp-dir "./bench-small.el") + "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el") + +(defconst bench-lisp-file bench-large-lisp-file) (defconst bench-pre-bench-hook nil "Hook for individual bench mark initialization.") @@ -59,19 +366,19 @@ (defconst bench-mark-function-alist '( - (bench-mark-1 . "Tower of Hanoi") - (bench-mark-2 . "Font Lock") - (bench-mark-3 . "Large File scrolling") - (bench-mark-4 . "Frame Creation") - (bench-mark-5 . "Generate Words") - (bench-mark-6 . "Sort Buffer") - (bench-mark-7 . "Large File bytecompilation") - (bench-mark-8 . "Loop Computation") - (bench-mark-9 . "Make a Few Large Size List") - (bench-mark-10 . "Garbage Collection Large Size List") - (bench-mark-11 . "Make Several Small Size List") - (bench-mark-12 . "Garbage Collection Small Size List") - (bench-mark-13 . "Append to buffer") + (bench-handler-hanoi . "Tower of Hanoi") + (bench-handler-font-lock . "Font Lock") + (bench-handler-scrolling . "Large File scrolling") + (bench-handler-make-frames . "Frame Creation") + (bench-handler-make-words . "Generate Words") + (bench-handler-sort-words . "Sort Buffer") + (bench-handler-byte-compile . "Large File bytecompilation") + (bench-handler-loop . "Loop Computation") + (bench-handler-large-list . "Make a Few Large Size List") + (bench-mark-large-list-garbage-collect . "Garbage Collection Large Size List") + (bench-handler-small-list . "Make Several Small Size List") + (bench-mark-small-list-garbage-collect . "Garbage Collection Small Size List") + (bench-handler-insert-into-empty-buffer . "Text Insertion") )) (defconst bench-enabled-profiling nil @@ -82,126 +389,18 @@ (setq gc-cons-threshold 40000000) -(defconst bench-number-of-large-lists 10 - "Number of lists to use in large list creation/garbage collections") - -(defconst bench-number-of-small-lists 1000000 - "Number of lists to use in small list creation/garbage collections") - -(defconst bench-large-list-size 1000000 - "Size of list to use in small list creation/garbage collection") - -(defconst bench-small-list-size 10 - "Size of list to use in small list creation/garbage collection") - -;----------------------------------------------------------------------------- -(defun bench-mark-1 () - "How long to complete the tower of hanoi." - (hanoi 4)) - -;----------------------------------------------------------------------------- -(defun bench-mark-2 () - "How long to fonitfy a large file." - (find-file bench-large-lisp-file) - (font-lock-fontify-buffer)) - -;----------------------------------------------------------------------------- -(defun bench-mark-3 () - "How long does it take to scroll down through a large file." - (let ((buffer-read-only t)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (next-line 1) - (sit-for 0)))) - -;----------------------------------------------------------------------------- -(defun bench-mark-4 () - "How quickly can emacs create a new frame." - (make-frame)) - - -;----------------------------------------------------------------------------- -(defun bench-mark-5 () - "How long does it take to generate lots of random words." - (set-buffer (get-buffer-create bench-sort-buffer)) - (let ((tmp-words bench-sort-number-words)) - (while (not (= tmp-words 0)) - (let ((word-len (random 10))) - (while (not (= word-len 0)) - (insert (+ ?a (random 25))) - (setq word-len (- word-len 1)))) - (insert "\n") - (setq tmp-words (- tmp-words 1))))) - -;----------------------------------------------------------------------------- - -(defun bench-mark-6 () - "How long does it take to sort the random words from bench-mark-5." - (set-buffer (get-buffer-create bench-sort-buffer)) - (sort-lines nil (point-min) (point-max)) -) +(defconst bench-small-frame-alist '((height . 24) (width . 80))) +(defconst bench-medium-frame-alist '((height . 48) (width . 80))) +(defconst bench-large-frame-alist '((height . 72) (width . 80))) -;----------------------------------------------------------------------------- -(defun bench-mark-7 () - "How long does it take to byte-compile a large lisp file" - (byte-compile-file bench-large-lisp-file) -) - -;----------------------------------------------------------------------------- -(defun bench-mark-8 () - "How long does it take to run through a loop." - (let ((count 250000)) - (let ((i 0) (gcount 0)) - (while (< i count) - (increment) - (setq i (1+ i))) - (message "gcount = %d" gcount)))) - -(defun increment () - "Increment a variable for bench-mark-8." - (setq gcount (1+ gcount))) - -;----------------------------------------------------------------------------- -(defun bench-mark-9 () - (let ((tmp-foo bench-number-of-large-lists)) - (while (> tmp-foo 0) - (make-list bench-large-list-size '1) - (setq tmp-foo (- tmp-foo 1))) - ) -) +(defsubst bench-get-time () + ;; Stolen from elp + ;; get current time in seconds and microseconds. I throw away the + ;; most significant 16 bits of seconds since I doubt we'll ever want + ;; to profile lisp on the order of 18 hours. See notes at top of file. + (let ((now (current-time))) + (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0)))) -;----------------------------------------------------------------------------- -(defun bench-mark-10 () - (garbage-collect) -) - -;----------------------------------------------------------------------------- -(defun bench-mark-11 () - (let ((tmp-foo bench-number-of-small-lists)) - (while (> tmp-foo 0) - (make-list bench-small-list-size '1) - (setq tmp-foo (- tmp-foo 1)) - )) -) - -;----------------------------------------------------------------------------- -(defun bench-mark-12 () - (garbage-collect) -) - -;----------------------------------------------------------------------------- -(defun bench-mark-13 () - (unwind-protect - (let ((a 100000)) - (set-buffer (get-buffer-create "*tmp*")) - (erase-buffer) - (while (> a 0) - (insert "0123456789\n") - (setq a (1- a)))) - (kill-buffer "*tmp*"))) - - -;============================================================================= (defun bench-init () "Initialize profiling for bench marking package." (if (fboundp 'start-profiling) @@ -210,9 +409,29 @@ (when (profiling-active-p) (stop-profiling) (clear-profiling-info))) - (message "Profiling not available in this Emacs.") + (message "Profiling not available in this XEmacs.") (sit-for 2))) +(defun bench-test-init () + "Initialize profiling for bench marking package." + (if (fboundp 'start-profiling) + (let ((buf (get-buffer-create bench-mark-profile-buffer))) + (erase-buffer buf) + (when (profiling-active-p) + (stop-profiling) + (clear-profiling-info))) + (message "Profiling not available in this XEmacs.") + (sit-for 2)) + (setq bench-lisp-file bench-small-lisp-file) + (setq bench-mark-make-words-number-of-words 100) + (setq bench-mark-sort-words-number-of-words 100) + (setq bench-mark-loop-count 10000) + (setq bench-mark-large-list-list-size 500) + (setq bench-mark-small-list-num-lists 100) + (setq bench-mark-insert-into-empty-buffer-num-words 100) + +) + (defun bench-profile-start (test-name) "Turn on profiling for test `test-name'." (when (and bench-enabled-profiling @@ -240,6 +459,16 @@ (add-hook 'bench-pre-bench-hook 'bench-profile-start) (add-hook 'bench-post-bench-hook 'bench-profile-stop) +(defun bench-post () +"Post processing of elp results" +; I can't figure out a good way to sort the lines numerically. +; If someone comes up with a good way, let me know. + (goto-char (point-min)) + (next-line 2) + (sort-lines nil (point) (point-max)) + (mail-results (current-buffer)) +) + (defun bench (arg) "Run a series of benchmarks." (interactive "p") @@ -248,35 +477,68 @@ (bench-init) (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs (setq byte-optimize nil)) + (if (fboundp 'menu-bar-mode) + (menu-bar-mode -1)) ;Turn off menu-bar (let ((benches bench-mark-function-alist)) (while benches (let ((test-name (cdar benches))) (run-hook-with-args 'bench-pre-bench-hook test-name) - (let ((count arg)) - (while (> count 0) - (message "Running %s - %s." (symbol-name (caar benches)) test-name) - (funcall (caar benches)) - (setq count (1- count)))) + (message "Running %s - %s." (symbol-name (caar benches)) test-name) + (funcall (caar benches) arg) (setq benches (cdr benches)) (run-hook-with-args 'bench-post-bench-hook test-name)) )) (elp-results) - (goto-char (point-min)) - (next-line 2) -; I can't figure out a good way to sort the lines numerically. -; If someone comes up with a good way, let me know. - (sort-lines nil (point) (point-max)) - (goto-char (point-min)) + (bench-post) +) + +(defun bench-test (arg) + "Run all the tests but with smaller values so the tests run quicker. +This way I don't have to sit around to see if the tests complete" + (interactive "p") + (elp-instrument-package "bench-mark") ;Only instrument functions + ;beginning with bench-mark + (bench-test-init) + (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs + (setq byte-optimize nil)) + (if (fboundp 'menu-bar-mode) + (menu-bar-mode -1)) ;Turn off menu-bar (let ((benches bench-mark-function-alist)) (while benches - (goto-char (point-min)) - (let ((test-name (cdar benches)) - (test-func (caar benches))) - (search-forward (symbol-name test-func)) - (end-of-line) - (insert " <= " test-name)) + (let ((test-name (cdar benches))) + (run-hook-with-args 'bench-pre-bench-hook test-name) + (message "Running %s - %s." (symbol-name (caar benches)) test-name) + (funcall (caar benches) arg) (setq benches (cdr benches)) + (run-hook-with-args 'bench-post-bench-hook test-name)) )) + (elp-results) + (bench-post) ) + +(defconst bench-send-results-to "holder@rsn.hp.com") +(defconst bench-subject "Bench Mark Results") +(defconst bench-system-form (format " + +Please fill in as much of the following as you can +and then hit C-cC-c to send. + +CPU Manufacturer (Intel,HP,DEC,etc.): +CPU Type (Pentium,Alpha): +CPU Speed: +RAM (in meg): +Emacs Version: %s +Emacs (version): %s +Compile line: +Bench Version: %s +" emacs-version (emacs-version) bench-version)) + +(defun mail-results (buffer) + (mail nil bench-send-results-to bench-subject) + (sit-for 0) + (goto-char (point-max)) + (insert bench-system-form) + (insert-buffer buffer) +) ;;; bench.el ends here
--- a/lisp/utils/loadhist.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/utils/loadhist.el Mon Aug 13 09:06:37 2007 +0200 @@ -34,6 +34,7 @@ (defun symbol-file (sym) "Return the input source from which SYM was loaded. This is a file name, or nil if the source was a buffer with no associated file." + (interactive "S") ; XEmacs (catch 'foundit (mapcar (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x)))))
--- a/lisp/version.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:06:37 2007 +0200 @@ -25,7 +25,7 @@ (defconst emacs-version "20.0" "Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta34)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta90)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/viper/Makefile Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/Makefile Mon Aug 13 09:06:37 2007 +0200 @@ -30,9 +30,6 @@ VIPERelc = viper-util.elc viper-mous.elc viper-ex.elc viper-macs.elc \ viper-keym.elc viper.elc -PRELOADS = -l viper-util.el -l viper-ex.el -l viper-mous.el \ - -l viper-macs.el -l viper-keym.el -l viper.el - all: dvi info hello elc goodbye elc: $(VIPERelc) @@ -98,23 +95,23 @@ viper-ex.elc: viper-ex.el viper-util.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile viper-ex.el + $(EMACS) -batch -f batch-byte-compile viper-ex.el viper-mous.elc: viper-mous.el viper-util.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile viper-mous.el + $(EMACS) -batch -f batch-byte-compile viper-mous.el viper-macs.elc: viper-macs.el viper-util.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile viper-macs.el + $(EMACS) -batch -f batch-byte-compile viper-macs.el viper-keym.elc: viper-keym.el viper-util.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile viper-keym.el + $(EMACS) -batch -f batch-byte-compile viper-keym.el viper.elc: viper.el viper-util.el @echo "" - $(EMACS) -batch $(PRELOADS) -f batch-byte-compile viper.el + $(EMACS) -batch -f batch-byte-compile viper.el dvi: viper.dvi viperCard.dvi @@ -135,7 +132,7 @@ rm -f *.elc *~ core distclean: clean - + realclean: clean rm -f *.dvi viper.info* rm -f viper.aux viper.cp viper.cps viper.fn viper.fns viper.ky \
--- a/lisp/viper/README Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/README Mon Aug 13 09:06:37 2007 +0200 @@ -111,3 +111,5 @@ viperCard.dvi contain the Viper manual and the quick reference card, respectively. + +
--- a/lisp/viper/viper-ex.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/viper-ex.el Mon Aug 13 09:06:37 2007 +0200 @@ -19,14 +19,34 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;; Code -;; Code +(provide 'viper-ex) + +;; Compiler pacifier +(defvar read-file-name-map) +(defvar vip-use-register) +(defvar vip-s-string) +(defvar vip-shift-width) +(defvar vip-ex-history) +(defvar vip-related-files-and-buffers-ring) +(defvar vip-local-search-start-marker) +(defvar vip-expert-level) +(defvar vip-custom-file-name) +(defvar vip-case-fold-search) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'viper-util) + (load "viper-util.el" nil nil 'nosuffix)) + (or (featurep 'viper-keym) + (load "viper-keym.el" nil nil 'nosuffix)) + )) +;; end pacifier + (require 'viper-util) -;; Compiler pacifier -(defvar read-file-name-map) -;; end compiler pacifier ;;; Variables @@ -285,7 +305,7 @@ ;; A token has a type, \(command, address, end-mark\), and a value (defun vip-get-ex-token () (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (skip-chars-forward " \t|") (cond ((looking-at "#") @@ -421,7 +441,7 @@ "!*"))) (save-window-excursion ;; put cursor at the end of the Ex working buffer - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (goto-char (point-max))) (cond ((vip-looking-back quit-regex1) (exit-minibuffer)) @@ -499,7 +519,7 @@ map))) (save-window-excursion ;; just a precaution - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (delete-region (point-min) (point-max)) (insert com-str "\n") @@ -594,7 +614,7 @@ ;; get an ex command (defun vip-get-ex-command () (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (if (looking-at "/") (forward-char 1)) (skip-chars-forward " \t") @@ -610,7 +630,7 @@ ;; Get an Ex option g or c (defun vip-get-ex-opt-gc (c) (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (if (looking-at (format "%c" c)) (forward-char 1)) (skip-chars-forward " \t") @@ -722,7 +742,7 @@ (setq ex-count nil) (setq ex-flag nil) (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "[a-zA-Z]") @@ -748,7 +768,7 @@ ex-count nil ex-flag nil) (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "!") @@ -810,7 +830,7 @@ ex-cmdfile nil) (save-excursion (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "!") @@ -1183,7 +1203,7 @@ (if ex-offset (progn (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (delete-region (point-min) (point-max)) (insert ex-offset "\n") @@ -1255,7 +1275,7 @@ (forward-line -1) (end-of-line))))) (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) (while marks @@ -1327,7 +1347,7 @@ (setq ex-addresses (cons (point) nil))) (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "[a-z]") @@ -1462,7 +1482,7 @@ (defun ex-quit () ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc. (save-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (if (looking-at "!") (forward-char 1))) (if (< vip-expert-level 3) @@ -1696,7 +1716,7 @@ ;; special meaning (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str) (save-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (goto-char (point-min)) (re-search-forward regex-forw nil t) @@ -1830,7 +1850,7 @@ (defun ex-tag () (let (tag) (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (set-mark (point)) @@ -1907,12 +1927,11 @@ (insert region) (save-buffer) (ex-write-info file-exists ex-file (point-min) (point-max)) - ) - (set-buffer temp-buf) - (set-buffer-modified-p nil) - (kill-buffer temp-buf) - )) - ) + )) + (set-buffer temp-buf) + (set-buffer-modified-p nil) + (kill-buffer temp-buf) + )) ;; this prevents the loss of data if writing part of the buffer (if (and (buffer-file-name) writing-same-file) (set-visited-file-modtime)) @@ -1964,7 +1983,7 @@ (defun ex-command () (let (command) (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) + (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) (set-buffer vip-ex-work-buf) (skip-chars-forward " \t") (setq command (buffer-substring (point) (point-max))) @@ -2024,6 +2043,4 @@ )) -(provide 'viper-ex) - ;;; viper-ex.el ends here
--- a/lisp/viper/viper-keym.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/viper-keym.el Mon Aug 13 09:06:37 2007 +0200 @@ -21,6 +21,23 @@ ;; Code +(provide 'viper-keym) + +;; compiler pacifier +(defvar vip-always) +(defvar vip-current-state) +(defvar vip-mode-string) +(defvar vip-expert-level) +(defvar vip-ex-style-editing-in-insert) +(defvar vip-ex-style-motion) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'viper-util) + (load "viper-util.el" nil nil 'nosuffix)) + )) +;; end pacifier + (require 'viper-util) ;;; Variables @@ -35,6 +52,29 @@ "Key used to ESC. Must be set in .vip file or prior to loading Viper. This setting cannot be changed interactively.") + +;;; Emacs keys in other states. + +(defvar vip-want-emacs-keys-in-insert t + "*Set to nil if you want complete Vi compatibility in insert mode. +Complete compatibility with Vi is not recommended for power use of Viper.") + +(defvar vip-want-emacs-keys-in-vi t + "*Set to nil if you want complete Vi compatibility in Vi mode. +Full Vi compatibility is not recommended for power use of Viper.") + +(defvar vip-no-multiple-ESC t + "*If true, multiple ESC in Vi mode will cause bell to ring. +This is set to t on a windowing terminal and to 'twice on a dumb +terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this +enables cursor keys and is generally more convenient, as terminals usually +don't have a convenient Meta key. +Setting vip-no-multiple-ESC to nil will allow as many multiple ESC, +as is allowed by the major mode in effect.") + +(defvar vip-want-ctl-h-help nil + "*If t then C-h is bound to help-command in insert mode, if nil then it is +bound to delete-backward-char.") ;;; Keymaps @@ -335,7 +375,7 @@ (define-key vip-vi-basic-map "~" 'vip-toggle-case) (define-key vip-vi-basic-map "\C-?" 'vip-backward-char) (define-key vip-vi-basic-map "_" 'vip-nil) - + ;;; Escape from Emacs to Vi for one command (global-set-key "\C-c\\" 'vip-escape-to-vi) ; everywhere @@ -441,7 +481,7 @@ (defun vip-zap-local-keys () "Unconditionally reset Viper vip-*-local-user-map's. -Rarely useful, but if you made a mistake by switching to a mode that adds +Rarely useful, but if u made a mistake by switching to a mode that adds undesirable local keys, e.g., comint-mode, then this function can restore sanity." (interactive) @@ -579,6 +619,4 @@ alist)) -(provide 'viper-keym) - ;;; viper-keym.el ends here
--- a/lisp/viper/viper-macs.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/viper-macs.el Mon Aug 13 09:06:37 2007 +0200 @@ -21,6 +21,24 @@ ;; Code +(provide 'viper-macs) + +;; compiler pacifier +(defvar vip-ex-work-buf) +(defvar vip-custom-file-name) +(defvar vip-current-state) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'viper-util) + (load "viper-util.el" nil nil 'nosuffix)) + (or (featurep 'viper-keym) + (load "viper-keym.el" nil nil 'nosuffix)) + (or (featurep 'viper-mous) + (load "viper-mous.el" nil nil 'nosuffix)) + )) +;; end pacifier + (require 'viper-util) (require 'viper-keym) @@ -938,6 +956,4 @@ (call-last-kbd-macro))) -(provide 'viper-macs) - ;;; viper-macs.el ends here
--- a/lisp/viper/viper-mous.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/viper-mous.el Mon Aug 13 09:06:37 2007 +0200 @@ -21,12 +21,25 @@ ;; Code -(require 'viper-util) +(provide 'viper-mous) ;; compiler pacifier (defvar double-click-time) (defvar mouse-track-multi-click-time) -;; end compiler pacifier +(defvar vip-search-start-marker) +(defvar vip-local-search-start-marker) +(defvar vip-search-history) +(defvar vip-s-string) +(defvar vip-re-search) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'viper-util) + (load "viper-util.el" nil nil 'nosuffix)) + )) +;; end pacifier + +(require 'viper-util) ;;; Variables @@ -453,7 +466,4 @@ ))) - -(provide 'viper-mous) - ;;; viper-mous.el ends here
--- a/lisp/viper/viper-util.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/viper-util.el Mon Aug 13 09:06:37 2007 +0200 @@ -42,7 +42,11 @@ (defvar vip-use-replace-region-delimiters) (defvar vip-fast-keyseq-timeout) (defvar vip-related-files-and-buffers-ring) -;; end compiler pacifier +(defvar vip-saved-cursor-color) +(defvar ex-unix-type-shell) +(defvar ex-unix-type-shell-options) +(defvar vip-ex-tmp-buf-name) +;; end pacifier ;; Is it XEmacs? (defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) @@ -155,6 +159,120 @@ (defvar vip-search-overlay-priority 500) +;;; Viper minor modes + +;; This is not local in Emacs, so we make it local. +;; This must be local because although the stack of minor modes can be the same +;; for all buffers, the associated *keymaps* can be different. In Viper, +;; vip-vi-local-user-map, vip-insert-local-user-map, and others can have +;; different keymaps for different buffers. +;; Also, the keymaps associated with vip-vi/insert-state-modifier-minor-mode +;; can be different. +(make-variable-buffer-local 'minor-mode-map-alist) + +;; Mode for vital things like \e, C-z. +(vip-deflocalvar vip-vi-intercept-minor-mode nil) + +(vip-deflocalvar vip-vi-basic-minor-mode nil + "Viper's minor mode for Vi bindings.") + +(vip-deflocalvar vip-vi-local-user-minor-mode nil + "Auxiliary minor mode for user-defined local bindings in Vi state.") + +(vip-deflocalvar vip-vi-global-user-minor-mode nil + "Auxiliary minor mode for user-defined global bindings in Vi state.") + +(vip-deflocalvar vip-vi-state-modifier-minor-mode nil + "Minor mode used to make major-mode-specific modification to Vi state.") + +(vip-deflocalvar vip-vi-diehard-minor-mode nil + "This minor mode is in effect when the user wants Viper to be Vi.") + +(vip-deflocalvar vip-vi-kbd-minor-mode nil + "Minor mode for Ex command macros in Vi state. +The corresponding keymap stores key bindings of Vi macros defined with +the Ex command :map.") + +;; Mode for vital things like \e, C-z. +(vip-deflocalvar vip-insert-intercept-minor-mode nil) + +(vip-deflocalvar vip-insert-basic-minor-mode nil + "Viper's minor mode for bindings in Insert mode.") + +(vip-deflocalvar vip-insert-local-user-minor-mode nil + "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. +This is a way to overshadow normal Insert mode bindings locally to certain +designated buffers.") + +(vip-deflocalvar vip-insert-global-user-minor-mode nil + "Auxiliary minor mode for global user-defined bindings in Insert state.") + +(vip-deflocalvar vip-insert-state-modifier-minor-mode nil + "Minor mode used to make major-mode-specific modification to Insert state.") + +(vip-deflocalvar vip-insert-diehard-minor-mode nil + "Minor mode that simulates Vi very closely. +Not recommened, except for the novice user.") + +(vip-deflocalvar vip-insert-kbd-minor-mode nil +"Minor mode for Ex command macros Insert state. +The corresponding keymap stores key bindings of Vi macros defined with +the Ex command :map!.") + +(vip-deflocalvar vip-replace-minor-mode nil + "Minor mode in effect in replace state (cw, C, and the like commands).") + +;; Mode for vital things like \C-z and \C-x) +;; This is t, by default. So, any new buffer will have C-z defined as +;; switch to Vi, unless we switched states in this buffer +(vip-deflocalvar vip-emacs-intercept-minor-mode t) + +(vip-deflocalvar vip-emacs-local-user-minor-mode t + "Minor mode for local user bindings effective in Emacs state. +Users can use it to override Emacs bindings when Viper is in its Emacs +state.") + +(vip-deflocalvar vip-emacs-global-user-minor-mode t + "Minor mode for global user bindings in effect in Emacs state. +Users can use it to override Emacs bindings when Viper is in its Emacs +state.") + +(vip-deflocalvar vip-emacs-kbd-minor-mode t + "Minor mode for Vi style macros in Emacs state. +The corresponding keymap stores key bindings of Vi macros defined with +`vip-record-kbd-macro' command. There is no Ex-level command to do this +interactively.") + +(vip-deflocalvar vip-emacs-state-modifier-minor-mode t + "Minor mode used to make major-mode-specific modification to Emacs state. +For instance, a Vi purist may want to bind `dd' in Dired mode to a function +that deletes a file.") + +(vip-deflocalvar vip-vi-minibuffer-minor-mode nil + "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") + +(vip-deflocalvar vip-insert-minibuffer-minor-mode nil + "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") + + + +;; Some common error messages + +(defconst vip-SpuriousText "Spurious text after command" "") +(defconst vip-BadExCommand "Not an editor command" "") +(defconst vip-InvalidCommandArgument "Invalid command argument" "") +(defconst vip-NoPrevSearch "No previous search string" "") +(defconst vip-EmptyRegister "`%c': Nothing in this register" "") +(defconst vip-InvalidRegister "`%c': Invalid register" "") +(defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "") +(defconst vip-InvalidTextmarker "`%c': Invalid text marker" "") +(defconst vip-InvalidViCommand "Invalid command" "") +(defconst vip-BadAddress "Ill-formed address" "") +(defconst vip-FirstAddrExceedsSecond "First address exceeds second" "") +(defconst vip-NoFileSpecified "No file specified" "") + + + ;;; XEmacs support (if vip-xemacs-p @@ -255,7 +373,7 @@ (vip-overlay-get vip-replace-overlay 'vip-cursor-color))) (defsubst vip-restore-cursor-color-after-insert () (vip-change-cursor-color vip-saved-cursor-color)) - + ;; Check the current version against the major and minor version numbers ;; using op: cur-vers op major.minor If emacs-major-version or @@ -947,6 +1065,12 @@ (set hook hook-value)))) +;; it is suggested that an event must be copied before it is assigned to +;; last-command-event in XEmacs +(defun vip-copy-event (event) + (if vip-xemacs-p + (copy-event event) + event)) ;; like read-event, but in XEmacs also try to convert to char, if possible (defun vip-read-event-convert-to-char () @@ -964,7 +1088,7 @@ ;; by correctly mapping key sequences for Left/Right/... (one an ascii ;; terminal) into logical keys left, right, etc. (defun vip-read-key () - (let ((overriding-local-map vip-overriding-map) + (let ((overriding-local-map vip-overriding-map) (inhibit-quit t) key) (use-global-map vip-overriding-map)
--- a/lisp/viper/viper.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/viper/viper.el Mon Aug 13 09:06:37 2007 +0200 @@ -8,7 +8,7 @@ ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. -(defconst viper-version "2.91 of August 5, 1996" +(defconst viper-version "2.92 of January 3, 1997" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -157,7 +157,7 @@ ;; and so many of the goodies of Emacs are not available. ;; ;; A skilled user should set vip-expert-level to at least 3. This will -;; enable `C-c; and many Emacs facilities will become available. +;; enable `C-c' and many Emacs facilities will become available. ;; In this case, vip-vi-diehard-minor-mode is inactive. ;; ;; Viper gurus should have at least @@ -300,7 +300,7 @@ (require 'cl) (require 'ring) -(require 'viper-util) +(provide 'viper) ;; Compiler pacifier (defvar vip-minibuffer-current-face) @@ -309,8 +309,30 @@ (defvar vip-minibuffer-emacs-face) (defvar iso-accents-mode) (defvar zmacs-region-stays) +(defvar mark-even-if-inactive) + +(eval-when-compile + (let ((load-path (cons "." load-path))) + (or (featurep 'viper-util) + (load "viper-util.el" nil nil 'nosuffix)) + (or (featurep 'viper-keym) + (load "viper-keym.el" nil nil 'nosuffix)) + (or (featurep 'viper-mous) + (load "viper-mous.el" nil nil 'nosuffix)) + (or (featurep 'viper-macs) + (load "viper-macs.el" nil nil 'nosuffix)) + (or (featurep 'viper-ex) + (load "viper-ex.el" nil nil 'nosuffix)) + )) ;; end pacifier +(require 'viper-util) +(require 'viper-keym) +(require 'viper-mous) +(require 'viper-macs) +(require 'viper-ex) + + ;;; Variables @@ -335,96 +357,6 @@ (defvar vip-saved-user-settings nil) -;;; Viper minor modes - -;; This must be local because although the stack of minor modes can be the same -;; for all buffers, the associated *keymaps* can be different. In Viper, -;; vip-vi-local-user-map, vip-insert-local-user-map, and others can have -;; different keymaps for different buffers. -;; Also, the keymaps associated with vip-vi/insert-state-modifier-minor-mode -;; can be different. -(make-variable-buffer-local 'minor-mode-map-alist) - -;; Mode for vital things like \e, C-z. -(vip-deflocalvar vip-vi-intercept-minor-mode nil) - -(vip-deflocalvar vip-vi-basic-minor-mode nil - "Viper's minor mode for Vi bindings.") - -(vip-deflocalvar vip-vi-local-user-minor-mode nil - "Auxiliary minor mode for user-defined local bindings in Vi state.") - -(vip-deflocalvar vip-vi-global-user-minor-mode nil - "Auxiliary minor mode for user-defined global bindings in Vi state.") - -(vip-deflocalvar vip-vi-state-modifier-minor-mode nil - "Minor mode used to make major-mode-specific modification to Vi state.") - -(vip-deflocalvar vip-vi-diehard-minor-mode nil - "This minor mode is in effect when the user wants Viper to be Vi.") - -(vip-deflocalvar vip-vi-kbd-minor-mode nil - "Minor mode for Ex command macros in Vi state. -The corresponding keymap stores key bindings of Vi macros defined with -the Ex command :map.") - -;; Mode for vital things like \e, C-z. -(vip-deflocalvar vip-insert-intercept-minor-mode nil) - -(vip-deflocalvar vip-insert-basic-minor-mode nil - "Viper's minor mode for bindings in Insert mode.") - -(vip-deflocalvar vip-insert-local-user-minor-mode nil - "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. -This is a way to overshadow normal Insert mode bindings locally to certain -designated buffers.") - -(vip-deflocalvar vip-insert-global-user-minor-mode nil - "Auxiliary minor mode for global user-defined bindings in Insert state.") - -(vip-deflocalvar vip-insert-state-modifier-minor-mode nil - "Minor mode used to make major-mode-specific modification to Insert state.") - -(vip-deflocalvar vip-insert-diehard-minor-mode nil - "Minor mode that simulates Vi very closely. -Not recommened, except for the novice user.") - -(vip-deflocalvar vip-insert-kbd-minor-mode nil -"Minor mode for Ex command macros Insert state. -The corresponding keymap stores key bindings of Vi macros defined with -the Ex command :map!.") - -(vip-deflocalvar vip-replace-minor-mode nil - "Minor mode in effect in replace state (cw, C, and the like commands).") - -;; Mode for vital things like \C-z and \C-x) -;; This is t, by default. So, any new buffer will have C-z defined as -;; switch to Vi, unless we switched states in this buffer -(vip-deflocalvar vip-emacs-intercept-minor-mode t) - -(vip-deflocalvar vip-emacs-local-user-minor-mode t - "Minor mode for local user bindings effective in Emacs state. -Users can use it to override Emacs bindings when Viper is in its Emacs -state.") - -(vip-deflocalvar vip-emacs-global-user-minor-mode t - "Minor mode for global user bindings in effect in Emacs state. -Users can use it to override Emacs bindings when Viper is in its Emacs -state.") - -(vip-deflocalvar vip-emacs-kbd-minor-mode t - "Minor mode for Vi style macros in Emacs state. -The corresponding keymap stores key bindings of Vi macros defined with -`vip-record-kbd-macro' command. There is no Ex-level command to do this -interactively.") - -(vip-deflocalvar vip-emacs-state-modifier-minor-mode t - "Minor mode used to make major-mode-specific modification to Emacs state. -For instance, a Vi purist may want to bind `dd' in Dired mode to a function -that deletes a file.") - - - ;;; ISO characters (vip-deflocalvar vip-automatic-iso-accents nil @@ -432,18 +364,6 @@ For some users, this behavior may be too primitive. In this case, use insert/emacs/vi state hooks.") - -;;; Emacs keys in other states. - -(defvar vip-want-emacs-keys-in-insert t - "*Set to nil if you want complete Vi compatibility in insert mode. -Complete compatibility with Vi is not recommended for power use of Viper.") - -(defvar vip-want-emacs-keys-in-vi t - "*Set to nil if you want complete Vi compatibility in Vi mode. -Full Vi compatibility is not recommended for power use of Viper.") - - ;; VI-style Undo @@ -478,13 +398,12 @@ (defvar vip-replace-overlay-cursor-color "Red" "*Cursor color to use in Replace state") - (defvar vip-insert-state-cursor-color nil "Cursor color for Viper insert state.") (put 'vip-insert-state-cursor-color 'permanent-local t) ;; place to save cursor colow when switching to insert mode (vip-deflocalvar vip-saved-cursor-color nil "") - + (vip-deflocalvar vip-replace-overlay nil "") (put 'vip-replace-overlay 'permanent-local t) @@ -580,19 +499,6 @@ ;; Current mode. One of: `emacs-state', `vi-state', `insert-state' (vip-deflocalvar vip-current-state 'emacs-state) -(defvar vip-no-multiple-ESC t - "*If true, multiple ESC in Vi mode will cause bell to ring. -This is set to t on a windowing terminal and to 'twice on a dumb -terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this -enables cursor keys and is generally more convenient, as terminals usually -don't have a convenient Meta key. -Setting vip-no-multiple-ESC to nil will allow as many multiple ESC, -as is allowed by the major mode in effect.") - - -(defvar vip-want-ctl-h-help nil - "*If t then C-h is bound to help-command in insert mode, if nil then it is -bound to delete-backward-char.") ;; Autoindent in insert @@ -702,14 +608,16 @@ (defvar vip-s-forward nil) (defconst vip-case-fold-search nil - "*If not nil, search ignores case.") + "*If not nil, search ignores cases.") (defconst vip-re-search t "*If not nil, search is reg-exp search, otherwise vanilla search.") -(defvar vip-adjust-window-after-search t - "*If not nil, pull the window up or down, depending on the direction of the -search, if search ends up near the bottom or near the top of the window.") +(defvar vip-search-scroll-threshold 2 + "*If search lands within this threshnold from the window top/bottom, +the window will be scrolled up or down appropriately, to reveal context. +If you want Viper search to behave as usual in Vi, set this variable to a +negative number.") (defconst vip-re-query-replace t "*If t then do regexp replace, if nil then do string replace.") @@ -778,22 +686,6 @@ ;; Remembers position of the last jump done using `''. (vip-deflocalvar vip-last-jump-ignore 0) -;; Some common error messages - -(defconst vip-SpuriousText "Spurious text after command" "") -(defconst vip-BadExCommand "Not an editor command" "") -(defconst vip-InvalidCommandArgument "Invalid command argument" "") -(defconst vip-NoPrevSearch "No previous search string" "") -(defconst vip-EmptyRegister "`%c': Nothing in this register" "") -(defconst vip-InvalidRegister "`%c': Invalid register" "") -(defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "") -(defconst vip-InvalidTextmarker "`%c': Invalid text marker" "") -(defconst vip-InvalidViCommand "Invalid command" "") -(defconst vip-BadAddress "Ill-formed address" "") -(defconst vip-FirstAddrExceedsSecond "First address exceeds second" "") -(defconst vip-NoFileSpecified "No file specified" "") - - ;; History variables ;; History of search strings. @@ -840,6 +732,10 @@ (defvar vip-tags-file-name "TAGS" "The tags file used by Viper.") +;; Indicates if we are in the middle of executing a command that takes another +;; command as an argument, e.g., cw, dw, etc. +(defvar vip-inside-command-argument-action nil) + ;; Minibuffer (defvar vip-vi-style-in-minibuffer t @@ -854,11 +750,6 @@ ;; *after* exiting the minibuffer (defvar vip-minibuffer-exit-hook nil) -(vip-deflocalvar vip-vi-minibuffer-minor-mode nil - "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") -(vip-deflocalvar vip-insert-minibuffer-minor-mode nil - "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") - ;; setup emacs-supported vi-style feel (setq next-line-add-newlines nil require-final-newline t) @@ -920,10 +811,12 @@ ;; Modifying commands that can be prefixes to movement commands (defconst vip-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\")) +;; define vip-prefix-command-p (vip-test-com-defun vip-prefix-command) ;; Commands that are pairs eg. dd. r and R here are a hack (defconst vip-charpair-commands '(?c ?d ?y ?! ?= ?< ?> ?r ?R)) +;; define vip-charpair-command-p (vip-test-com-defun vip-charpair-command) (defconst vip-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l @@ -932,31 +825,33 @@ ?; ?, ?0 ?? ?/ ) "Movement commands") +;; define vip-movement-command-p (vip-test-com-defun vip-movement-command) ;; Commands that can be repeated by . (dotted) -(defconst vip-dotable-commands '(?c ?d ?C ?D ?> ?<)) +(defconst vip-dotable-commands '(?c ?d ?C ?s ?S ?D ?> ?<)) +;; define vip-dotable-command-p (vip-test-com-defun vip-dotable-command) ;; Commands that can follow a # -(defconst vip-hash-cmds '(?c ?C ?g ?q ?S)) -(vip-test-com-defun vip-hash-cmd) +(defconst vip-hash-commands '(?c ?C ?g ?q ?s)) +;; define vip-hash-command-p +(vip-test-com-defun vip-hash-command) ;; Commands that may have registers as prefix (defconst vip-regsuffix-commands '(?d ?y ?Y ?D ?p ?P ?x ?X)) +;; define vip-regsuffix-command-p (vip-test-com-defun vip-regsuffix-command) (defconst vip-vi-commands (append vip-movement-commands vip-dotable-commands vip-charpair-commands - vip-hash-cmds + vip-hash-commands vip-prefix-commands vip-regsuffix-commands) "The list of all commands in Vi-state.") +;; define vip-vi-command-p (vip-test-com-defun vip-vi-command) - -;;; Arrange the keymaps -(require 'viper-keym) ;;; CODE @@ -1035,7 +930,7 @@ (memq (vip-event-key last-command-event) '(up down left right (meta f) (meta b) (control n) (control p) (control f) (control b))) - (vip-restore-cursor-color))) + (vip-restore-cursor-color-after-replace))) (defun vip-replace-state-post-command-sentinel () ;; Restoring cursor color is needed despite @@ -1174,7 +1069,7 @@ [(control h)] 'vip-del-backward-char-in-insert) (define-key vip-replace-map [(control h)] 'vip-del-backward-char-in-replace))) - + (t ; Vi state (setq vip-vi-diehard-minor-mode (not vip-want-emacs-keys-in-vi)) (if vip-want-ctl-h-help @@ -1451,7 +1346,7 @@ (iso-accents-mode -1)) (vip-restore-cursor-color-after-insert) - + ;; Protection against user errors in hooks (condition-case conds (run-hooks 'vip-vi-state-hook) @@ -1537,7 +1432,7 @@ (interactive "P") (message "Switched to VI state for the next command...") (vip-escape-to-state arg nil 'vi-state)) - + ;; Escape to STATE mode for one Emacs command. (defun vip-escape-to-state (arg events state) ;;(let (com key prefix-arg) @@ -1574,10 +1469,10 @@ ;; this-command, last-command-char, last-command-event (setq this-command com) (if vip-xemacs-p ; XEmacs represents key sequences as vectors - (setq last-command-event (vip-seq-last-elt key) + (setq last-command-event (vip-copy-event (vip-seq-last-elt key)) last-command-char (event-to-character last-command-event)) ;; Emacs represents them as sequences (str or vec) - (setq last-command-event (vip-seq-last-elt key) + (setq last-command-event (vip-copy-event (vip-seq-last-elt key)) last-command-char last-command-event)) (if (commandp com) @@ -1669,6 +1564,7 @@ (defun vip-alternate-Meta-key (arg) "Simulate Emacs Meta key." (interactive "P") + (sit-for 1) (message "ESC-") (vip-escape-to-emacs arg '(?\e))) (defun vip-toggle-key-action () @@ -1679,6 +1575,7 @@ (vip-iconify) (suspend-emacs)) (vip-change-state-to-emacs))) + ;; Intercept ESC sequences on dumb terminals. ;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es> @@ -1742,7 +1639,7 @@ (setq last-input-event event keyseq (vector (character-to-event ?\e)))) ((eventp first-key) - (setq last-command-event first-key)) + (setq last-command-event (vip-copy-event first-key))) )) ) ; end progn @@ -1862,7 +1759,7 @@ (while (eq event ?U) (vip-describe-arg prefix-arg) (setq event (vip-read-event-convert-to-char))) - + (if (or com (and (not (eq vip-current-state 'vi-state)) ;; make sure it is a Vi command (vip-characterp event) (vip-vi-command-p event) @@ -1879,7 +1776,7 @@ ;; If vip-digit-argument was invoked by vip-escape-to-vi (which is ;; indicated by the fact that the current state is not vi-state, ;; then `event' represents the vi command to be executed (e.g., `d', - ;; `w', etc. Again, last-command-char must make emacs believe that + ;; `w', etc). Again, last-command-char must make emacs believe that ;; this is the command we typed. (setq last-command-char (or com event)) (setq func (vip-exec-form-in-vi @@ -1889,7 +1786,7 @@ ;; some other command -- let emacs do it in its own way (vip-set-unread-command-events event)) )) - + ;; Vi operator as prefix argument." (defun vip-prefix-arg-com (char value com) @@ -1928,7 +1825,8 @@ (setq char (read-char)))) (t (setq com char) - (setq char (vip-read-char-exclusive)))))) + (setq char (read-char)))))) + (if (atom com) ;; `com' is a single char, so we construct the command argument ;; and if `char' is `?', we describe the arg; otherwise @@ -1943,6 +1841,7 @@ (setq mv-or-digit-cmd (vip-exec-form-in-vi (` (key-binding (char-to-string (, char))))))) + ;; as com is non-nil, this means that we have a command to execute (if (memq (car com) '(?r ?R)) ;; execute apropriate region command. @@ -1964,10 +1863,13 @@ ((equal com '(?! . ?!)) (vip-line (cons value ?!))) ((equal com '(?= . ?=)) (vip-line (cons value ?=))) (t (error ""))))) - + (if mv-or-digit-cmd (progn (setq last-command-char char) + (setq last-command-event + (vip-copy-event + (if vip-xemacs-p (character-to-event char) char))) (funcall mv-or-digit-cmd cmd-info))) )) @@ -1993,20 +1895,21 @@ (defun vip-command-argument (arg) "Accept a motion command as an argument." (interactive "P") - (condition-case nil - (vip-prefix-arg-com - last-command-char - (cond ((null arg) nil) - ((consp arg) (car arg)) - ((integerp arg) arg) - (t (error vip-InvalidCommandArgument))) - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - ((integerp arg) nil) - (t (error vip-InvalidCommandArgument)))) - (quit (setq vip-use-register nil) - (signal 'quit nil))) - (vip-deactivate-mark)) + (let ((vip-inside-command-argument-action t)) + (condition-case nil + (vip-prefix-arg-com + last-command-char + (cond ((null arg) nil) + ((consp arg) (car arg)) + ((integerp arg) arg) + (t (error vip-InvalidCommandArgument))) + (cond ((null arg) nil) + ((consp arg) (cdr arg)) + ((integerp arg) nil) + (t (error vip-InvalidCommandArgument)))) + (quit (setq vip-use-register nil) + (signal 'quit nil))) + (vip-deactivate-mark))) ;; repeat last destructive command @@ -2043,6 +1946,8 @@ ;; invoked by the `C' command (defun vip-exec-change (m-com com) + (or (and (markerp vip-com-point) (marker-position vip-com-point)) + (set-marker vip-com-point (point) (current-buffer))) ;; handle C cmd at the eol and at eob. (if (or (and (eolp) (= vip-com-point (point))) (= vip-com-point (point-max))) @@ -2076,6 +1981,8 @@ (if (= com ?C) (vip-change-mode-to-insert) (vip-yank-last-insertion))) (defun vip-exec-delete (m-com com) + (or (and (markerp vip-com-point) (marker-position vip-com-point)) + (set-marker vip-com-point (point) (current-buffer))) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(letter digit)) @@ -2118,6 +2025,8 @@ (back-to-indentation)) (defun vip-exec-yank (m-com com) + (or (and (markerp vip-com-point) (marker-position vip-com-point)) + (set-marker vip-com-point (point) (current-buffer))) (if vip-use-register (progn (cond ((vip-valid-register vip-use-register '(letter digit)) @@ -2326,7 +2235,8 @@ )) -;; This command is invoked interactively by the key sequence #<char> +;; The hash-command. It is invoked interactively by the key sequence #<char>. +;; The chars that can follow `#' are determined by vip-hash-command-p (defun vip-special-prefix-com (char) (cond ((= char ?c) (downcase-region (min vip-com-point (point)) @@ -2589,8 +2499,8 @@ (setq incr 1)) (<= (+ incr (count-lines beg end)) 1)))) )) - - + + ;; Check if the string ends with a newline. (defun vip-end-with-a-newline-p (string) (or (string= string "") @@ -3869,10 +3779,11 @@ (interactive "p") (recenter (- (window-height) (1+ arg)))) -;; If vip-adjust-window-after-search is t, scroll up or down 1/4 of window -;; height, depending on whether we are at the bottom or at the top of the -;; window. This function is called by vip-search (which is called from -;; vip-search-forward/backward/next) +;; If point is within vip-search-scroll-threshold of window top or bottom, +;; scroll up or down 1/7 of window height, depending on whether we are at the +;; bottom or at the top of the window. This function is called by vip-search +;; (which is called from vip-search-forward/backward/next). If the value of +;; vip-search-scroll-threshold is negative - don't scroll. (defun vip-adjust-window () (let ((win-height (if vip-emacs-p (1- (window-height)) ; adjust for modeline @@ -3882,15 +3793,18 @@ min-scroll direction) (save-excursion (move-to-window-line 0) ; top - (setq at-top-p (<= (count-lines pt (point)) 2)) + (setq at-top-p + (<= (count-lines pt (point)) + vip-search-scroll-threshold)) (move-to-window-line -1) ; bottom - (setq at-bottom-p (<= (count-lines pt (point)) 2)) + (setq at-bottom-p + (<= (count-lines pt (point)) vip-search-scroll-threshold)) ) - (cond (at-top-p (setq min-scroll 1 + (cond (at-top-p (setq min-scroll (1- vip-search-scroll-threshold) direction 1)) - (at-bottom-p (setq min-scroll 2 + (at-bottom-p (setq min-scroll (1+ vip-search-scroll-threshold) direction -1))) - (if (and vip-adjust-window-after-search min-scroll) + (if min-scroll (recenter (* (max min-scroll (/ win-height 7)) direction))) )) @@ -4317,6 +4231,7 @@ ;; highlight the result of search ;; don't wait and don't highlight in macros (or executing-kbd-macro + vip-inside-command-argument-action (vip-flash-search-pattern)) ))) @@ -4839,16 +4754,16 @@ (defun vip-mark-point () "Set mark at point of buffer." (interactive) - (let ((char (vip-read-char-exclusive))) - (cond ((and (<= ?a char) (<= char ?z)) - (point-to-register (1+ (- char ?a)))) - ((= char ?<) (vip-mark-beginning-of-buffer)) - ((= char ?>) (vip-mark-end-of-buffer)) - ((= char ?.) (vip-set-mark-if-necessary)) - ((= char ?,) (vip-cycle-through-mark-ring)) - ((= char ?D) (mark-defun)) - (t (error "")) - ))) + (let ((char (read-char))) + (cond ((and (<= ?a char) (<= char ?z)) + (point-to-register (1+ (- char ?a)))) + ((= char ?<) (vip-mark-beginning-of-buffer)) + ((= char ?>) (vip-mark-end-of-buffer)) + ((= char ?.) (vip-set-mark-if-necessary)) + ((= char ?,) (vip-cycle-through-mark-ring)) + ((= char ?D) (mark-defun)) + (t (error "")) + ))) ;; Algorithm: If first invocation of this command save mark on ring, goto ;; mark, M0, and pop the most recent elt from the mark ring into mark, @@ -5154,7 +5069,7 @@ vip-want-emacs-keys-in-insert nil)) ((and (> vip-expert-level 1) (< vip-expert-level 5)) - ;; an intermediate to guru + ;; intermediate to guru (setq vip-no-multiple-ESC (if (vip-window-display-p) t 'twice) vip-want-emacs-keys-in-vi t vip-want-emacs-keys-in-insert (> vip-expert-level 2)) @@ -5542,13 +5457,6 @@ -;;; Bring in the rest of the files -(require 'viper-mous) -(require 'viper-macs) -(require 'viper-ex) - - - ;; The following is provided for compatibility with older VIP's (defalias 'vip-change-mode-to-vi 'vip-change-state-to-vi) @@ -5596,7 +5504,7 @@ (add-hook 'html-helper-mode-hook 'viper-mode) (defvar java-mode-hook) (add-hook 'java-mode-hook 'viper-mode) - + (defvar emacs-lisp-mode-hook) (add-hook 'emacs-lisp-mode-hook 'viper-mode) @@ -5620,12 +5528,12 @@ (defvar fortran-mode-hook) (add-hook 'fortran-mode-hook 'vip-mode) - + (defvar basic-mode-hook) (add-hook 'basic-mode-hook 'vip-mode) (defvar bat-mode-hook) (add-hook 'bat-mode-hook 'vip-mode) - + (defvar text-mode-hook) (add-hook 'text-mode-hook 'viper-mode) @@ -5648,7 +5556,7 @@ '(defadvice vc-diff (after vip-vc-ad activate) "Force Vi state in VC diff buffer." (vip-change-state-to-vi)))) - + (vip-eval-after-load "emerge" '(defadvice emerge-quit (after vip-emerge-advice activate) @@ -5701,7 +5609,7 @@ 'internal-ange-ftp-mode 'vi-state vip-comint-mode-modifier-map) ;; set hook (add-hook 'comint-mode-hook 'vip-comint-mode-hook) - + ;; Shell scripts (defvar sh-mode-hook) (add-hook 'sh-mode-hook 'viper-mode) @@ -5797,7 +5705,7 @@ ;; set the toggle case sensitivity and regexp search macros (vip-set-vi-search-style-macros nil) - + ;; ~/.vip is loaded if it exists (if (and (file-exists-p vip-custom-file-name) @@ -5880,7 +5788,6 @@ (run-hooks 'vip-load-hook) ; the last chance to change something -(provide 'viper) (provide 'vip19) (provide 'vip)
--- a/lisp/w3/ChangeLog Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:06:37 2007 +0200 @@ -1,4 +1,1183 @@ -Sun Aug 11 16:41:58 1996 William Perry <wmperry@cs.indiana.edu> +Fri Jan 3 08:43:56 1997 William M. Perry <wmperry@aventail.com> + +* 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 @@ -6,7 +1185,7 @@ 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 Perry <wmperry@cs.indiana.edu> +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 @@ -17,7 +1196,7 @@ 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 Perry <wmperry@cs.indiana.edu> +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 @@ -28,13 +1207,13 @@ * w3-speak.el: fixed bugs -Mon Aug 5 14:03:09 1996 William Perry <wmperry@cs.indiana.edu> +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 Perry <wmperry@cs.indiana.edu> +Sun Aug 4 23:51:26 1996 William M. Perry <wmperry@cs.indiana.edu> * w3-speak.el: new version of w3-speak from raman @@ -53,16 +1232,28 @@ * w3-parse.el: fixed graphical entities -Sat Aug 3 20:09:50 1996 William Perry <wmperry@cs.indiana.edu> +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 -Thu Aug 1 13:32:54 1996 William Perry <wmperry@cs.indiana.edu> +* 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 @@ -75,9163 +1266,6 @@ * w3-draw.el: Added support for balloon-help -Fri Jul 26 05:57:21 1996 William Perry <wmperry@cs.indiana.edu> +Fri Jul 26 05:57:21 1996 William M. Perry <wmperry@cs.indiana.edu> * w3-display.el, w3-texinfo.el: Initial revision - -* w3-parse.el: *** empty log message *** - -* w3-hot.el: Should now be able to handle XMosaic style hotlist files - -* w3-parse.el: -Added some HTML 3.2 stuff, reorged some of the content-models, et. c - -* w3-draw.el: few fixes to the title handling. -don't display any text outside the <html></html> area - -* w3-style.el: -Changes to w3-style-parse-css to gracefully ignore <!-- and --> in a -stylesheet, for those losers who insist on using SGML comments to hide -the <style> tag from stupid browsers. - -* w3-parse.el: -Changed the content model of the <style> tag to CDATA so that idiots -who want to hide the style information from stupid old browsers by the absolutely braindead use of comments (<!-- ... -->) can. *sigh* - -Thu Jul 25 05:00:55 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-style.el: Fixed stupid bug in :device: handling - -Tue Jul 23 00:40:54 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-keyword.el: more keywords for speech stuff - -* docomp.el: *** empty log message *** - -* w3-draw.el: -Beginnings of support for the new and improved fucked up netscapism -<spacer> tag - -Mon Jul 22 03:22:52 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-sysdp.el: added stub for make-local-hook - more Emacs 19.2x lossage. - -* w3-forms.el: -always encode hex strigs into uppercase for stupid broken fucking -braindead forms decoders!!! - -Sun Jul 21 20:07:50 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.8 - -* w3.txi: fixed a few compilation errors in w3.txi - -* w3.txi: Revamped a few nodes, removed the downloading/compiling notes, and -documented url-proxy-services and improved the proxy section in -general. - -* w3-hot.el: Should now auto-recognize HTML bookmark files - -* font.el: Allow a font to have a size like "+12pt" - -* w3-draw.el: -Now handles <font face="xxxx"> ala Internet Exploiter and Nutscrape - -* w3.el: Added function for reloading all stylesheets - -* w3-menu.el: Added option to the 'style' menu for reloading stylesheets - -* w3-forms.el: -fixed problem with dropwon menus with the same 'value' would show the first item with that value, not necessarily the one the user selected. - -* w3-widget.el: w3-follow-inlined-image works again - -* w3-draw.el, w3-keyword.el, w3-menu.el, w3-vars.el, w3-xemac.el, w3.el: -You can now load delayed images - -Sat Jul 20 05:15:06 1996 William Perry <wmperry@cs.indiana.edu> - -* w3.txi: Removed 16-bit windows section. -removed programming interface chapter. -fixed Gnus accessing function docs. -added pointer to browse-url-browser-function. -removed docs of w3-delimit-emphasis / w3-delimit-links. - -* w3-forms.el: -If a form has an invalid encoding type, issue a warning about the bad -html and the fall back on application/x-www-form-urlencoded - -* w3-style.el: -@import no longer causes a 'buffer-modified, kill it anyway?' question. -newer CSS font shorthand supported. -split the font-family on commas, not spaces, ala newer CSS. - -* font.el: A few changes to the default font-family-mappings - -* w3-draw.el: -Allow global document stuff to be specified on the 'body' tag as well -as the 'html' tag. - -Fri Jul 19 04:35:48 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.7 - -Thu Jul 18 14:20:20 1996 William Perry <wmperry@cs.indiana.edu> - -* default.css: -moved monospaced font declaration for pre/xmp into the :xemacs: section - -Tue Jul 16 02:49:55 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-latex.el: Lots of patches from stephen peters. -* Fix to backslash handling code so that it works. - -* Fix to ~ (very important, that) so that it generates a - `\textasciitilde', since in a <tt> environment the previous call - would work incorrectly. Similar fix for ^ characters. - -* For carriage returns in a verbatim environment, use `\newline' - instead of `\ '. Also adds a \nullspace command for use in <pre> - environments, since the existing code for <pre> tended to eat - leading whitespace without it. - -* Use `\newline' instead of `\linebreak', since \linebreak tries to - justify the line out to the text width. - -* Added `\batchmode' call at the beginning of the generated LaTeX, to - force attempted recovery of any errors. - -* Added calls to not indent paragraphs and skip lines between - paragraphs. I'm not sure whether I like this better or not, but I - figured that most HTML browsers currently use that formatting. This - should be changed once stylesheets are working nicely, to use - whatever's specified in the stylesheet for LaTeX. - -Mon Jul 15 17:33:19 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-draw.el: -tty-closest-color-matching now works for netscape-style color crap as -well as stylesheet stuff - -* w3-parse.el, w3-xemac.el: anal retentive patch for mispelling in comments - -Sat Jul 13 22:47:21 1996 William Perry <wmperry@cs.indiana.edu> - -* w3.el: -w3-echo-link stuff is now handled in the new widget-motion-hook variable. - -* widget-edit.el: -New hook - widget-motion-hook - called with the widget moved to. - -* w3-draw.el: -w3-echo-link stuff is now handled in the new widget-motion-hook variable. -when following a link, its color is changed correctly. - -Fri Jul 12 05:52:49 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-style.el: fixed problem parsing class attributes in CSS - -* w3-style.el: *** empty log message *** - -Thu Jul 11 18:00:20 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-style.el: deal gracefully with device-bitplanes returning nil - -* w3-style.el: You can now use a :speech: device section in a CSS stylesheet - -* patch-for-old-emacsen: Initial revision - -* w3-sysdp.el: version of valid-color-name-p and device-class for the OS/2 -presentation manager. - -* w3-e19.el: Some OS/2 hacks - -* w3-draw.el: -sanity check the fill-prefix before setting it, and issue a warning if -list indentation tries to overflow the right window margin. - -* w3-vars.el: Created version 3.0.6 - -Wed Jul 10 23:50:10 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-draw.el: fixed problem with emacspeak - -* default.css: *** empty log message *** - -* dist.Makefile: fixed install target - duh - -* w3.el: some more mule fixing - -* w3.el: remove compression extensions from default save-as filenames - -* w3.el: fixed w3-save-binary-file to set initial-contents on the call to -read-file-name - -* w3-hot.el: fixed problem with w3-hotlist-add-document-at-point - -* w3-parse.el: Fix for mule and character entities > 127 - -* w3-draw.el: -fixed mysterious problem of stylesheet formatting info not working -correctly the first time a tag was seen. *dumb* mistake on my part. - -Tue Jul 9 21:01:15 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-sysdp.el: added more overlay functions - -* w3-vars.el: Created version 3.0.5 - -* w3.el: *** empty log message *** - -* dist.Makefile: -Now uses 'install' to do the copying around, instead of trying to fake it. - -* dist.Makefile: *** empty log message *** - -* font.el: Require disp-table so that display table stuff is loaded (apparently -XEmacs 19.13 didn't autoload or dump it - *sigh*) - -* dist.Makefile: No longer mention THIS-IS-VERSION-XX in the makefile - -* w3.el: *** empty log message *** - -* w3.el: Fixed w3-save-binary-file - -* w3.el, w3-speak.el, w3-style.el, w3-draw.el: voices-via-stylesheet fixes - -* dtk-css-speech.el: Initial revision - -* w3-forms.el: wais submissions work again - -* w3-print.el: fix problem with ps-print and forms printing (read-only text) - -Sun Jul 7 22:04:07 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.4 - -* w3-forms.el: <input type=radio checked> works now - -* w3-forms.el: Radio buttons work again. *sigh* - -Thu Jul 4 16:32:06 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-draw.el: Let stylesheets handle the w3-delimit-links stuff - -Mon Jul 1 15:42:21 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.3 - -* widget-edit.el: another patch to not require new-style backquote processing - -* w3-sysdp.el: Added stub for buffer-substring-no-properties - -* w3-menu.el: -Do not use menus under Emacs 19.28 - they are broken / incompatible -with that version of easymenu - -* w3-sysdp.el: Fix to device-or-frame-type to work under Emacs 19.28 - -* w3.el: fix for set-auto-mode lossage on null buffer-file-name - -* w3-sysdp.el: Added in stubs for plist-put and plist-get, and an Emacs 19.2x -specific version of facep. everything almost works in 19.28 now. - -* widget-edit.el: Don't assume native backquoting abilities - -Sun Jun 30 22:53:02 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.2 - -* w3.txi: *** empty log message *** - -* w3.el, w3-xemac.el, w3-widget.el, w3-toolbar.el, w3-sysdp.el, w3-style.el, w3-speak.el, w3-print.el, w3-prefs.el, w3-parse.el, w3-mule.el, w3-mouse.el, w3-menu.el, w3-latex.el, w3-keyword.el, w3-imap.el, w3-hot.el, w3-forms.el, w3-emulate.el, w3-e19.el, w3-draw.el, w3-annotat.el, w3-about.el, images.el, font.el, w3-vars.el: -Changed email address info - -* dist.Makefile: Added w3-latex.el to the dist.Makefile - -* w3-vars.el, default.css: *** empty log message *** - -* font.el: final fix for font-height lossage - -* docomp.el: added menubar-visible-p - -Wed Jun 26 16:38:12 1996 William Perry <wmperry@cs.indiana.edu> - -* font.el: -Use truncate instead of round for font sizes - usually gives better results - -* w3-annotat.el, w3.el: -Patch from Darrell Kindred <dkindred+@cmu.edu> for news problems -1. nnheader-init-server-buffer isn't called, so the - first call to nntp-open-server fails. (Patch inserts - a call to nnheader-init-server-buffer in url-news-open-host.) - 2. The `&', '<', and '>' characters don't get turned into - entities in news from lines, subject, body, etc. The result - is that "William Perry <wmperry@monolith.spry.com>" shows up - as "William Perry @monolith.spry.com>". (The patch moves - w3-insert-entities-in-string to url.el and renames it to - url-insert-entities-in-string, then calls it from url-format-news. - 3. When displayed, news articles get an extra, empty - "References" entry. (Patch inserts a `(delete "" ...)' - to remove the trailing empty reference from the list.) - -Tue Jun 25 19:00:48 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-menu.el: Revamped the options menu - added the edit-preferences button. - -* w3.el: Fix for window-splitting with the back button - -* w3-sysdp.el: Added bogus definition of set-marker-insertion-type - -Mon Jun 24 14:51:18 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-about.el: changed pointers for xemacs.cs.uiuc.edu to xemacs.org - -Fri Jun 14 16:50:26 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-auto.el: *** empty log message *** - -* w3-vars.el, w3.el, w3-forms.el: -Fixes for mule from MORIOKA Tomohiko <morioka@jaist.ac.jp> - -* w3-xem20.el: Initial revision - -* w3-prefs.el: fixed problem under FSFmacs - -Thu Jun 13 14:31:38 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-menu.el: -Extended w3-menu-save-options to save more info. Different way of -turning menubar on/off in XEmacs 19.14 (menubar-visible-p specifier) - -* w3-latex.el: Applied hypertext link printing patches from Stephen Peters -<speters%samsun@us.oracle.com> - -* w3.el: patch for imbalanced tags in w3-document-information - -* w3-prefs.el: All the panels work to some degree now - -Wed Jun 12 03:25:39 1996 William Perry <wmperry@cs.indiana.edu> - -* w3-prefs.el: More panels work - -* w3-forms.el: fix for radio button munging - -Tue Jun 11 23:47:37 1996 William Perry <wmperry@cs.indiana.edu> - -* widget-edit.el: -fixed bug in widget-forward if a widget extended to (point-max) - -* w3.el: *** empty log message *** - -Sun Jun 9 21:21:35 1996 William Perry <wmperry@cs.indiana.edu> - -* widget-edit.el: Few bug fixes for widget-backward behaviour - -* w3-speak.el: more renamings that I forgot before - -* w3.el: w3-find-default-stylesheets is now a little smarter (looks for -stylesheets in the directory it is being loaded from). Error messages -when no default stylesheet can be found is much better now as well. - -* dist.Makefile, clean-cache, default.css, w3.txi, descrip.mms, font.el, images.el, w3-about.el, w3-annotat.el, w3-auto.el, w3-draw.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-sysdp.el, w3-toolbar.el, w3-vars.el, w3-widget.el, w3-xemac.el, w3.el, widget-edit.el, widget.el, xbm-button.el, xpm-button.el, docomp.el: -Initial revision - -Thu Jun 6 15:03:15 1996 William Perry <wmperry@indiana.edu> - - -* w3-auto.el: Added autoload for w3-show-dvi - -* w3-latex.el: w3-parse-tree-to-latex now takes optional URL argument. -<pre> and <xmp> text now work correctly. -Added a known-bugs section. -Added a variable for whether to print hyperlinks as footnotes or not. - - -* w3-annotat.el, w3-e19.el, w3-forms.el, w3-hot.el, w3-prefs.el, w3-xemac.el, w3.el: -Replaced w3-insert w/insert - no longer needed - -* w3-latex.el: Added footnotes for hypertext links - -Wed Jun 5 20:18:36 1996 William Perry <wmperry@indiana.edu> - -* w3-latex.el: -Changed some things to be more like w3-draw in how it gets formatting -informatino for each chunk - -* w3.el: -Merged in new latex printing code from Stephen Peters <speters%samsun@us.oracle.com> - -* w3-print.el: Stephen Peters <speters%samsun@us.oracle.com> - -* w3-auto.el: -Merged in new latex printing code from Stephen Peters <speters%samsun@us.oracle.com> - -* w3-latex.el: Initial revision - -* w3-parse.el: patch from jbw for eveil <! comment syntax - -Mon Jun 3 20:43:37 1996 William Perry <wmperry@indiana.edu> - -* w3-parse.el, w3-vars.el: -added flag for whether to honor netscape style <! > comments. - - -* w3-parse.el, w3-vars.el: Added alt text capabilities to w3-graphic-entities - -* w3-menu.el: Toggling menubar from Emacs->W3 works again - -* w3.el: w3-map-links works again, so does w3-complete-link - -* w3-e19.el, w3-xemac.el: removed old def. of w3-map-links - -* w3-draw.el: fixed url expansion - -* w3-forms.el: -More fixes for netscape compatibility with single-text entry form -submissions - -* w3-speak.el: -Added a few patches from Raman (folding-mode stuff) and definition of -advice for w3-scroll-up - -* w3-prefs.el: -Got rid of some compiler warnings about free variables, and removed -some bogus variables that I can get elsewhere now -(w3-preferences-numglyphs) - -* w3-prefs.el: Added hooks for setting up the prefs buffer, and ok/cancel/reset -hooks. Fixed saving of proxy information - -* descrip.mms: Updated VMS MMS file - -* dist.Makefile: Added w3-prefs to the distribution - -Sun Jun 2 20:09:22 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: a few more emacspeak extensions - - -* w3-e19.el: Fixed compile-time errors re: w3-form-element-* functions - -* w3-draw.el: fixed bug in w3-valid-voice-p - - -* w3-speak.el: fixed some compiler warnings - - -* dist.Makefile: Added w3-speak.el to the distribution - -* w3-speak.el: -Move some functionality of the w3-fetch defadvice into a w3-mode-hook -that is automatically added by w3-speak-use-voice-locking - -* w3-speak.el: Wow, I think it will work - -* w3-draw.el: reimplemented w3-echo-link - -* w3.el: fixed problem of not resetting the user's value of url-be-asynchronous -in the new version of w3-download-url - -* w3.el: Made w3-download-url asynchronous by default, and make sure it asks -for the filename before it starts the download. - -Sat Jun 1 20:04:22 1996 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed w3-download-url - -* w3-parse.el: Fixed graphic entities to use normal entity expansion instead of -'STARTTAG - see commentary in the code for why exactly. - -* w3.el: Fixed w3-mail-document-author to do the right thing for 'made' links -again. Now searches for mail(to|server) links first. If none found, -takes the first 'made' link and fetches that. If one found, fetch it. -If more than one mail(to|server) link is found, present the user with -a list and let them choose. - -* w3-speak.el: Initial revision - -Fri May 31 21:34:19 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-style.el: Basic support for emacspeak out of the box - -* w3.el: Fixed typo in w3-popup-info - -* w3-parse.el: Fixed bug in graphic entity creation - -* w3.el: Added new function w3-describe-entities that lists all the entities -currently defined. - -* w3-parse.el: Added in new definitions for graphic entities - they live again! - -* w3-vars.el: Added in new definitions for graphic entities - - -Thu May 30 17:32:36 1996 William Perry <wmperry@indiana.edu> - - -* w3-prefs.el: -Changed to only using one buffer instead of two stacked buffers - was -too big a pain in the ass to navigate w/o the mouse. - -* w3-forms.el: fixed form submission changes - -* w3-draw.el: -Supports target'ed windows to some extent (external, _blank, _top) - -* w3.el: delete-other-windows in w3-fetch-other-frame - -* w3-draw.el: -the hyperlnk widgets now keep _all_ attributes that are specified on a -link in them as widget properties. This will eventually allow us to -do targetted windows, etc. - - -* w3-prefs.el: protect against errors in widget-forward - -* w3-prefs.el: -Ok, cancel, and save buttons work. Proxy configuration screen is -complete. Old window configuration restored when exiting. Now -selects the prefs window after choosing something from the toolbar - -* w3-sysdp.el: Added symbol-value-in-buffer - - -* w3-draw.el, w3-forms.el: Single-entry form auto-submission now works again - -* w3-sysdp.el: Added insert-file-contents-literally function - -Wed May 29 21:52:40 1996 William Perry <wmperry@indiana.edu> - -* w3-prefs.el: proxy panel sort of works - -* w3-print.el: Few patches to the latex printing by Stephen Peters -<speters%samsun@us.oracle.com> - -* w3-mouse.el: w3-follow-inlined-image works again - -* w3-draw.el: -Fixed problem with paragraph filling screwups after <xmp></xmp> sections - -* w3-vars.el: -new keybinding for return so that return doesn't self-insert when not -on a hyperlink - - -* font.el: don't error out on bad rgb color values - -* font.el: Don't error out if you cannot find the rgb.txt file - -* w3-parse.el: -Supports stupid %!@*ing netscape-style <! > `comments'. What complete -and utter horseshit. - -* w3-draw.el: fixed read-only errors once and for all. :) - -* w3-e19.el: removed old bogus definition of w3-follow-inlined-image-mouse - - -* w3-prefs.el: progress - -* w3.el: Now correctly looks for 'stylesheet' in w3-configuration-directory. -Avoid infinite recursion if url-be-asynch == t when -w3-find-default-stylesheets is called - -* w3.el: fix for http 0.9 servers and asynchronous transfers - -* w3-widget.el: -Actually added w3-image-widget-callback so 'href images work right - -Tue May 28 22:35:46 1996 William Perry <wmperry@indiana.edu> - -* w3-prefs.el: Initial revision - - -* w3-menu.el: Put the correct Emacs/XEmacs in the menubar toggle - -* w3-draw.el: -fixed problems with badly specifid colors in netscape-crap <body> attributes - -* w3-forms.el: <input type=image> works minimally - -* w3-forms.el: -Fixed a problem with option lists in forms. The forms validator is cool - -* w3.el: previewing buffers now works much _MUCH_ better - -* w3.el: Added stub for w3-find-file, a more intuitive name for w3-open-local - -* w3-draw.el: Link-echoing now works - -* widget.el, widget-edit.el: -Changed widget-forward to honor a new :help-echo property - - -* widget-edit.el: -Fix for widget-forward when widgets are _RIGHT_ on top of each other - -* w3.el: Fixed stupid problem on my part - -* w3-draw.el: -Fix problem with <pre> segments from Mac-based web servers (^M only, no ^J) - -* w3.el: Don't do set-auto-mode under mule, as it wigs out with null filenames - -* w3.el: Fixes for www: hrefs - -* w3.el: Fix for file information & last-modified - -Mon May 27 23:08:26 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: problem in 19.30 - -* w3-forms.el: -Fixed problem with 'submit' button on forms _always_ being sent to the -server - overanxious with making sure everything had a 'name' field at -widget creation time. Gack. - -* w3-xemac.el: -Beginnings of a mode-motion-handler to do spiffy handling of client -side imagemaps, etc. - - -Sun May 26 01:17:31 1996 William Perry <wmperry@indiana.edu> - -* images.el: removed duplicate converter - -Fri May 24 18:19:16 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: file: urls for images work now - -* w3.el: Fixed missing paren in configuration-file warning code - -* w3.el: New version of w3-version from "Robert J. Chassell" -<bob@gnu.ai.mit.edu> that will let you do C-u M-x w3-version to insert -the version information into the buffer at point. - -* w3.el, w3-hot.el, w3-forms.el, w3-emulate.el, w3-annotat.el: -No longer use mm-insert-file-contents lossage - -* images.el: Added p[np]m<->ps converters - - -* w3-widget.el: No more newlines after images w/alt text & no hyperlink - -* w3.el: Moved where w3-default-configuration gets loaded so that you can set -some variables in it and have them honored by the rest of w3-do-setup - -Thu May 23 16:08:23 1996 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: -Now only grabs images with the same URL/SRC once per page, instead of -starting up multiple transfers for the same one. Yeah. - -* w3-menu.el: context-sensitive menus now work again on images - -* w3-sysdp.el: synching up with XEmacs 19.14's version - -* w3-sysdp.el: Added lots more device functions - -Wed May 22 17:08:21 1996 William Perry <wmperry@indiana.edu> - - -* w3-widget.el: Now checks for invalid glyphs before removing the textual -representation from the buffer. - -* w3.el: Removed w3-beta from the distribution - functionality moved elsewhere - -* w3-widget.el: -Better handling of images that are hyperlinks that have no 'alt' text. - -* w3-draw.el: -Some stuff from the old w3-beta, image fixes, initial color of html page should be better. - - -* dist.Makefile: -Removed w3-beta from the distribution - functionality moved elsewhere - -* w3-emulate.el: Moved w3-read-netscape-config into w3-emulate - -* w3-widget.el: Few screwups w/markers fixed - -Tue May 21 05:31:56 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-forms.el, w3.el: Some XEmacs 20.0 MULE changes - -* w3-xem20.el: Initial revision - - -Mon May 20 16:17:37 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Asynch image loading works! - -* w3-widget.el: Put a help-echo property on the image extent when necessary - -* w3-imap.el: Removed lots of stuff into the new image widget - -* w3-widget.el: -Make sure you always use a marker for the 'where' of an image widget - -* w3.el: w3-my-safe-copy-face is now a little more paranoid so that it will not -bomb on TTYs - -Sat May 18 22:44:53 1996 William Perry <wmperry@indiana.edu> - -* widget-edit.el: some text property munging for XEmacs - -* w3-widget.el: Yet more bug fixes for ye olde image widget - -* w3-widget.el: -reorded some checks in the image widget callback so that client side -imagemaps got done correctly. - -* w3-draw.el: -Fixed bug in the use of the new image widget when it was _not_ used -like <a href=foo>test<img src=blah>test</a> - -* w3-forms.el: Support <input type=button> ala netscape - -* w3-forms.el: Give default labels to submit and reset buttons - - -Fri May 17 19:52:49 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Now uses the new image widget - -* w3-widget.el: Various fixes - -* dist.Makefile: Added w3-widget to the distribution - -* w3-forms.el: -Fixed radio button formatting problems (similar to choice options) - -* w3-menu.el: -Don't put the hide location and hide statusbar menu entries in under -Emacs 19 just yet. - -* w3-imap.el: Few fixes for Emacs 19 in tty mode - -* w3-forms.el: -Option lists now no longer insert a newline unconditionally. Ack. - -* w3-draw.el: inhibit-read-only for some Emacs 19 lossage - -Thu May 16 16:15:01 1996 William Perry <wmperry@indiana.edu> - -* w3-menu.el: Better fix for XEmacs w/no menus - -* w3-mouse.el: -Do not use button keysyms if no X support is compiled in (button1, etc) - -* w3-xemac.el: -Don't make toolbar buttons if not (featurep 'toolbar). Don't add our -help stuff to the help menu unless (featurep 'menubar) - -* w3-menu.el: -Don't install menus under XEmacs unless (featurep 'menubar), otherwise it will bomb on a TTY-only XEmacs. - -Tue May 14 16:32:16 1996 William Perry <wmperry@indiana.edu> - -* w3-widget.el: Initial revision - -* font.el: Strikethru stuff works again. - -* default.css: added some netscapisms in the default stylesheets - -* w3-style.el: Added a require 'cl for 'case' handling - -* w3-parse.el: Added 'strike' tag to %font in the DTD ala HTML 3.2 - -Mon May 13 20:56:52 1996 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Removed w3.ad from the distribution, as it is no longer used. - -Fri May 10 16:28:13 1996 William Perry <wmperry@indiana.edu> - - -* w3-imap.el: Now displays client-side imagemaps pretty sweetly under Emacs 19 -(drop-down list of destinations)... Whoo hoo! - - -* default.css: few changes to default stylesheet - nothing major - - -* w3-draw.el: fixed problem in w3-decode-area-coords - -Thu May 9 13:46:42 1996 William Perry <wmperry@indiana.edu> - - -Wed May 8 17:52:10 1996 William Perry <wmperry@indiana.edu> - -* w3.el: Avoid creating bad html in w3-document-information - - -Tue May 7 16:06:20 1996 William Perry <wmperry@indiana.edu> - - -* w3-vars.el: New keybinding C-A-t for listing open network transfers - - -* w3-draw.el, w3-forms.el, w3-parse.el: Support <keygen> tags in the parser - -Mon May 6 18:03:06 1996 William Perry <wmperry@indiana.edu> - -* images.el: fixed image converter for tiff->pnm and pnm->tiff. Also added -converter for JBIG (?!) image type - -* w3-forms.el: -Fall back to using old-style looking stuff for text entry areas - some -HTML was truly confusing where the widget ended and began. Gack. - -Thu May 2 16:24:12 1996 William Perry <wmperry@indiana.edu> - - -* dist.Makefile: now installs default.css - -* w3-imap.el: -image order fixed on pages with consecutive images with no text in between. - -* w3.el: Now looks in the data-directory and data-directory/w3/ subdir for -stylesheet files. Now looks for several stylesheet files, not just -the first one it finds. - -Wed May 1 21:36:37 1996 William Perry <wmperry@indiana.edu> - -* w3-e19.el: fixed mouse waggling under fsf - -* w3-vars.el: Added default for w3-source-file-hook ... automatically goes into -html-mode (should probably do font-lock as well to get netscap'y look) - -* w3-draw.el: Fixed <body> tags yet again... god am I stupid - -* w3-e19.el: Fixed mouse movement under FSF - - -* w3.el: auto-autoload w3-do-setup - -* w3-vars.el: changed w3-documentation-root - -* w3-menu.el, w3-xemac.el, w3-toolbar.el, w3-mouse.el: - -* w3-menu.el: -Now use w3-default-configuration-file for saving options from the menubar - -* w3-auto.el: removed a few autoloads due to the forms revamping - -* docomp.el: few more stub variables - -* w3-vars.el: More forms fixes - -* w3.el: Some jka-compr fixes - -* w3-style.el: removed annoying 'applying style hints' messages - -* w3-draw.el: Fixed the handling of default attributes on <body> tag for text -coloring, etc. Wasn't using the new syntax the stylesheet parser was -expecting. - -* w3-hot.el, w3-menu.el: In XEmacs, changed the hotlist menu constructor to use -w3-html-bookmarks instead of adding a separate menu item for it. -Consitent with how it has to be done under Emacs19 - - -Tue Apr 30 20:45:20 1996 William Perry <wmperry@indiana.edu> - -* w3-mouse.el: In netscape emulation mode, emulate the mouse bindings as well. - -* font.el: -Now takes care of setting a display-table on the face for smallcaps and bigcaps - -* w3-forms.el: more fixes - -* w3-sysdp.el: Added definition of alist-to-plist - -* w3-draw.el: fixed some <select> issues - -* w3-forms.el: New round of cleanup of the forms code continues - -Sat Apr 27 04:31:57 1996 William Perry <wmperry@indiana.edu> - -* widget-edit.el: fixed typo in the 'sexp' widget - -* w3-auto.el: autoload widget-forward/backward - -* widget-edit.el: Fix for file widget -use 'keymap property when in xemacs, 'local-map when in fsf - -* w3-menu.el: -Don't put the toggle toolbar menu item up in Emacs or a XEmacs with no -toolbar support - -* w3-draw.el: More efficient handling of end of hyperlink - -* w3-beta.el: w3 buffers are no longer read only - -* w3-forms.el, w3.el, w3-mouse.el: -Make middle-mouse-button run w3-widget-button-click, that will not -call widget-button-click if there is no widget under the event - this -avoids being able to paste into the buffer, etc. Gack! - - -* w3-vars.el: -no longer show the read-only/modified status in the modeline for w3 buffers - -* w3-vars.el: Yet more key shuffling for the widget stuff - -Fri Apr 26 23:09:10 1996 William Perry <wmperry@indiana.edu> - -* widget-edit.el, widget.el: Initial revision - -* w3-forms.el: -Only set the face of a form element if one has been explicitly defined - -* w3-imap.el: -Removing alt text from the buffer when loading images works again... yahhh - -* w3.el, w3-forms.el, w3-auto.el, w3-e19.el, w3-menu.el: -Fixed the 'links' menu for both XEmacs and Emacs - -* w3-keyword.el: -elc files should now be portable between XEmacs and Emacs again... as -long as you don't use the byte-compile-dynamic stuff. - -* w3-draw.el: -Fixed problem of w3-handle-hyperlink-end being a little too aggressive -about putting the highlight and link properties on empty <a> tags. - -Thu Apr 25 19:08:45 1996 William Perry <wmperry@indiana.edu> - - -* w3-xemac.el, w3-vars.el, w3-style.el, w3-menu.el, w3-imap.el, w3-forms.el, w3-e19.el, w3-draw.el, w3.el: -Lots and lots of changes... -- config files are now all in ~/.w3/, ala netscape -- everything is now done via the excellent 'widget' package and text - properties... most of the code in w3-e19 and w3-xemac is now gone -- 90% of the forms code is gone, subsumed by widget -- some stylesheet changes for the latest CSS level 1 draft -- general cleanup of lots of other code -- many changes all over the place to deal with the new widget package - and text-property representation - -* w3-auto.el: more autoloads - - -* w3-hot.el: New way of extracting the default title of a link under point - -* w3-beta.el: No longer call w3-mule-attribute-zones - - -* w3-emulate.el: No more special casing of keysyms based on emacs version... - -* w3-toolbar.el: Changed the default toolbar type to 'both - - -* dist.Makefile: added w3-mouse.el to the distribution - -* w3-mouse.el: Initial revision - -* w3-menu.el: -Moved new, unified version of context sensitive menu code into w3-menu - - -* w3-mule.el: Removed lots of old crap - - -* w3-keyword.el: Initial revision - -* font.el: -Now tags colors that are actually vectors as [rgb #r #g #b] instead of -just [#r #g #b] - -Mon Apr 22 16:48:31 1996 William Perry <wmperry@indiana.edu> - -* docomp.el: Added bogus def of has-modeline-p to shut up emacs-19 - -* w3-auto.el: renamed w3-annotate.el to w3-annotat.el - - -Fri Apr 19 20:40:46 1996 William Perry <wmperry@indiana.edu> - -* w3-auto.el: Added autoloads for widget package - -Thu Apr 18 12:57:47 1996 William Perry <wmperry@indiana.edu> - - -Wed Apr 17 13:35:41 1996 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Don't send the truncated URL that is used for displaying menus to the -actual function. D'oh! - -Tue Apr 16 17:37:59 1996 William Perry <wmperry@indiana.edu> - -* w3-merge.el: Initial revision - -Mon Apr 15 21:24:04 1996 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: Use temporary faces in XEmacs, so people don't puke when they do -edit-faces and see all the crappy face names. - -Sat Apr 13 01:07:49 1996 William Perry <wmperry@indiana.edu> - -* w3.el: New function w3-popup-image-info that displays info about an image ala -netscape 2.x - -* w3-menu.el: -slight re-ordering of the options menu. Can now turn off the modeline -and minibuffer - -* w3-e19.el, w3-xemac.el: -When the menubar is turned off, add a turn menubar back on option to -all context sensitive menus - -* w3-vars.el: Shortened the context-sensitive menu over hyperlinks - -Fri Apr 12 03:51:20 1996 William Perry <wmperry@indiana.edu> - - -Thu Apr 11 17:43:48 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Now handles set-cookie commands from <meta> tags - -Wed Apr 10 14:30:19 1996 William Perry <wmperry@indiana.edu> - - -* w3-vars.el, w3-draw.el, w3.el: -Set the variable list-buffers-directory appropriately to show the URL -for all the various W3 buffers via list-buffers. - -Tue Apr 9 20:52:52 1996 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -url-truncate-url-for-viewing can now take an optional width parameter. -If an unknown URL type is found, put quotes around it in the error -message so that its easier to know what exactly wasn't recognized. - - -* w3-parse.el: Various patches from jbw. -1. Parser-side fix for <XMP> duplication. -2. Percentages would get way out of wack on large files - -Mon Apr 8 22:40:47 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: fixed problem in w3-decode-area-coords that would mess up on some -client side imagemaps (namely www.excite.com) - -Wed Apr 3 15:45:43 1996 William Perry <wmperry@indiana.edu> - -* images.el: more tcsh crap... please make it stop. - -* w3.el: Added new w3-fetch-other-window command - -Tue Apr 2 17:16:23 1996 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Some extent functions for emacs19 - -* w3-imap.el: Client-side image mapping polygons work now. - -* images.el: Hopefully final fix for csh/tcsh - -Mon Apr 1 18:58:49 1996 William Perry <wmperry@indiana.edu> - - -* images.el: fixes for csh/tcsh shells, yet _AGAIN_! - - -* w3-menu.el: Can now toggle the menubars from the options menu - -Thu Mar 28 20:04:03 1996 William Perry <wmperry@indiana.edu> - - -* docomp.el: fix for emacs 19.28 griping because of those %!@#%!@ defsubsts. -If you ar eusing 19.28, please please upgrade. - -* w3-menu.el: New 'style' menu item to control the IE 3.0 compatiblitiy parsing - - -* w3-style.el: -now :normal: or :default: in a stylesheet end a device-specific section - -* w3-style.el: -CSS now handles C++ style // comments like the unreleased IE 3.0 with -stylesheets. Oh, the joy of compatibility! - -Wed Mar 27 19:44:12 1996 William Perry <wmperry@indiana.edu> - -* images.el: -Possible fix for image loading problems seen when people have csh or -tcsh as their default shell. Good lord, are these people insane? See -http://www.cs.ruu.nl/wais/html/na-faq/unix-faq-shell-csh-whynot.html -for details. - -* w3-forms.el: -fixed problem with some forms that don't deal well with following the -!@#%!@ing spec for application/x-www-form-urlencoded. Now does not -escape the _ character. #%!@#%!@#%!@%!@#%!~@ - wow, its lucky we -passed the CDA or someone might have gotten offended here. - -* w3-draw.el: -now handles xmp slightly differently - waiting for patches from jbw -for the parser end of the fix. - -* w3-style.el: -You can now have emacsen specific sections of a CSS stylesheet by -using the device-specific stuff. Use :emacs: or :xemacs: as the -device type and away you go. - -Tue Mar 26 21:14:19 1996 William Perry <wmperry@indiana.edu> - - -* w3-e19.el: Fixed the 'submit form to nil' bug in mouse movement - - -* w3.el, w3-hot.el: HTML bookmark parsing now actually works. - -Mon Mar 25 14:53:56 1996 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el, w3-about.el: -Changed some pointers to ben wing and pearl software. - -Wed Mar 20 15:50:50 1996 William Perry <wmperry@indiana.edu> - - -* w3.el: -Prefix arg to w3-quit now kills all w3 buffers, not just the current one. - -* w3-draw.el: fixed a problem with ^M in <XMP> and <PRE> sections - -* w3-imap.el: protect against passing invalid data to make-glyph - -Sun Mar 17 23:20:14 1996 William Perry <wmperry@indiana.edu> - - -Tue Mar 12 18:23:12 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Stubs for math mode - -Sat Mar 9 17:47:21 1996 William Perry <wmperry@indiana.edu> - -* w3-toolbar.el: -Should now work correctly with no toolbar support compiled into XEmacs. - -Wed Mar 6 01:52:32 1996 William Perry <wmperry@indiana.edu> - - -* w3-imap.el: -Fixed problem with button2 usage in w3-imap.el when compiling with FSFMacs - -Fri Feb 23 01:58:21 1996 William Perry <wmperry@indiana.edu> - - -Wed Feb 21 17:06:00 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Now outputs a warning when it runs into a table, just so people know -its not my fault if it looks like crap. :) - -* w3.el: Now uses the real add-minor-mode - -* w3-sysdp.el: Added stub for add-minor-mode - -* w3.el: Now set buffer-file-truename and buffer-file-name to nil when sourcing -a document. - -* w3-draw.el, w3-sysdp.el: -Few fixes for #%!@ damn emacsen that don't sanely deal with make-face et. al -on a TTY interface. - - -Tue Feb 20 14:12:27 1996 William Perry <wmperry@indiana.edu> - - -Mon Feb 19 15:13:55 1996 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Changed binding of mouse-2 to 'ignore instead of 'undefined - more polite. - -Sun Feb 18 19:11:45 1996 William Perry <wmperry@indiana.edu> - -* RelNotes2.3: Initial revision - -Sat Feb 17 23:50:00 1996 William Perry <wmperry@indiana.edu> - -* w3.el: fixed loading of default stylesheet stuff. gack. - -* w3-auto.el: fixed autoloading of css parser - - -* w3.txi: manual formatting changes - wheee. - - -* w3-menu.el: -Now explicitly require easymenu for FSF19 - some older versions don't -autoload it. *sigh* - -Fri Feb 16 21:39:19 1996 William Perry <wmperry@indiana.edu> - - -Thu Feb 15 22:56:04 1996 William Perry <wmperry@indiana.edu> - -* w3.el: w3-fetch now defaults to http://www. if you are not in a w3 buffer - -* w3-menu.el: Added menu item for incremental display - -Mon Feb 5 17:01:39 1996 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Fixed bug in the <font> handling if all you are doing is setting a color - -Tue Jan 30 15:16:43 1996 William Perry <wmperry@indiana.edu> - -* w3.txi: Added section on emulation. Updated copyright info and dates. - -Sun Jan 28 06:17:55 1996 William Perry <wmperry@indiana.edu> - -* w3-menu.el: Fleshed out the doc string of w3-use-menus some more. - -Sat Jan 27 18:59:57 1996 William Perry <wmperry@indiana.edu> - -* w3-style.el: Made more of the functions names be saner... don't pollute the -namespace for when we support more stylesheet notations. Need to -extrapolate it some more and have a registry of acceptable notations. - -Fri Jan 26 18:40:42 1996 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: No longer adds WWW options submenu to the main options menu - - -* w3.el, w3-xemac.el: -Lots of changes for new client-side imagemap support and cleanup of old code. - - -* w3-menu.el: New `style' menu - -* w3-imap.el: -Lots of changes for new client-side imagemap support and cleanup of old code. - -* w3-emulate.el: -Added keybindings for left & right arrow keys under netscape emulation. - -* w3-draw.el: -Lots of changes for new client-side imagemap support and cleanup of old code. -Removed inlined mpeg code, waiting for XEmacs 19.15 to support it again. - -* descrip.mms: Updated the VMS makefile for the new files - -* dist.Makefile: Added w3-menu.el to the distribution - -Thu Jan 25 17:51:39 1996 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: -Moved over to new, more robust menu specifications - mainly stolen from VM. - -* w3.el, w3-vars.el, w3-emulate.el: -Moved w3-search-* functions out of w3-emulate.el into w3.el where they belong. -Moved some variables out as well. - -* w3-e19.el: Removed w3-emacs19-hack-faces-p support. -Moved over to new, more robust menu specifications - mainly stolen from VM. - -* w3-menu.el: -Menus now appear to work under both emacs19 and XEmacs. Fixed problem -where 'Search Again' was always available, even if no search had been -done yet. - - -* w3-menu.el: Initial revision - -Tue Jan 23 18:05:08 1996 William Perry <wmperry@indiana.edu> - -* font.el: Fixed problem with latest XEmacs 19.14 beta - - -* w3-emulate.el: -lynx/netscape emulation now uses new w3-search-forward function - -* w3-toolbar.el: Toolbar now uses new w3-search-forward function - -* w3-imap.el: Work around small bug in the 19.14 beta byte compiler - -* w3.el: Don't choke and die if you can't find ange-ftp - -Mon Jan 22 16:15:42 1996 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Added w3-emulate.el to distribution - -* w3.el, w3-vars.el: Moved the emulation stuff into a separate file - -* w3-emulate.el: Initial revision - -Sun Jan 21 19:16:33 1996 William Perry <wmperry@indiana.edu> - - -* dist.Makefile: Added w3-imap.el to the distribution - -Sun Jan 14 01:00:30 1996 William Perry <wmperry@indiana.edu> - -* w3.txi: updated w3.org mailing list addresses - -* w3.txi: Added section on reporting bugs... needs finishing - -Sat Jan 13 08:30:06 1996 William Perry <wmperry@indiana.edu> - - -Fri Jan 12 19:42:17 1996 William Perry <wmperry@indiana.edu> - -* w3-parse.el: Added parsing stuff for client-side imagemaps - -* w3-draw.el, w3-vars.el, w3-imap.el: -Client-side imagemaps parse correctly now, and the data is stored. - -* w3-e19.el: -Make the options button look a little more like a button under emacs 19 - -* w3.txi: Combined some of the indices to make it easier to find stuff. - -* w3-imap.el: Fixed macros x-coord and y-coord - -* w3-imap.el: -Added definitions for point-in-rectangle|circle functions, and stub -for point-in-polygon function - -* w3-imap.el: Initial revision - -Wed Jan 10 13:32:30 1996 William Perry <wmperry@indiana.edu> - -* w3.el: Renamed w3-store-in-x-clipboard to w3-store-in-clipboard - -* w3-xemac.el: New version of w3-store-in-clipboard - -* w3-e19.el: Renamed w3-store-in-x-clipboard to w3-store-in-clipboard - -* w3-e19.el: w3-store-in-x-clipboard now uses x-select-text instead of -x-set-selection, which is more correct as a good X citizen I guess. - -Sun Jan 7 17:03:38 1996 William Perry <wmperry@indiana.edu> - -* w3.el: only check current-prefix-arg if interactive-p. Otherwise we hose up -things in ffap.el and probably lots of other things nobody has found -yet. - -Wed Jan 3 19:47:47 1996 William Perry <wmperry@indiana.edu> - -* w3-vars.el, w3.el: -New netscape emulation minor mode that sets up a lot of keybindings. - -* font.el: Made set-face-background|foreground|font interactive again. - -* docomp.el: Now adds urldir to the load path - -* dist.Makefile: Now copies the THIS-IS-VERSION-* files when installing - -* docomp.el: -Now adds URLDIR to load-path instead of unconditionally using ../url - -* dist.Makefile: -Now puts URLDIR in the environment of the compiling emacsen so that -docomp.el can get at it. - -Tue Jan 2 17:52:14 1996 William Perry <wmperry@indiana.edu> - -* w3.el: Renamed a few things from style-sheet to stylesheet, to be consistent - - -Wed Dec 20 18:21:29 1995 William Perry <wmperry@indiana.edu> - -* w3-hot.el: Removed compile-time warnings - -* dist.Makefile: removed w3-srch.el from distribution - -* w3-hot.el: -Basic handling of html hotlists... converts into XEmacs-style menu currently - -* w3-beta.el: Added definition of w3-normalize-spaces - -* font.el: Definition of define-new-mask macro should now work on older emacs -19.2x that don't understand native backquoting. - -* w3-parse.el: -No longer throw up a warning for <hr> in <pre> - it really is legal HTML 2.0 - -* w3-xemac.el: Now stores the parse _tree_ in w3-current-parse. -Modified the view-parse-tree menu item to show this (not just w3-last-parse-tree - -* w3-parse.el: -Made w3-display-parse-tree able to take a parse tree as an argument - -* w3-beta.el: -Make w3-refresh-buffer signal an error for now - not yet reimplemented. - - -* w3-vars.el: Added entities - (sim . 126) - (le . "<=") - (agr . "alpha") - (rdquo . "''") - (ldquo . "``") - - -* w3-parse.el: Now allows <hr> inside of <pre> - -Tue Dec 19 22:21:15 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed textarea default input handling - -* w3-vars.el, w3-parse.el: Added variable w3-maximum-line-length - -Mon Dec 18 22:30:38 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Offer to save to disk if an external viewer fails - -* w3.el: If w3-fetch is given a prefix arg, dump to disk. - -* w3.el: -Now defaults to using ~/.netscape/preferences instead of ~/.MCOM-preferences - -Sun Dec 17 21:26:41 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el, w3-vars.el, w3.txi: -Changed w3-link-delimiter-info to w3-link-info-display-function - -Sat Dec 16 17:23:39 1995 William Perry <wmperry@indiana.edu> - -* font.el: fixed typo in tty-font-create-plist - -* font.el: Fixed stupid mistake in font-tty-find-closest-color - -Thu Dec 14 22:34:32 1995 William Perry <wmperry@indiana.edu> - -* font.el: Now uses linethru if on XEmacs - -* default.css: Moved to new CSS comment syntax -Added new stuff for TTYs - - -Wed Dec 13 15:49:44 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Removed a bunch of old code for XEmacs <= 19.13 - -* w3-xemac.el: Now registers all netpbm utilities by default - -* font.el: Added a few new bitmasks (overline linethrough) - -* w3-style.el: -Now handles the new CSS style syntax - will they every !%#@ing decide -on one and stick with it?!!?!? - - -Tue Dec 12 22:53:43 1995 William Perry <wmperry@indiana.edu> - -* w3.el: fixed problem in w3-insert-entities-in-string under XEmacs - - -* w3-forms.el: Few form fixes - -* w3-vars.el: Modified the default stylesheet - - -* font.el: Bold now works on ttys - -* w3-sysdp.el: -Added stubs for make-face set-face-foreground and set-face-background -for non-X emacsen - - -Mon Dec 11 22:52:38 1995 William Perry <wmperry@indiana.edu> - -* font.el: Some emacs19 patches - -* font.el: Changed all the style stuff to use bitmasks for speed. -More TTY changes -If no size specified for font, defaults to size of default font for device. -If no family specified for font, defaults to family of default font for device. - -* w3-style.el: All stylesheet stuff now uses the new font package - -Sun Dec 10 17:55:13 1995 William Perry <wmperry@indiana.edu> - -* font.el: Some of the font stuff now works on TTYs (bold/dim/etc) - -* w3-sysdp.el: Added stubs for face-property and set-face-property - -* w3-parse.el: Added wired - -Sat Dec 9 23:36:21 1995 William Perry <wmperry@indiana.edu> - -* font.el: -Added definition of x-font-regexp for emacs19 that has everything font.el -needs in it. - -Fri Dec 8 18:05:48 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: -Better handling of links - now keeps _all_ links with the same rel or rev - -* w3.el: New presentation of document information - - -* w3-xemac.el, images.el: Can now compile under Emacs19 - -Wed Dec 6 14:37:12 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el, w3.el: Now comes with a global fallback stylesheet - - -* w3-style.el: No longer make '/' a 'string' type in the syntax-table - it was -screwing up non-quoted URLs big time. - -* font.el: If running under emacs19, always condition-case where we do a -set-face-font, since it handles different fonts badly right now. - -Tue Dec 5 22:29:28 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el: -New image/hyperlink/default context-sensitive menus. Can now have a -'%s' in the w3-graphlink and w3-hyperlink-menu entries that will be -replaced by the URL under point - -* w3-xemac.el: Now merges context-sensitive menus when appropriate - -* w3-vars.el: Added image mapping for image/png to 'png - -* images.el: Modified the pnm and ppm to gif converters to actually work now. - -* images.el: Added converters for PNG - -Mon Dec 4 19:22:26 1995 William Perry <wmperry@indiana.edu> - - -* w3-xemac.el: XBM images now work again - gross - - -* w3-parse.el: -defvar of w3-sgml-md-syntax-table no longer uses an eval-when-compile -form, since this makes MULE and XEmacs 20.0 croak, and makes the .elc -files non-portable, now that Emacs 19.30 uses a separate data type for -them. - -* default.css: More fun stylesheet things - -* w3.el: When dumping to disk, only send "*/*" in the acceptheader - -* w3-vars.el: Now uses the new 'images' package for image conversion. - -* w3-xemac.el: Now uses the new 'images' package for image conversion. -Removed some stuff for old lemacsen - - -* images.el: Wow, it works - -* new.el: Now handles pre-formatted sections correctly - -* font.el: Default to 12pt font - - -Sat Dec 2 16:55:58 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Applied some patches from joe wells. - -* w3-parse.el: Applied some patches from joe wells. -1. Added error transitions to infer <TBODY>, <TR>, and <TD> when seeing - bad stuff inside a TABLE. A lot of people write shit like this: - <TABLE> Text to be centered in a pretty frame in Netscape </TABLE> -2. Took out a particular error transition for P start tags in the state - transition table that was leading to horrible handling of some bad - HTML I was seeing. I had thought this transition would improve - handling of bad HTML, but I hadn't seen this particular kind of bad - HTML. -3. Fixed a use of w3-invalid-sgml-chars (that didn't work at all) and - fixed its documentation string. - -Fri Dec 1 16:25:58 1995 William Perry <wmperry@indiana.edu> - -* images.el: Initial revision - -Thu Nov 30 14:33:14 1995 William Perry <wmperry@indiana.edu> - - -Wed Nov 29 15:06:58 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Define x-font-regexp-foundry-and-family for Emacs 19 - -* dist.Makefile: -No longer compile w3-sysdp.el - was causing problems in emacs 19.29/19.30 - -* w3-auto.el: Added autoload for w3-form-format-unknown - -Tue Nov 28 16:33:12 1995 William Perry <wmperry@indiana.edu> - -* w3-toolbar.el: Finally fixed nil specifier problem in w3-toggle-toolbar - - -* font.el: Added a new generic font family 'elfin'. New keyword :oblique. New -function font-create-object that converts a window-system-dependent -font specification into our internal representation - -* new.el: Shit, it works! - -* w3-style.el: Now intern's the 'break' items, for faster comparison later. - -Mon Nov 27 22:21:04 1995 William Perry <wmperry@indiana.edu> - - -Sun Nov 26 01:31:44 1995 William Perry <wmperry@indiana.edu> - - -Sat Nov 25 04:47:31 1995 William Perry <wmperry@indiana.edu> - -* new.el: Initial revision - -Fri Nov 24 22:53:55 1995 William Perry <wmperry@indiana.edu> - -* w3.txi: Lots of changes and restructuring - -* w3.txi: -Documented the recent keymap changes for history/annotation/hotlist actions - -* w3-vars.el: Moved history commands onto their own keymap - -* w3-vars.el: -Moved all hotlist and annotation functions into their own keymap 'h' -and 'a' respectively. Comments on the new keybindings are welcome. - -* w3-style.el: -font-size-index now scales by 1.44 instead of 1.2, as CSSv5 recommends - -Thu Nov 23 22:33:22 1995 William Perry <wmperry@indiana.edu> - - -* default.css: Few piddly changes - -* w3.txi: Lots of documentation changes. Thanks to jon konrath - -* w3-style.el: Fixed typo in w3-style-font-size-for-index - -* w3-draw.el: Can now handle <font color=xxx> - -* w3-style.el: The output device specific stuff works now - -* w3-draw.el: -Fixed conversion of netscape <body> attributes into a CSS stylesheet - -Wed Nov 22 16:49:32 1995 William Perry <wmperry@indiana.edu> - -* w3-style.el: Now correctly parses the ":foo:" stuff in CSS to handle multiple -media. Doesn't actually do anything with it yet, but at least it -doesn't make the thing choke and die any more. - -Tue Nov 21 16:33:37 1995 William Perry <wmperry@indiana.edu> - -* default.css: Various tweaks and changes to the default stylesheet - -* w3-style.el: Removed old cssv3 stuff - is now completely cssv5 -Added correct handling of comments - -* w3-draw.el: Setting default background works again - -* w3-xemac.el: -Added a debugging menu for right now to show the last parse tree and the -current stylesheet. - -* font.el: Few changes to not always default to 'medium' font weight, for those -fonts that don't have one. - -Mon Nov 20 14:14:06 1995 William Perry <wmperry@indiana.edu> - -* w3-about.el: Converted about:style to CSSv5 - -* w3.txi: Started revamping some sections - -Sun Nov 19 22:13:17 1995 William Perry <wmperry@indiana.edu> - - -* w3-e19.el: Fixed w3-overlays-at - - -* w3-beta.el, w3-draw.el, w3-e19.el, w3-forms.el: -Everything and its grandmother now uses a default stylesheet - no more -Xresources! - -* w3-mule.el: Fixed a few MULE bugs - -* w3-style.el: -w3-generate-stylesheet-faces does not actually create any of the faces -now - delays that until they are actually needed/used in -w3-face-for-element - -* w3-vars.el: -Everything and its grandmother now uses a default stylesheet - no more -Xresources! - -* w3.el: Everything and its grandmother now uses a default stylesheet - no more -Xresources! -Much faster version of w3-insert-entities-in-string. -Now binds require-final-newline to nil when saving a binary file. -Fixed a few MULE bugs with coding systems and www: URLs -Fixed reading of initial stylesheet. - -* w3-xemac.el: -Everything and its grandmother now uses a default stylesheet - no more -Xresources! - -* w3-auto.el: Now autoloads w3-generate-stylesheet-faces - -* docomp.el: Moved some variable stubs around - -* w3-parse.el: Several patches from jbw to the new parser - -Sat Nov 18 02:54:18 1995 William Perry <wmperry@indiana.edu> - - -* w3-vars.el: Fixed typo in one of the new defvars - -* w3-vars.el: Changed the format of w3-list-chars-assoc and w3-style-tags-assoc - -* w3-draw.el: Removed conversion of old style entity stuff - -* w3-vars.el: Moved w3-html-entities variable - -* w3.el: Now correctly generates stylesheet faces for the user stylesheet. -w3-insert-entities-in-string should now be more efficient. - -* w3-parse.el: Moved w3-html-entities variable - -Fri Nov 17 18:42:54 1995 William Perry <wmperry@indiana.edu> - -* w3-auto.el: Added autoload for w3-parse-arena-stylesheet - -* w3.el: Fixed hashtable stuff under XEmacs - the key of a hashtable must be -able to compare with 'eq', not 'equal', so had to change it to use -symbols instead of the url string. - -* w3-beta.el: -No longer bind pop-up-windows to nil through all of w3-prepare-buffer - -* dist.Makefile: -Now requires that the URL package be installed before continuing - -* w3-parse.el: Added the 'label' tag. - -* w3-draw.el: Fixed dumb mistake in the handling of -w3-visited-node-style/w3-node-style for links under a window system. - -* w3-forms.el: Removed old bogus code - - -* w3-parse.el: Fixed bug in the new entity expansion - -* w3-style.el: -Fixed a problem with the font-weight keyword in style specs. Now -stores the font specification in the stylesheet as well - -* w3.el: No longer unconditionally load w3-sysdp.el - -* w3-draw.el: Fixed some spacing problems - -* w3-parse.el: Various patches from jbw - -Thu Nov 16 18:52:56 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: Added in the emacs-w3 easter eggs to the DTD - -* w3-parse.el: Allow '_' in attribute names - -Wed Nov 15 23:10:23 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Fixed list items with new implied paragraph breaks immediately after - -* w3-draw.el: Fixed the yogsothoth handling - -* w3-xemac.el: Fixed image loading problem - -* w3-parse.el: -Fixed w3-sgml-name-to-string to be a macro instead of a true function. -Since it was wrapped within an eval-when-compile, all calls to it -later on would be fucked due to an undefined function - -* w3-draw.el: Removed some dead code - -* font.el: -Can now correctly combine any number of fonts with font-combine-fonts - -* w3-draw.el: -Fixed problem with not swallowing newlines when necessary due to new parser - - -* w3-forms.el: Moved lots of stuff out into new auxiliary files - -* w3-auto.el: Initial revision - -* w3.el: Moved lots of stuff out into new auxiliary files - -* w3-annotat.el: Initial revision - -* w3-hot.el: Removed the old, unused air mosaic hotlist parser - - -* w3-parse.el, w3-draw.el: -Make a display-table for use globally for things in the windows character set - -* w3-parse.el: The whole new parser from joe wells. M-x amen - -* w3-draw.el: Few changes for the new parser - -Mon Nov 13 15:56:58 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed the <font size=+x> handling - -* w3-draw.el: -Implemented messaging the 'title' of a link instead of just the naked URL -Now honors the nasty netscapism 'seqnum' attribute on <li> tags - -* w3-vars.el, w3-xemac.el, w3-e19.el: -Implemented messaging the 'title' of a link instead of just the naked URL - -* w3-toolbar.el: Activated the w3-toolbar-stop-icon stuff - -Fri Nov 10 17:30:43 1995 William Perry <wmperry@indiana.edu> - -* w3.el: -Fixed problem with application/x-www-form-urlencoding of names of form fields - -Thu Nov 9 20:56:02 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Few fixes for ordered lists in alpha and roman style - -* w3.el: Catch malformed www: URLs - -Fri Nov 3 21:34:35 1995 William Perry <wmperry@indiana.edu> - - -* w3-style.el, w3-draw.el: -Can now specify alignment and textalignment in stylesheets for <hr> - -Thu Nov 2 22:25:50 1995 William Perry <wmperry@indiana.edu> - -* w3-style.el: -Fixed problem in stylesheet parser calling (char-after) at point-max - - -* w3-hot.el: Now requires w3-vars, so that w3-setup-done is bound. - -Wed Nov 1 15:39:06 1995 William Perry <wmperry@indiana.edu> - -* w3.el: More work on allowing the user to do a completing-read on the -annotations of a buffer to delete one. Fixed a few potential screwups -in the annotations code with regard to improperly entity-ized strings. -no longer refetches a text/plain document from the server when you do -a document-source on it. - -* w3-hot.el: -Don't leave backup copies of w3-hotlist-file or url-global-history-file - -Tue Oct 31 06:20:43 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Fixed stupid problem introduced when changing w3-set-fill-prefix-length to defsubst instead of defmacro - -* w3-draw.el, w3-e19.el, w3-vars.el, w3-xemac.el, w3.el: -Now handles empty containers with name/id attributes - -* w3-beta.el: Different formatting for annotations - -* w3.el: Base of allowing the user to choose what annotation to delete when -w3-delete-personal-annotation is called from a non-PAN - -* w3-parse.el, w3-beta.el, w3-vars.el, w3-draw.el: Few performance tweaks - - -Sun Oct 29 02:14:10 1995 William Perry <wmperry@indiana.edu> - -* w3-hot.el, w3.el: -Removed old HTML <div1> so that the new display engine doesn't gripe - -* w3-vars.el, w3.el: Made w3-source-document honor w3-reuse-buffers. Also made -w3-reuse-buffers default to `reuse' - -* w3-draw.el: Fixed the form handling for isindex fields. - -* w3-draw.el: Include a working version of center-line for emacs 19.29 - -* dist.Makefile: Now uses an implicit target. - -Sat Oct 28 04:16:16 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed stupid typos - -* w3-e19.el, w3-xemac.el: -Now signals an error in w3-find-specific-link if the #link could not -be found - -* w3.el: w3-show-history-list now works again - - -* w3-draw.el: Fixed the <option value=xxx> handling - -* w3-draw.el: Make headers nuke <p> alignments on the stack - - -* w3-parse.el: No longer swallows all the trailing '>' after a tag. So -<h1>>>>>></h1> will show up correctly. Hmmmm... is this right? -Comments anyone? - -* w3-draw.el: -first paragraph breaks within a list item are now filled correctly - - -Fri Oct 27 13:41:16 1995 William Perry <wmperry@indiana.edu> - - -* w3-style.el: -Now correctly keeps track of the tags that something applies-to - -correct handling of context and new level 2 attribute references -instead of the old naive way. - -* w3-style.el: Now implements @import for stylesheets ala CSS v4 - -Thu Oct 26 15:11:29 1995 William Perry <wmperry@indiana.edu> - -* font.el: Fixed problem in Emacs 19.29 with the font-set-face-font stuff - -copy-face sends us in the internal vector instead of the face symbol. -Bleah! - -Wed Oct 25 22:35:42 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed following a link to a fragment "#foo" does not add that URL to -url-global-history-completion-list (and thus it will not be shown as a -link that has been followed) if the base URL is already in a buffer. - -* default.css: Updated to new (unreleased) CSS v5 specification - -* font.el: Removed some old function definitions that are no longer used. - -* w3-draw.el: -Will now create the face storage variables if make-face is not bound. -Was causing some of the stuff later on in the display engine to crap -out and die. - -Tue Oct 24 16:42:24 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-style.el: More CSS hacks - -* w3-style.el: Some CSS v5 stuff - -* font.el: Added definition of font-warn - -* w3-style.el: No longer get everything set to a nil/nil/nil/nil font - -Mon Oct 23 23:49:51 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Now honors the special `link' and `visited' classes for anchor tags - - -* w3-style.el: Now honors old back.color syntax - -* w3.el: Now honors the $html-source CSS special - -Thu Oct 19 21:12:50 1995 William Perry <wmperry@indiana.edu> - - -Wed Oct 18 22:20:59 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: few formatting tweaks. - -* w3-style.el: Few various tweaks for font-style - - -Tue Oct 17 21:47:49 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el, w3-e19.el: Fixed form entries - - -Mon Oct 16 20:35:42 1995 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed applicatin/x-www-form-urlencoded crap - -* font.el: -Don't die if the set-face-xxxx functions are undefined when font.el[c] -is loaded - -Sun Oct 15 23:33:49 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed handling of add.before and add-after - -* w3-style.el: Don't bomb out on ttys - -* w3-parse.el: Patch from jbw to handle more bad HTML - -* w3-parse.el: -Correct handling of things like " in an attribute/value pair - - -* w3-beta.el: Better handling of personal annotations - -* w3-draw.el: -Fixed fig and ol handling to be consistent with the new symbol-based -argument lists - -* w3-parse.el: -Moved default parameters for ol into w3-draw where they belong, courtesy of jbw - -* w3.el: Patches for personal annotations by jbw - - -* w3.el: fixed some fuckups in the history list - - -* w3.el: Check return value of url-get-url-at-point in w3-follow-url-at-point -before passing to w3-fetch. - -* w3-vars.el: Fixed documentation for w3-header-chars-assoc - -Thu Oct 12 13:59:58 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Implemented w3-active-link-color for emacs 19 - -Tue Oct 10 16:17:52 1995 William Perry <wmperry@indiana.edu> - -* w3-style.el: Some more CSS v4 stuff - -* w3-draw.el, w3-xemac.el, w3-vars.el: Now has w3-active-node-style - - -Mon Oct 9 02:59:55 1995 William Perry <wmperry@indiana.edu> - -* w3-about.el: Updated the about stylesheet to the new v4 syntax - -* default.css: Updated the default stylesheet to the new v4 syntax - -Sun Oct 8 23:48:10 1995 William Perry <wmperry@indiana.edu> - -* w3-style.el: -Now keeps track of `@define' directives - still need to actually do -something sensible with them though. - -* w3-style.el: -Now understands CSS v4 syntax. Can handle either v3 or v4, based upon -some state in the parser. - - -Mon Oct 2 18:07:36 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Removed some epoch stuff - - -* w3-draw.el, w3-about.el, w3-vars.el, w3.el: Removed some epoch stuff - - -Sun Oct 1 17:34:43 1995 William Perry <wmperry@indiana.edu> - - -Thu Sep 28 13:25:59 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Disabled w3-shuffle-history-menu for now, since it cannot copy with -url-history-list being a hashtable. - -* w3-xemac.el: The url-history-list is now really a hashtable - -* w3-beta.el, w3.el: -Fixed a few problems in the hotlist and history handling where it was -not escaping URLs correctly of < > &, etc. - - -Wed Sep 27 21:44:58 1995 William Perry <wmperry@indiana.edu> - -* font.el: Don't make the rgb.txt buffer visible to the user. - - -Tue Sep 26 14:59:14 1995 William Perry <wmperry@indiana.edu> - -* RelNotes: Initial revision - -Mon Sep 25 21:59:10 1995 William Perry <wmperry@indiana.edu> - - -* w3-xemac.el: No longer tries to auto-detect giftopnm or giftoppm - - -* w3-style.el: Only create font objects when necessary - -* w3-style.el, w3-draw.el: New stylesheet mechanism - - -* font.el: Added lots of color stuff - -Sun Sep 24 17:13:14 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Added def of find-face - -* font.el: Various tweaks - -Sat Sep 23 04:04:14 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-xemac.el, descrip.mms, dist.Makefile: - -* w3-toolbar.el: Moved all the toolbar specific stuff out into its own file - - -* w3-toolbar.el: Initial revision - -Fri Sep 22 15:08:48 1995 William Perry <wmperry@indiana.edu> - - -Thu Sep 21 17:21:24 1995 William Perry <wmperry@indiana.edu> - - -Wed Sep 20 14:07:46 1995 William Perry <wmperry@indiana.edu> - - -* w3-hash.el: Initial revision - -Tue Sep 19 13:48:09 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed fill out forms - -Mon Sep 18 18:13:14 1995 William Perry <wmperry@indiana.edu> - - -* w3.el: A few fixes for w3-url-completion-function to make sure -url-global-history-hash-table is really a hashtable - - -Sun Sep 17 18:04:25 1995 William Perry <wmperry@indiana.edu> - - -* w3-parse.el: fixed typo - -* w3-parse.el: Avoid lots of string-creation in w3-parse-args - -* w3.el: Use all-completions directly in emacs-19 in w3-url-completion-function -for raw speed. - -* w3-draw.el: Fixed some _STUPID_ problems - - -* w3-sysdp.el: -make-hashtable now finds the next highest prime for the initial size. - -* w3-draw.el: -Everything from w3-parse-args is now a symbol, so that the faster assq -can be used when retrieving. It is possible something was missed - -keep an eye out for things getting fucked. - - -* w3-vars.el, w3-draw.el: -Now caches whether a URL has been visited or not between calls to -w3-handle-hype and w3-handle-hyperlink-end, for speed - -* w3.el: Changes to w3-url-completion-function to handle the new internal -representation of the global history. Performance might suffer here -(in XEmacs), but the majority of people don't ever notice the url -completion anyway. :) - -* w3-sysdp.el: Added def of clrhash - - -* w3-sysdp.el: Added hashtable functions - -Sat Sep 16 01:37:54 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Some MULE stuff - -* w3-beta.el: Fixed bug in finding #xxx links - -* w3-draw.el: -Catch error in centering a horizontal rule due to brokenness in emacs 19.29 - - -* w3-vars.el, w3-parse.el, w3-draw.el: -Lots of performance tweaks from jbw@cs.bu.edu (Joe Wells) - -Mon Sep 11 14:32:40 1995 William Perry <wmperry@indiana.edu> - - -Sun Sep 10 23:26:47 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Added defvar for x-library-search-path - -Sat Sep 9 03:17:37 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Added options menu item for honroing stylesheets - - -Wed Sep 6 15:12:24 1995 William Perry <wmperry@indiana.edu> - - -Tue Sep 5 17:41:31 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed stupid problem with new def of w3-warn - -Mon Sep 4 18:10:03 1995 William Perry <wmperry@indiana.edu> - - -* w3-vars.el: Added SGI rgb inlined image converter - -* w3-parse.el: -Fixed problem where something like <a href=^M "foo" would use the ^M -as the href value. Bleah! - - -* w3-beta.el: Integrated new version of w3-prepare-buffer from Shuji NARAZAKI -<narazaki@csce.kyushu-u.ac.jp> that gets rid of the horrid -'asynchronous retrieval finishes when in minibuffer' lossage. Yeah! - -* w3.el: Redirects should now no longer screw up the history list. - - -Sun Sep 3 21:53:09 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Only do the absolute minimum setup necessary in -w3-read-url-with-default - this yields faster response time upon first -starting up via w3-fetch. Uses custom completion routine to only do -the url setup routines when the user requests completion on a URL. - -* w3-sysdp.el: fixed typo in device-mm-width - -Fri Sep 1 02:47:29 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Treat bogus METHODs on forms like GET, but still put up a warning -buffer - - -Thu Aug 31 23:59:33 1995 William Perry <wmperry@indiana.edu> - - -* default.css: Initial revision - - -* w3-draw.el: Put in special test for CR or LF in name of a input field so that -spaces would not be inserted and screw up cgi scripts that aren't -expecting it. - -* w3-xemac.el: Fixed various toolbar problems - -Wed Aug 30 20:36:17 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Incorrectly 'typed' input types now default to `text' - - -* w3.el: Applied patch from jbw@cs.bu.edu (Joe Wells) for the extremely -annoying ` Wrong type argument: overlayp, (w3form (("enctype" -. "application/x- ...' stuff. - -Mon Aug 28 21:15:50 1995 William Perry <wmperry@indiana.edu> - - -* xbm-button.el: Initial revision - - -* w3-xemac.el: Now uses xbm-button-create when necessary - -* w3-xemac.el: Fixed save options bug - - -* w3-draw.el: Fixed bug where 'plain' lists would not be indented at all. - - -* font.el: Initial revision - -Sun Aug 27 01:10:25 1995 William Perry <wmperry@indiana.edu> - - -Sat Aug 26 06:21:20 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Added split-string - -Fri Aug 25 18:56:55 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Added definition of try-font-name - - -* w3-style.el, w3-xemac.el, w3-vars.el, w3-e19.el, w3-draw.el: -Can now specify the default face in style sheets - - -Thu Aug 24 19:08:16 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Changed w3-munge-color-XXX to strip spaces out of color names passed -in. - -* w3-style.el: Some fixes for the arena 0.97 type style sheets - -Mon Aug 21 21:12:22 1995 William Perry <wmperry@indiana.edu> - - -* w3-style.el: Style sheet stuff now more up-to-snuff with CSS v3. Also now -normalizes all colors to their RGB tuples, so that faces can be shared -between stylesheets that refer to them by different names (#FFF -> -black -> #FFFFFF -> etc) - - -Sun Aug 20 23:34:37 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed typo - - -* w3-util.el: Added doc strings for the w3-hyperlink-element-xxxx functions - -* w3-util.el: Added a provide statement - -* w3-util.el: Initial revision - -* w3.el: New version of w3|url-warn - -* w3-draw.el, w3-e19.el, w3-epoch.el, w3-parse.el, w3-style.el, w3-xemac.el, w3.el: -Use new warnings facility. Reimplemented most of w3-debug-html - -* w3.el, w3-draw.el: Now stores the ID attribute of input elements - - -* w3-parse.el: Nuke entities inside of a <textarea> - -* w3-parse.el, w3-draw.el: -Don't parse any markup that occurs inside of a <TEXTAREA> - -* w3-vars.el: -Removed textarea and textargs from w3-state-vector and w3-state-locator-variable - -* w3-draw.el: Fixed O-T-M-P error - -* w3-draw.el: Background bitmaps working again - -* w3-about.el: fixed typo - - -Sat Aug 19 23:39:01 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Made the netpbm stuff come after the loading of the emacs-specific -file, and now checks to see if w3-insert-graphic is bound before doing -any of its checking, so that Emacs 19 etc users won't get the warning. -Also now checks for either pbmtoxbm or ppmtoxbm, since NETPBM doesn't -have ppmtoxpm - -* docomp.el: Added stub for emx-binary-mode - -Fri Aug 18 15:28:14 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Hack to let old xpm icons work for now - -Thu Aug 17 23:46:58 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el, w3-draw.el: Basic support for raman's <label> stuff for forms - -* w3.el: Fixed typo in w3-batch-fetch - -Mon Aug 14 15:00:37 1995 William Perry <wmperry@indiana.edu> - -* w3.el, w3-xemac.el, w3-draw.el: Can now specify width and height on mpegs - -* w3-xemac.el: Use new version of xpm-button.el - -* xpm-button.el: New version from kyle - -* w3.el: Fixed typo in warning about netpbm utilities - -Sun Aug 13 17:50:20 1995 William Perry <wmperry@indiana.edu> - -* xpm-button.el: Made it so it doesn't bomb out on a tty - -* dist.Makefile: added xpm-button to the distribution - -* xpm-button.el: Initial revision - -* w3-style.el: fixed a few typos - - -* w3-xemac.el: -Now uses the xpm-button program to make textual toolbar icons when necessary - -Sat Aug 12 02:33:49 1995 William Perry <wmperry@indiana.edu> - -* w3-about.el: Added about:license and about:warranty URL nodes - -* w3-draw.el: Catch errors when making w3-graphic-face - -* w3.el: Changed the behaviour of url-keep-history - the history list is only -saved to disk if this is eq to `t'. Setting it to anything else -(usually a number) will keep the list in memory so that -w3-show-history-list can still work. - -* w3.el: Don't add the initial page to the history list, so hitting 'B' in the -first W3 buffer won't take you out of any w3-mode buffers. - -* w3-beta.el, w3-hot.el, w3-style.el, w3.el: -Always set coding-system to *noconv* in MULE when inserting file contents - -Fri Aug 11 13:43:14 1995 William Perry <wmperry@indiana.edu> - -* w3-beta.el, w3-draw.el: -Moved w3-show-invisible-href into w3-draw to avoid invalid macro stuff - -* w3-parse.el, w3-draw.el: Don't swallow spaces after <XMP> - - -* w3-xemac.el: -New function w3-start-image-cache-timer that will time out all images -after 5 minutes and cause a garbage-collect so that the pixmaps get -returned to the windowing system. This function will get smarter -soon. - -* w3-xemac.el: -New variable w3-toolbar-type to control waht the toolbar looks like. -Can be 'pictures' 'text' or 'both' for icons only, text only, or -captioned icons repsectively. - -Thu Aug 10 23:15:44 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Put up a big ugly warning if cannot find any of the netpbm utilities -at startup - - -* w3-draw.el: -The size of a <SELECT> area is now defined by the maximum of all the -lengths of the displayed strings or the SIZE attribute. - -* w3-draw.el: No longer picks up the last item of a <SELECT> form area when no -<OPTION DEFAULT> is present - -* w3-xemac.el: Asynch during images should be correctly turned off now - -Sun Aug 6 15:58:35 1995 William Perry <wmperry@indiana.edu> - - -Sat Aug 5 06:11:02 1995 William Perry <wmperry@indiana.edu> - -* w3.el, w3-vars.el: New binding of space to w3-scroll-up - - -* w3.el, w3-draw.el, w3-beta.el, w3-vars.el: More stuff from the MULE folks - - -* w3-xemac.el: Added separators between toolbar buttons - -Sat Jul 29 19:13:33 1995 William Perry <wmperry@indiana.edu> - - -Sat Jul 22 02:51:16 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Don't choke if w3-mode-go-menu is not a keymap in w3-create-hotlist-menu - -Fri Jul 21 13:44:30 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: -Added let bninding around the call to sera-to-fidel-marker to bind -sera-being-called-by-w3 so that all is well with the world when using -it with mule 2.2.3 for ethiopic text - -Thu Jul 20 04:06:34 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed doc string for w3-open-local - also added autoloads for the -w3-maybe-follow-* functions - -Tue Jul 18 13:24:39 1995 William Perry <wmperry@indiana.edu> - -* w3-beta.el, w3-hot.el: -Moved all the hotlist stuff out into w3-hot.el, in preparation for writing -more robust hotlist handling (HTML files, etc, as hotlists). - -Mon Jul 17 14:05:31 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: <HR> handling now inserts fill-prefix/etc if in lists. - -Wed Jul 12 12:42:03 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: -Patch from chuck to use XBM version of toolbar icons if XPM support -not available. - -Tue Jul 11 00:01:49 1995 William Perry <wmperry@indiana.edu> - - -Mon Jul 3 15:28:33 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Fixed problem with multiple <textarea> tags would 'merge' the default -contents. Blah. - - -* w3-draw.el: -Fixed a slight formatting problem for <select multiple> lists when -within a centered area - looked like crap. - -* w3-draw.el: Don't load background images if w3-delay-image-loads=nil - -Sun Jul 2 03:35:07 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Added new target for w3-hot.elc - -* w3.el: Extracted hotlist functions into w3-hot.el - -* w3-hot.el: Initial revision - -* w3-vars.el, w3.el: Changed *-hooks to be *-hook' - -Sat Jul 1 17:14:23 1995 William Perry <wmperry@indiana.edu> - -* w3-mule.el: Fixed problem in w3-convert-code-for-mule - -Thu Jun 29 16:27:33 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Few more tweaks to the makefile - -* dist.Makefile: Now tries to create INFODIR if it doesn't exist - -* w3-e19.el, w3-mule.el, w3-vars.el, w3.el: -Various patches from Katsumi Yamaoka <yamaoka@ga.sony.co.jp> Katsumi Yamaoka <yamaoka@ga.sony.co.jp> for MULE stuff -] - -* w3.el: Fixed a hidden forms problem. - -Tue Jun 27 04:17:59 1995 William Perry <wmperry@indiana.edu> - - -Mon Jun 26 02:29:33 1995 William Perry <wmperry@indiana.edu> - -* w3-wemac.el, w3-xemac.el, w3-e19.el: Fixed problem pointing to w3_toc.html - -Sun Jun 25 22:28:28 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Fixed problem in 19.29 where there were two help menus. - - -* w3-sysdp.el: Some more device-* functions - -* w3-sysdp.el: More NS problems resolved - -* w3-xemac.el: Removed autoload for Info-goto-node - -* w3-sysdp.el: Fixed problem in w3-device-class on NeXTstep - -* w3-draw.el: Fixed problem in w3-get-resource on NeXTstep - -* w3-beta.el, w3-draw.el, w3-epoch.el, w3-mule.el, w3-srch.el, w3-style.el, w3-sysdp.el, w3-xemac.el, w3.el: -Continue movement to using w3-sysdp.el defined functions instead of -url-* funcs - -* dist.Makefile: Removed extraneous w3-sysdp.el from SOURCES macro - -Wed Jun 21 20:04:44 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Few changes for 19.12 - -* w3-draw.el: New version of w3-pause for XEmacs - -* w3-draw.el: Fixed blinking - -Tue Jun 20 14:10:49 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: <listing> now works. - -* w3-draw.el: Fixed <secret> handlig ng when not in XEmacs 19.12 - -Mon Jun 19 15:12:18 1995 William Perry <wmperry@indiana.edu> - - -* w3-sysdp.el: Fixed problem in device-class with arg not being optional - -Sun Jun 18 21:41:36 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: -Fixed bug in emacs-19 version of device-class on non-color displays - -* w3-sysdp.el: Rewrote device-class -Added device-pixel-width and device-pixel-height - -* w3-xemac.el: New function w3-ensure-toolbar-visible - - -* w3-draw.el: Moved valid-color-name-p definition over into w3-sysdp.el - -Sat Jun 17 17:50:44 1995 William Perry <wmperry@indiana.edu> - -* docomp.el: More toolbar stuff - -* docomp.el: Removed lots of stuff that isn't necessary now that we are using -w3-sysdp.el all over the place - -* w3-sysdp.el: Few more bugfixes - - -* w3-sysdp.el: Fixes for nextstep - -* w3-sysdp.el: -Fixed definition of device-class so that it won't choke and die under -NeXTstep. - -* w3-draw.el: -If w3-delimit-links is non-nil, put delimiters around submit/reset -form areas. - -* w3-xemac.el, w3-e19.el: -New options in menu to control honoring of refresh headers and color requests - -Fri Jun 16 21:52:39 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Now honors multiple <title></title> crap like netscape. - -* w3.el: Fixed handling of refresh header if url-honor-refresh-requests == 'ask - -* w3.el: Ask the user before submitting a bug. - -* w3-sysdp.el: Removed scrollbar functions. - -Thu Jun 15 23:42:26 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Always use @echo so it doesn't show up twice. - - -* w3-xemac.el: More <link>-controlled toolbar stuff - - -* w3-xemac.el: Don't call device-type with an argument. - -* w3-beta.el, w3-draw.el: -Fixed a few problems with compatibility with FSF19 in X mode - - -* dist.Makefile: Added urlauth to makefile - -* w3-epoch.el: Fixed problem in w3-map-links - - -Wed Jun 14 23:38:46 1995 William Perry <wmperry@indiana.edu> - - -* w3.el: Removed a few things that are now in w3-sysdp.el - -* w3-sysdp.el: -Changed sysdep-defalias to make sure that 'def' is fboundp if its a -symbol, so that bogus defs of make-frame, etc, are not created in -emacs18 - -* w3.el: Few things to get a nice clean compile using w3-sysdp - -* w3-xemac.el: -Removed loading of w3-sysdp, since it is loaded for everything now. - -* w3-sysdp.el: More functions added - -* w3-print.el, w3-epoch.el, w3-emacs.el, w3-e19.el, w3-draw.el: -Few things to get a nice clean compile using w3-sysdp - -* docomp.el: Now loads w3-sysdp during compilation - -* w3-xemac.el: Stubs for <LINK> specific toolbar stuff. - -* w3-parse.el: Rewrote w3-can-safely-ignore as a macro - -Tue Jun 13 15:38:32 1995 William Perry <wmperry@indiana.edu> - - -* w3-xemac.el: -Moved some stuff over into w3-sysdp.el for a truly clean compile. -Fixed the new 'privacy' menu item - -* w3.el: Added back in text/plain encoder for forms - -* w3-xemac.el: -make sure that when we add our options/help menus to the menubar, we -do it to the global menubar, not just the current one, which could be -anything, but usually GNUS or VM if not the default. - -* w3-xemac.el: Fixed w3-x-poup-menu bug. - -* w3-xemac.el: -Fixed problem skip was having at http://www.calendars.com/concerts/ - -Mon Jun 12 20:32:04 1995 William Perry <wmperry@indiana.edu> - -* w3-wemac.el: Added back in crufty old menu definitions for use in WinEmacs - -* w3-xemac.el: New 'save options' item - - -* descrip.mms, dist.Makefile, w3.el: -Added back in the requiring of w3-wemac - just too much different -stuff between it and even 19.10. - -* w3-xemac.el: -Check for what type of menu we are displaying in w3-sensitize menu, or -some weird stuff could happen (like adding 'go' and 'view' menus to -the 'Emacs' type menubar. - -* w3-xemac.el: Reordered some functions to avoid warnings in byte compiler - -* w3-xemac.el: -Added a button ala VM to swap between the global menubar and the W3 one. - -* w3.txi: Added stub for VMS section of documentation - -* w3.el: Various patches from Richard Levitte <levitte@vms.stacken.kth.se>. -(w3-do-setup): expand VMS Mosaic files correctly. - -* docomp.el: Various patches from Richard Levitte <levitte@vms.stacken.kth.se>. -start with inserting the current directory into load-path. -(hack-dot-emacs): remove the two first items from -command-line-args-left. Otherwise, Emacs tries to work on them when -hack-dot-emacs is done. - -* descrip.mms: -Added the VMS build file from Richard Levitte <levitte@vms.stacken.kth.se> - -* descrip.mms: Initial revision - -Sun Jun 11 22:50:50 1995 William Perry <wmperry@indiana.edu> - - -* w3.txi: -Added in section on disk caching, filled out the Digest authentication -mechanism and SSL sections as well. Only things left to do are the -sections on non-unix platforms. - -* w3-xemac.el: -Deal gracefully with markers passed into w3-add-zone (for WinEmacs) - - -* w3-draw.el: -Fixed stupid FSF 19 lossage where x-color-defined-p signals an error -in a tty instead of failing gracefully. Robustness? Whassat? - - -* w3-draw.el: -Fixed problem in w3-handle-paragraph where re-search-forward could signal an error because 'NOERROR' was not t. - -* w3.el: Fixed w3-find-this-file - -Sat Jun 10 23:19:30 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed stupid screwup - -* w3.el: Run the value of a submit button through url-hexify-string - -* w3-vars.el, w3-draw.el: -Renamed w3-user-colors-take-preference -> w3-user-colors-take-precedence - -* w3-draw.el, w3.el: IMAGE inputs in forms now work (sortof) - -Fri Jun 9 15:01:05 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed problem with unterminated <a> refs. - -Thu Jun 8 14:44:35 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: Fixed plaintext handling. - -Mon Jun 5 15:12:17 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Added color printing toggle to emacs19 menus - -* w3-xemac.el: Added color printing toggle to xemacs menus - -* w3.el: After reading a form entry area, make sure we mark the buffer as not -modified. - - -* w3-draw.el: -fixed w3-handle-paragraph to handle weird circumstances where it could -try to make-string with a negative first arg. - -* w3.el: Patches from girod@trshp.trs.ntc.nokia.com for his local file handling -stuff - -Sun Jun 4 20:58:40 1995 William Perry <wmperry@indiana.edu> - - -Sat Jun 3 17:07:32 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: -Patch from Skip Montanaro <skip@automatrix.com> to make sure we delete -old copies of the .el and info files, since they are read only by -default, and this would cause the installation to fail. - -* w3-xemac.el: -Make sure we don't try to set the X selection from a tty only xemacs - -it signals a wrong-device-type error. - - -Fri Jun 2 13:58:01 1995 William Perry <wmperry@indiana.edu> - -* w3-beta.el: -Removed dependence on url-grok-url from the netscape cache importing - -Tue May 30 16:29:16 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Now recognizes <link rel="style"> as well as <link rel="stylesheet"> - -* w3.el: Fixed bug in w3-hotlist-delete that would choke and die on items named -'hotlist' - fixed the regular expression it was working with. - - -* w3.el: Few fixes - - -* w3-draw.el: Nuke all faces when leaving a <pre> segment - - -Mon May 29 18:24:04 1995 William Perry <wmperry@indiana.edu> - - -* w3-style.el, w3-print.el, w3-parse.el, w3-e19.el, w3-beta.el, w3-about.el, w3.el, w3-draw.el: -Removed lots of function documentation and left it as comments. These -functions are not meant to be seen by everyone, and this saves space -in the .elc files. - -* w3.el: Made w3-save-binary-file default to a sane filename - - -* w3-10646.el: -Removed bogus copyright, added back in the real one from Erik Naggum. -gotta hate cut & paste - -* w3-xemac.el: -Make sure the links menu is broken up when using the filter method in 19.12 - - -* w3.el, w3-xemac.el, w3-epoch.el, w3-draw.el: -Now deals with the removal of url-parse-relative-link - -Sun May 28 22:28:55 1995 William Perry <wmperry@indiana.edu> - - -* w3.el, w3-about.el: Use the new url-register-protocol interface - -* w3-vars.el: Fixed w3-modeline-format to look nicer - - -Sat May 27 22:00:15 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Removed w3-wemac from the distribution and makefile rules - -* w3.el: No longer require w3-wemac if running under windows - the standard -w3-xemac package should handle it now. - -* w3-vars.el, w3.el: -New variable w3-modeline-format that controls the modeline look when -in w3-mode buffers. - -* w3-vars.el: Removed crufty old menu definitions - -* w3-draw.el: -The new color-frobbing stuff works in older versions of lemacs/xemacs - -* w3-xemac.el: First pass at a merger of w3-wemac.el and w3-xemac.el - - -* w3-xemac.el: -Add the options and help menus to the main menubar in all versions of -xemacs - -Fri May 26 23:42:29 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: More patches from chuck for the next great xemacs beta - -* w3-style.el, w3-draw.el: -Avoid calling of set-face-xxx functions directly, use 'apply' to avoid -Emacs-19 lossage of defsubsts that makes .elc files non-portable to -XEmacs. - -* w3-draw.el: Honor the <base> tag stuff when doing forms. - -* w3-vars.el: Few fixes for the latest beta of XEmacs 19.12 - -Thu May 25 19:44:48 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -The body color handling stuff now deals gracefully with bad colors - -* w3.el: Few fixes for VRML - -* w3-style.el: Can now compile under Emacs 18 again. - -Wed May 24 13:47:17 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Rearranged some of the menus to be like the XEmacs counterparts - -Tue May 23 14:30:05 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: More renamings for XEmacs 19.12 - -Mon May 22 12:20:36 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el, w3-e19.el: -Renamed url-automatic-cacheing -> url-automatic-caching - -* w3-xemac.el: Removed call to bogus exit-emacs func. - -Wed May 17 16:20:46 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Support the newer way of doing toolbars in XEmacs 19.12 - -* w3-xemac.el: Patch from chuck for latest XEmacs 19.12 toolbar stuff - - -Tue May 16 20:18:40 1995 William Perry <wmperry@indiana.edu> - -* w3.el: VRML stuff - - -Mon May 15 03:38:36 1995 William Perry <wmperry@indiana.edu> - -* w3.el: If no last-modified, don't try to refetch the head info if not in file -or ftp mode. - - -* w3-style.el: -New w3-spatial-to-canonical function that can convert something like -1in or 12pt to a pixel-based representation. - -* w3-xemac.el: Changed menus when under Lemacs 19.10 look just like 19.12 - -Sun May 14 17:37:35 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Fixed problem with <p align="xxx"> .... <p> not properly terminating -the alignment - - -* w3-about.el: hehe - -* w3.el: Better cleanup of the temp directory. - - -Sat May 13 21:03:14 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: Finished up cookie interface - -* w3-draw.el: -Stub for interface to the cookie() function of emacs from within an HTML -document. - -* w3-about.el: New stylesheet for about: pages - -* w3.el: Make w3-reload-document not recenter the window - -* w3-draw.el: Fixed isindex handling for prompt=xxx and action=xxx - -* w3-draw.el: -Make sure the emphasis on quotes (<q></q>) includes _both_ quote chars. - -* w3-e19.el: -Don't blindly set the mouse-face on anything with 'w3 in the property -list. would cause things like <a name=xxx> to highlight. - - -* w3-xemac.el: XEmacs 19.12 tweaks - -* w3-about.el: -New authors page that doesn't crap out in XEmacs 19.11 / Lemacs 19.10 - -* w3-xemac.el: Few more tweaks to the menus - -* docomp.el: More garbage for a clean compile - -* w3-xemac.el, w3-draw.el, w3.el: Few fixes for the latest beta of XEmacs 19.12 - -Thu May 11 16:32:17 1995 William Perry <wmperry@indiana.edu> - - -* w3-xemac.el: Added buffers menu to w3 menu - -Wed May 10 22:19:25 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: -Don't set up the toolbar if w3-toolbar-orientation is not 'top 'left -'right or 'bottom. Don't set the menubar for the w3 buffer if there -is no default one. Copy the options menu into the main options menu -if in XEmacs 19.12 - -* w3-xemac.el: Fixed images in 19.12 - -* w3.txi: Lots of changes - -* w3.el: Added some stuff from the texinfo docs - -Tue May 9 16:43:46 1995 William Perry <wmperry@indiana.edu> - - -Mon May 8 21:45:28 1995 William Perry <wmperry@indiana.edu> - -* w3-emacs.el: -Fix from Michael Welsh Duggan <md5i+@andrew.cmu.edu> for w3-back-link -in emacs 18 - -* dist.Makefile: Added ssl.el file - -* w3-draw.el: -Fixed problem with <br> in indented areas inserting the indentation twice - -* docomp.el: Turn off new emacs19 dynamic loading gunk - -Sun May 7 23:33:18 1995 William Perry <wmperry@indiana.edu> - - -* w3-style.el: Few fixed for XEmacs 19.12 - -* w3-style.el: More style hackings - -* w3-parse.el: -Gracefully handles stuff like '< ' in a document - this should be -shown. Screw document authors that do stuff like '< a' - its wrong. - -* w3.el: Make w3-mark-link-as-followed be a no-op if w3-emacs19-hack-faces-p is -non-nil, otherwise weird things happen with too many spaces inserted -in the buffer, and there was really no difference between the two -renderings in that nasty mode anyway. - -* w3-xemac.el: Fixed typo in spiffy new menus for xemacs 19.12 - -* w3.el: Let w3-notify-when-ready deal gracefully with a null argument - -* w3-draw.el: Make </pre> without matching <pre> act like <p> - -* w3-draw.el: Added the <flame> tag - -* RelNotes2.2: Initial revision - -* w3-draw.el: Only set w3-last-tag if non-text - -* w3-draw.el: Reverted to old <dt> handling - looks better. - -* w3-about.el: Removed a few dependencies on the old 'b64-xxxx' functions - -* w3-style.el: -New stylesheet parser - can handle the new grammar agreed upon by -H&kon and I. - -* dist.Makefile: Added new base64 package - -Sat May 6 21:46:21 1995 William Perry <wmperry@indiana.edu> - - -* w3-xemac.el: Now puts help-echo property on images that are links - -* w3.el: Now includes a mime-version header for mailed documents - - -* w3-emacs.el: New version of w3-forward-link and w3-back-link that skip over -'w3-graphic zones. - -* w3-draw.el: <tab id=xxx> and <tab to=xxx> work now - -* w3.el: Fixed problem with command-line-args-left being unbound when not in -startup phase - - -* w3-draw.el: New way to handle secrets fixed in old versions of emacs. -Default background pixmap to nil - -* w3-about.el: New text for easter egg tag #1 - -* w3-xemac.el: Image-type selector menu is back. - - -* w3-xemac.el: -Changed mouse activation for image links to button2 to be consistent - -* w3.txi: Few spelling changes - -Fri May 5 23:05:39 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Can now do: -emacs -f w3-fetch [url] - -* w3.el: Can now have 'PUT' as the method for a form. - -* w3-xemac.el: Return the bitmap - -* w3-draw.el: Now handles the 'background' bitmap tag of netscape - -* w3-vars.el, w3-draw.el: Few changes to make the 'secret' tag work better. - - -* w3-xemac.el: Reordering of defvars to make sure we can get a clean compile - -* w3-xemac.el: Use glyph-width if its available. - - -* w3-draw.el: Netscape body tags would choke emacs18 - -* w3.el: Do w3-setup in w3-batch-fetch - - -* w3.el: -w3-save-as can now take an optional argument to tell it what to save as - -Thu May 4 23:58:53 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Cool new menus for XEmacs - -* w3-draw.el: Fixed bug in handling of multiple <dt> elements before a <dd> - -Mon May 1 20:10:36 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el, w3-vars.el: Use the new about: pages - -* w3-draw.el: Fixed <link rel="stylesheet" href="xxxx"> handling - -* w3-style.el: fixed style handling from a URL/href - -Sun Apr 30 20:57:17 1995 William Perry <wmperry@indiana.edu> - - -* w3-xemac.el: New glyph interface for XEmacs 19.12 - -* w3-about.el: More about: docs. - -* w3-epoch.el, w3-draw.el: More fixes for epoch - -* w3.el: Fixed links of just images in XEmacs - -Sat Apr 29 22:25:33 1995 William Perry <wmperry@indiana.edu> - -* docomp.el, w3-epoch.el, w3-draw.el: More epoch fixes - -* w3-draw.el: The netscape background/foreground body colors work in epoch now. - -* w3-epoch.el: All the face stuff now works in epoch again. - -* w3-parse.el: Use w3-10646 if available - - -* w3-10646.el: New keywords - -* w3-10646.el: Initial revision - -Fri Apr 28 22:52:46 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Implemented teh 'add.before' and 'add.after' stylesheet mechanism - -* w3.el: Fixed case where return would pop up an x-menu in emacs19 - -* w3-style.el: Fixed problem with leading whitespace - -* w3.el: Added about URL handling - -* w3-draw.el: Fix to jnetscape body tags - -* w3-about.el: Initial revision - - -Thu Apr 27 01:40:39 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Few updates for XEmacs 19.12 - -Wed Apr 26 17:59:03 1995 William Perry <wmperry@indiana.edu> - - -Tue Apr 25 22:15:55 1995 William Perry <wmperry@indiana.edu> - -* w3.el: w3-in-assoc now silently skips nonstrings in the car - -* w3-draw.el: Can now use regexps in stylesheets (h[1-6], etc) - -* w3-style.el: Added DSSSL-lite parser - - -* w3-draw.el: Now handle <link rel=stylesheet href=xxxx> - -* w3-style.el: Modify the accept headers when retrieving a URL for a stylesheet - -Mon Apr 24 07:52:37 1995 William Perry <wmperry@indiana.edu> - -* w3-print.el: Wrap w3-convert-html-to-latex in case-fold-search == t - -* w3-vars.el: Added w3-node-style and w3-visited-node-style to the persistent -variables list - this is necessary for letting -w3-mark-link-as-followed to work with the netscape body tags. - -* w3-vars.el: Make w3-node-style and w3-visited-node-style buffer-local, or the -netscape tags on <body> screw up subsequent documents! - -* w3-parse.el: Removed a condition-case in w3-nuke-entities-in-region - -* w3-xemac.el: Few more toolbar fixes. -Fixed autoload for Info-goto-node - -Sun Apr 23 22:01:08 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed w3-backward-in-history - -* w3-style.el: -New function w3-create-x-font to create a font based on the family, -style, and size. - -* w3-xemac.el: -New variable w3-toolbar-orientation to control what side of the frame -the toolbar appears on. - -* w3-draw.el: New way of getting info from stylesheets to synch up with the new -stuff from H&kon. - -* w3-xemac.el: Added button for hotlists in the toolbar - -* w3-xemac.el: Various and sundry toolbar stuff. - -* dist.Makefile: Now makes the install directory if it doesn't exist. - -* w3-draw.el: <blink> now works on tty's in XEmacs. -Scaling of fonts in a tty-only XEmacs works also. - -Sat Apr 22 13:42:25 1995 William Perry <wmperry@indiana.edu> - -* w3-print.el, w3.el, w3.txi: Changed references to info.cern.ch to w3.org - - -Fri Apr 21 19:34:47 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Removed a few old variables - -* w3-draw.el: -Don't set attributes on default face if they are nil - bad things man. - -* w3-epoch.el, w3-e19.el, w3-wemac.el: Removed a few old variables - -* w3-xemac.el: -Finally fixed problem in lemacs/xemacs form entry where every once in -a while it would choke with a 'wrong-type-argument stringp (wierd -list)' error. - -* w3-draw.el: Fixed problem with the <body> attributes when in Emacs 19 - -* w3-vars.el, w3-draw.el: -New variable w3-user-colors-take-preference to control whether the -netscape tags on <body> are honored or not. - -* w3-xemac.el: Provide a definition of add-submenu for older XEmacsen - -* w3.el, w3-vars.el: Removed a few old variables - -* w3-draw.el: Now honor the netscape attributes on <body> - -* w3-vars.el: Added keybinding for w3-mail-document-author - -* w3-beta.el: Reimplemented the w3-show-headers stuff. - -Thu Apr 20 20:23:06 1995 William Perry <wmperry@indiana.edu> - -* w3.el: w3-document-information now looks much prettier - -* w3.el: Fixed w3-mail-to-author and Renamed it to w3-mail-document-author to -avoid confusion about what 'author' we are mailing to - the documents, -or Emacs-w3's - - -* w3.el: Revamped the forward and backward history handling - -* w3-draw.el: Got <p nowrap> working - -Wed Apr 19 17:01:58 1995 William Perry <wmperry@indiana.edu> - - -* clean-cache: Initial revision - -* w3.el: Revamped how <link> is handled. Added printing of <link> data in -w3-document-information - -* w3-draw.el: -Revamped how <link> is handled. Fixed a bug in meta handling - was -not downcasing the http-equiv, so it could not always find an old -value in url-current-mime-headers to replace. - -* w3-vars.el: changed w3-list-chars-assoc to use symbols instead of strings - -* w3.txi: Documented change in w3-list-chars-assoc - -* w3-draw.el: Converting w3-list-chars-assoc won't die if you do it twice - -* w3-sysdp.el: Updated to latest version from XEmacs - -* w3-sysdp.el: Removed keywords - -Sun Apr 16 22:41:11 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed problem in w3-handle-emphasis-end - -* w3-draw.el: Added code to fixup spaces are . and ! - -* w3-beta.el: Now parses out the link commands in the mime headers - -* w3.el: Issue an error if they chose a link type (rel or rev) that the -document did not contain when in w3-use-links - -* w3-style.el: -Make the buffer not modified before killing it when parsing a style sheet - -* w3.el: Fixed parsing of default stylesheet - -* w3.el: Fix for form field reversals in submissions - -Sat Apr 15 23:33:36 1995 William Perry <wmperry@indiana.edu> - -* w3-beta.el: Can now import netscape bookmark files - -* w3-draw.el: -Now handles <q></q> differently - inserts "" around the material, and -you can specify the start and end quotes in stylesheets with: -q: startquote=`` -q: endquote='' - -* w3-draw.el: -Was not expanding relative URLs before checking whether they had been -visited with w3-delimit-links non-nil. This would lead to weird -looking links like [[something}} - not very pretty. - -* w3-vars.el, w3.el: Now reads in a default stylesheet for the user if -w3-default-stylesheet is non-nil. This can be a URL. - - -* w3.el: Made w3-pass-to-viewer be more like man when in asynchronous mode. - -* w3-vars.el: New variable w3-notify - -* w3-parse.el: -Fixed problem in pre/xmp handling where it would choke if there were -extra endtags and swallow-newlines went negative. - -Fri Apr 14 23:52:51 1995 William Perry <wmperry@indiana.edu> - -* w3.el, w3-xemac.el, w3-wemac.el, w3-vars.el, w3-style.el, w3-srch.el, w3-print.el, w3-parse.el, w3-next.el, w3-mule.el, w3-mac.el, w3-epoch.el, w3-emacs.el, w3-e19.el, w3-draw.el, w3-beta.el: -Changed keywords - -* w3-vars.el: removed old variable w3-global-history-completion-list - - -* w3-draw.el: No inherent maxlength on <textarea> fields - -* w3.el: Added alias for w3-popup-info - -* w3.el: Always goto (point-min) in w3-document-information and w3-popup-info - -* w3-vars.el: Added keybindings for w3-document-information and w3-popup-info - -Thu Apr 13 21:12:33 1995 William Perry <wmperry@indiana.edu> - - -* w3-style.el: w3-blend-colors now works in XEmacs 19.12 - -* w3-style.el: Added function w3-blend-colors (FSF Emacs-19 specific) - -* w3-parse.el: -Make sure to clear the minibuffer when done parsing - otherwise it -could leave a 'Parsed x of y (zz%)' message, which can make people -think it is hung. - -* w3-draw.el, w3.el: Fixed <link> handling - -Wed Apr 12 03:24:02 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Fixed a few problems with stylesheets losing the alignment info from -headers too soon. - -* w3-draw.el: -<p></p>, <div></div>, and <note></note> can all specify the face to -use for an element via the 'class' attribute. - -* w3-draw.el: Fixed a bug in using the 'class' attribute to add faces to text. -Would forget what tag would end the current face, so faces went on -forever. Ugh! - -* w3-draw.el: The 'class' attribute can now be used to add faces to text. - -* w3-style.el: Changed how style sheet faces are regenerated. Now stores the -face-name as an item in w3-current-stylehseet (assoc "face" ...) to -get it. - -Tue Apr 11 23:11:58 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Added some more stuff from chuck - -* w3-draw.el: Fixed popping the alignment from an address tag if -w3-right-justify-address is non-nil - -* w3-draw.el: Redid w3-get-default-style-info macro - - -Mon Apr 10 22:46:14 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: Added thge marca sound for <hype> tag. - -* w3-draw.el: Now honors the 'class' attribute on any style-sheetable tag - -* w3-style.el: -Few tweaks to how the style sheet is stored, to make using the 'class' -attribute on tags quicker (stores an intern'd symbol and a string in -the list) - -* w3.el: Fixed problem where inlined images on the local disk could get trashed -because buffer-file-name was not nil in the buffer. - - -* w3-draw.el: Fixed <font size=-x> handling - -* w3-parse.el: Call sera-to-fidel-marker if in mule. - -Sun Apr 9 18:37:24 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed <div> </div> handling - -* w3-draw.el: -Use copy-tree on w3-use-stylesheet so we don't side-effect the original list - - -* w3-xemac.el: Added in the code to create the toolbar. - -* w3-beta.el: Fixed the importing of netscape cache files - - -* w3-draw.el: -Changed w3-push-alignment to be a little smarter - if align is null, -don't bother pushing it on the stack. - -* w3-parse.el: -Fixed a spacing problem that would show up when doing progressive -rendering but not a w3-refresh-buffer. Ugh. - - -Sat Apr 8 23:34:06 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Made w3-generate-error check the contents of the ' *url-error*' buffer -and use it as part of the error message. - -* w3-draw.el: -Got rid of bad use of concat in w3-handle-font, and better handling of -the font scaling. - -Fri Apr 7 22:59:07 1995 William Perry <wmperry@indiana.edu> - - -* w3-e19.el: Remove the files menu in emacs 19.29 - -* w3.el: Fixed problem in mule with w3-save-binary-file - -* dist.Makefile: Added -no-site-file to BATCHFLAGS - -* dist.Makefile: More renaming for DOS lossage - -Wed Apr 5 19:59:33 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed w3-fetch for working in buffers with no default url... d'ohhh - - -* w3-draw.el: -Fixed screwup in w3-handle-p that would push an alignment onto the -stack twice for headers - -* w3.el: w3-fetch now has a 'silent' default - it doesn't insert the default as -the default option - it checks if the user presses return, and uses -the default if they did. - -* w3-draw.el: Now uses a stack of alignments, and honors the <div></div> tag. - -Tue Apr 4 17:29:32 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Makefile now works in Windows and NT - -* w3.el: Removed anonymous lambda from w3-hotlist-apropos - -* w3.txi: Fixed typo in texinfo node - -Mon Apr 3 23:03:19 1995 William Perry <wmperry@indiana.edu> - - -* hype.au: Initial revision - -Sun Apr 2 20:17:02 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed <meta> handling - -* w3.el: Fixed w3-popup-info - - -* w3.txi: Basic documentation of the style sheet mechanism - -* w3-draw.el: -Fixed the align=indent problem where first line of the indented region -was not indented. - -* dist.Makefile: Renamed w3.texinfo to w3.txi, for 8.3 losingness - - -* w3.txi: Removed all the 'WORK' areas except for the non-unix systems nodes. -Put out a call for assistance to w3-beta and gnu-emacs-help for these -areas. - -Tue Mar 28 23:36:30 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed a few more concat'ing integer problems - -* w3-draw.el: Can now specify OL styles in stylesheets. - - -* w3.el: -Added w3-hotlist-apropos function from mic@cs.ucsd.edu (Michelangelo Grigni) - -* w3-xemac.el, w3-e19.el: Fixed concat'ing of ints - -Mon Mar 27 22:05:19 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Now requires w3-print - -* w3-draw.el: Only mangle headers if w3-delimit-emphasis is non-nil - - -Sun Mar 26 19:50:16 1995 William Perry <wmperry@indiana.edu> - - -* dist.Makefile: Removed w3-main from the distribution - renamed to w3 - -* w3.el: Moved w3-upcase-region into w3-draw. -Now requires w3-style and all the new dipslay engine chunks. - -* w3-draw.el: -Now initializes the current stylesheet to the user stylesheet before -any drawing starts. - -* w3-vars.el: -Made w3-header-chars-assoc work with the new display engine (mostly), -and added a few more things to the state variables. - -* w3-style.el: -Can now do font scaling in style sheets. smarter about font.type. -Only thing left is font.family - - -* docomp.el: More var decls. - -* w3-wemac.el: Fixed w3-mouse-handler for windows - -* w3-draw.el: -Make all face storage variables buffer-local for style-sheet stuff. - -* w3-style.el: Now handles fonts/colors in style sheets - whooo hooo! - -Sat Mar 25 23:38:49 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Renamed w3-state-garbage-variable - -* w3-draw.el: -Now uses style sheets to find alignment and width for the various tags -before falling back on its defaults. - - -* w3-parse.el: -Fix for stupid people who don't use & instead of & in the middle -of a doc. - - -* w3-xemac.el: Added w3-center-spaces and w3-right-spaces for -centering/right-justifying pixmaps - -* w3-xemac.el, w3-sysdp.el: -A few new functions for the latest and greatest beta - -* w3-vars.el: Changed a few of the menu names - -* w3-style.el: Now actually parses and stores the style sheet information - -* w3-draw.el: Handle case where tag is a list - -Fri Mar 24 14:36:09 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Now uses device-type for XEmacs 19.12 - -Wed Mar 22 21:14:30 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed a few spacing problems - -* w3-e19.el: -Fixed w3-forward-link for links that were right up on top of each other. - -* w3-parse.el: -Fixed screwup with unterminated quoted chars in attribute/value pairs - - -* dist.Makefile: Removed w3-old - -* w3-draw.el: Fixed stupid typo when checking for faces. d'ohhhh! - -Mon Mar 20 23:23:34 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Fixed problem with w3-extend-zone and detached extents - -* w3-draw.el: <option selected> now works again - - -* w3-xemac.el: -Set the help-echo property when showing form elements if possible. - -* w3-vars.el, w3-beta.el, w3-draw.el: -Redid how state is kept - now uses a vector, which should be faster, -and is able to be buffer-local. - -* w3-parse.el: -w3-nuke-entities-in-region should no longer choke in odd circumstances -with just '&' in a document. - -* dist.Makefile: Removed w3-forms - it has been assimilated - -* dist.Makefile: Added a few new dependencies - - -* w3-draw.el: Added message when scaling fonts, just to keep the user informed - -* w3-wemac.el, w3-xemac.el, w3-e19.el: -When moving the mouse over a submit button in a form, shows where the -form will be submitted. - -* w3-draw.el: Fixed emacs-18 lossage in skip-chars-backward - -* w3-draw.el: Another fix to make sure <li><p> construct doesn't look like crap - -* w3-draw.el: -Split the handling of the refresh header out into its own function so -that it can be used from the drawing/parsing code for META commands - -Sun Mar 19 02:12:24 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: Fixed problem with window focus. - -* w3.el: Few fixes for passing to viewers - -* w3-parse.el: Set fill-column in w3-preparse-document - -Sat Mar 18 23:47:37 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: If parsing, do incremental display as well - -* w3-draw.el: Removed ugly hacks from w3-pause for emacs19 - just too ugly. - - -* dist.Makefile, docomp.el: -Take LISPDIR on the command line for hack-emacs-file - -* dist.Makefile: Removed EMACSTEMPLATE - -* dist.Makefile, docomp.el: hack-dot-emacs now takes a command line argument - -* w3-draw.el: links in tty mode won't show [[/{{ - -* w3-vars.el: All graphical entities now have textual alternativs - -* w3-draw.el: Added graphic entities back in. - -* w3-draw.el: Able to embed a few more types - -* w3-parse.el, w3-draw.el: Added the base functionality for the embed tag - -Fri Mar 17 15:44:16 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Removed some old targets, added new ones for new files - -* w3-style.el: Initial revision - - -* w3-parse.el: Special handling for the <style> argument. - -* w3-vars.el, w3-draw.el: Moved variables into w3-vars.el - -* w3-parse.el, w3-draw.el: Basis for the <style></style> notation done - -Thu Mar 16 19:44:12 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Fixed scaling of fonts, now handles cryptopt blocks for secure-http - - -* w3-draw.el: -Now no whitespace between link delimiters and the actual text of the link - - -* dist.Makefile: Added md5 target - -* w3-parse.el, w3-draw.el, w3-beta.el: -Now draws each signel item as it is parsed.. - -Wed Mar 15 23:27:55 1995 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed a problem in w3-pass-to-viewer - -* w3-draw.el: -Fixed problem with headers being hosed because of new way to do faces. - -* w3-draw.el, w3-xemac.el: Imagemaps work now - -Tue Mar 14 16:04:04 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: A few general performance increases - -Mon Mar 13 05:51:41 1995 William Perry <wmperry@indiana.edu> - -* w3-beta.el, w3-draw.el, w3-e19.el, w3-mac.el, w3-next.el, w3-old.el, w3-vars.el, w3-xemac.el: -Lots and lots of doc fixes to meet FSF/GNU guidelines. - -* w3-parse.el, w3.el, w3-e19.el, w3-draw.el: Few doc string fixes - - -* w3-vars.el, w3.el: -Now guess the value of w3-color-use-reducing based on values of -x-display-visual-class and x-display-planes. - -* w3-draw.el: -Fixed problem with indenting being lost in a list item after a sublist -terminates. - -* w3-draw.el: Redid some of the font stuff. - -Sun Mar 12 17:31:59 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: Some basic table-drawing support put in. - -* w3-tables.el: Initial revision - -* w3.txi: Use active voice in keybinding descriptions. - -Sat Mar 11 22:20:21 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: More state kept - ugh. - -* w3-forms.el: -Removed dependence on STREAM being defined - will make going totally asynch much easier - -* w3-vars.el, w3-parse.el, w3.el, w3-emacs.el: Removed 'backslashitis' - -* w3-e19.el: Removed a few unused variables - -* w3-draw.el: Optimized face stuff. - -* w3-beta.el: Removed 'backslashitis' - -* w3-vars.el, w3-e19.el: Change to the popup menu - -* w3-draw.el: Few fixes for blinking and wired text - -Fri Mar 10 23:18:30 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-xemac.el: Fixed images as linkx - - -* w3-draw.el: Fixed <br> in <dl> after a <dt> being indented too far - -* w3-draw.el: Fixed <br> in <ol> not being indented enough - -* w3-old.el: Now provides itself - -* w3-draw.el: New variable to turn off incremental display. - -* w3-draw.el: Does not display <certs> elements now. - -Thu Mar 9 20:35:12 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el, w3-epoch.el, w3-e19.el: -Don't make so many faces if using the new display engine - we don't -need any of the w3-xxxx-style ones. - -* w3-beta.el: -Nuke w3-delayed-images and w3-delayed-movies in w3-refresh-buffer, or -multiple images would get loaded! - -* w3-draw.el: Avoid calling w3-pause as often - speeds up redisplay a lot. - -* dist.Makefile: -No longer byte-compile w3-sysdp - was causing too many problems. - -* w3-beta.el: -No longer (goto-char (point-min)) in w3-show-buffer so that movement -done while drawing is still honored. - -* w3-draw.el: Added a save-excursion around the last handle-paragraph so that -movement done while drawing is still honored. - -* w3-xemac.el: -Use copy-tree when available for menu copying - much more reliable - -* w3-mac.el: Added a provide for w3-mac - -* w3-xemac.el: Fixed problem with extents becoming detached in 19.12 - -* w3-forms.el: Few forms fixes. - -* w3-beta.el: Added w3-install-latest from mernst@research.microsoft.com - -* w3-beta.el: Fixed MCOM->netscape stuff. - -* w3-forms.el: Fixed misplaced parentheses - -Mon Mar 6 23:29:59 1995 William Perry <wmperry@indiana.edu> - - -Sat Mar 4 15:33:08 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Now handles images like in the old display engine if not in XEmacs/Lucid - -* w3-e19.el: Only create air hotlist menu if w3-air-hotlists is non-nil - -Fri Mar 3 16:01:38 1995 William Perry <wmperry@indiana.edu> - - -Thu Mar 2 15:50:57 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Run w3-add-hotlist-menu first time a hotlist is loaded in. - -* w3-e19.el: Let w3-add-hotlist-menu run even if not in w3-mode - -Wed Mar 1 16:22:46 1995 William Perry <wmperry@indiana.edu> - -* w3-sysdp.el: Removed function call causing problems - -* w3-xemac.el: Don't load pictures if current frame is on a tty - -* w3-draw.el: Added back in a call to mule-attribute-zones - -* w3-parse.el: -Don't nuke the windows chars for quote and trademark when in MULE - -Sun Feb 26 19:17:38 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Removed message about 'unknown tag <%s> skipped' - was causing -confusion for some people. - - -* W3.ad: Initial revision - -Sat Feb 25 23:53:08 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed incremental display in emacs 18.xx - -* w3-draw.el: Fixed paragraph spacing problem. - -* dist.Makefile: Made beta display engine the default. - -* w3.el: Removed LCD archive entry, moved into w3.el - -* w3-wemac.el: Various fixes for new display engine into WinEmacs - -* w3-vars.el: Don't die if cannot load 'annotations' - -* w3-sysdp.el: -Removed anonymous lambda without 'function' wrapper for WinEmacs and -early versoins of lucid emacs. - -* w3-srch.el: Provide w3-srch - -* w3.el: Changed _W3 on dos machines to W3.INI -New function w3-force-reload-document to reload even if in standalone mode -Added a default for w3-complete-link -Provide w3-main - -* w3-draw.el: -Defvard w3-last-fill-pos and w3-last-tag to better facilitate drawing -in 2 buffers at once. -Fixes for messed up percentages in WinEmacs/XEmacs < 19.12 -Fixed <br> and <p> in blockquotes and align=indent - -Mon Feb 20 04:54:30 1995 William Perry <wmperry@indiana.edu> - -* w3.el, w3-vars.el: Removed w3-color-planes and w3-color-display variables. - -* w3-vars.el, w3.el: New variables w3-netscape-configuration-file and -w3-use-netscape-configuration-file, for whether to parse and honor the -options in a Netscape/X style configuration file. - -Sun Feb 19 22:27:00 1995 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: Don't change menubar if current-menubar is nil. - -* w3.el: Now shows whether you are using the beta version in the bug reports - - -* w3-draw.el, w3-parse.el, w3-print.el, w3.el: -Removed references to w3-working-buffer - -Sat Feb 18 19:51:53 1995 William Perry <wmperry@indiana.edu> - -* docomp.el: Reworked the autoloads/defvars - -* dist.Makefile: Removed w3-lemac.el - -* w3.el, w3-draw.el, w3-vars.el: -Removed variable w3-running-lemacs, since w3 now uses sysdep.el for -[XL]emacs, so there is no distinction between lemacs and xemacs - -* w3-e19.el: Fixed problem with unquoted lambda in w3-e19-options-menu - -* w3-xemac.el: -This version should theoretically work with lemacs and xemacs both - -* w3-draw.el: Fixed incremental display in xemacs. - -* w3-sysdp.el: Initial revision - -Thu Feb 16 15:58:44 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Changed messaging of viewer - would barf on undefined escape sequences -in crufty mailcap-related stuff. - -Sun Feb 12 23:09:40 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Better event handling while drawing HTML - -* w3-beta.el: Fixed personal annotations. - -* w3-draw.el: Removed proclaim-inline calls. - - -* w3.txi: Added docs for new 'label' and 'textalign' attributes of <hr> - -* w3-e19.el: -Fixed problem in emacs 19 with mouse-selecting a link would sometimes -say there was not a link, but selecting it with 'return' would work. -Now both work. - -* w3-parse.el: fixed problems with entity-resolution in attribute values. - -* w3-draw.el: -More spacing stuff, added 'label' and 'textalign' attributes to <hr> - -* w3-forms.el: Remove spaces at beginning of options. - -Sat Feb 11 22:10:46 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -Removed dependence on 'stream' from title handling. This will make it -easier to do totally streamed drawing, RSN. - -* w3-draw.el: Fixed more spacing problems. - -* w3-parse.el, w3-draw.el: -Fixed various spacing bugs - seem to be all gone now!!!! - -* w3-vars.el: New function to read a netscape-style configuration file. - -* w3-parse.el: w3-nuke-entities-in-region can now accept null args. - - -* w3-beta.el: New function to read a netscape-style configuration file. - -Fri Feb 10 06:19:26 1995 William Perry <wmperry@indiana.edu> - - -Tue Feb 7 15:51:23 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Removed the file-name-handler-alist, to put it in url.el where it belongs. - -* w3.el: -Finding the source of a url that is already in a buffer should work now. - -* w3-draw.el, w3-beta.el: -Now will always get a 'completed' message when drawing/imaging. - -Mon Feb 6 02:13:31 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fix for emacs 18 - -* w3-forms.el, w3-parse.el: -Optimized the calling of w3-nuke-entities-in-region. Parsing _much_ -faster, drawing only slightly slower, so its a win. - -* w3-draw.el: Semi-incremental display now works in all emacsen, and recognizes -scroll-up and C-c to interrupt. - -* w3-draw.el: Fixed plaintext handling. - -Sun Feb 5 23:41:28 1995 William Perry <wmperry@indiana.edu> - - -* w3-e19.el, w3-vars.el: Fixed view menu. - -* w3-vars.el, w3.el: -Let w3-color-filter be a string, for people brave enough to want to -set it themselves. - -* w3-epoch.el: Now works with new display engine. - -* w3-draw.el: Few problems for epoch fixed, <br> in <dl> looks right now. - -* w3-draw.el: Reimplemented w3-link-delimiter-info - -* w3-draw.el: Re-implemented the 'linkname value of w3-delimit-emphasis - - -* dist.Makefile: -Removed hack to change w3.texinfo on the fly when creating info file. - -Sat Feb 4 18:11:14 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Removed setting of default-directory because it causes call-process to -die a hideous death and not let you do anything like M-| lpr in the -source buffers. - - -* w3.el: Replaced w3-confirmation-func with url-confirmation-func - -Fri Feb 3 13:42:35 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: -fixed insertion of w3-link-end-delimiter - was always inserting the -'not visited' part.c - -Tue Jan 31 20:45:19 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Right-mouse-menu now works - -Mon Jan 30 04:52:26 1995 William Perry <wmperry@indiana.edu> - -* w3.txi: Added non-unix OS sections. Need to flesh them out more. - -Sun Jan 29 22:15:48 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Added w3-style-tags-assoc - -* w3-draw.el, w3-vars.el: -Added new variable w3-right-justify-address to control whether -text within an <address> tag is right justified. Defaults to t. - -* w3-vars.el: Few new variables for fsf19 - -* w3.el: Removed special cases for fsf19 to use the old lmenu package. - -* w3-e19.el: No longer needs the lmenu package. - -* w3-draw.el: Fixed typo - -* w3-epoch.el: Made all arguments to w3-make-face optional. - -* w3-draw.el: Few more fixes for epoch. No longer have to remove \n\n, so -incremental display looks better. w3-delimit-emphasis now works in -the new display engine. - - -* w3.txi: Lots of cleanup work, addition of netscape extensions, new HTML 3.0 -stuff, variable name changes, xresource changes, all for the new -display engine. - -Sat Jan 28 23:07:36 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Deal with url-get-url-at-point possibly returning nil. - -* w3-epoch.el: Got rid of error in new display engine. - -* w3-draw.el: w3-draw.el will now compile with emacs 18 again - the incremental -display was messing it up. - -* w3-beta.el, w3-draw.el, w3-e19.el, w3-emacs.el, w3-epoch.el, w3-forms.el, w3-lemac.el, w3-mac.el, w3-mule.el, w3-next.el, w3-old.el, w3-parse.el, w3-print.el, w3-srch.el, w3-vars.el, w3-wemac.el, w3-xemac.el, w3.el: -Added headers for finder package - -* w3-draw.el: Make sure w3-link-end-delimiter is never on a line by itself - -Thu Jan 26 04:56:42 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el: -moved w3-mule-retrieval-coding-system to url-mule-retrieval-coding-system - -Wed Jan 25 15:38:50 1995 William Perry <wmperry@indiana.edu> - -* w3-beta.el: -Added definition for (abs x) if none exists (for emacs 18, epoch, compat.) - -Mon Jan 23 03:32:40 1995 William Perry <wmperry@indiana.edu> - -* w3.txi: Removed w3-bad-server-alist - -Sun Jan 22 21:53:19 1995 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: Fixed space problems, hopefully for good. - -* w3-e19.el: New options item for relying solely on the cache - -Sat Jan 21 20:27:22 1995 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem where default-directory would sometimes be set to nil - -bad things man! - -* w3-beta.el: replaced all occurances of htmlplus with html - -* w3-draw.el: -Fixed problem with plaintext and embed. <lit> now acts like <pre>, -but with no mono-spaced font. Fixed problem with null titles (empty -string invalid for buffer name error). <blink> works on xemacs 19.12 -in tty mode. Small problem with <pre> segments with whitespace at -beginning fixed. A few small hacks to handle some pythia markup. - -* w3-e19.el: -Protect against copying menu-bar-help-menu if in tty mode. Also no -longer disable the edit menu when in w3-mode. - -* w3-parse.el: -Fixed problem with plaintext and embed. <lit> now acts like <pre>, -but with no mono-spaced font. - -* w3.el: replaced all occurances of htmlplus with html - -Wed Jan 18 02:31:59 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: -fixed bug in w3-nuke-entities-in-region if nonterminated entity was -last thing in a buffer (ie: <[EOB]); - -* w3.el: Remove duplicate links from links-alist when doing a completing-read -on the links. - -Tue Jan 17 13:18:13 1995 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Make install should now copy w3.elc to the dest. directory - -Mon Jan 16 03:52:57 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Better handling of faces. - -* w3.el: Implemented <input type=file> - -Sat Jan 14 22:40:58 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: More spacing taken care of - -* w3-draw.el: Few fixes to <pre></pre> presentation - -Thu Jan 12 15:39:37 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Fixed formatting problem with <dd> - -Mon Jan 9 23:20:05 1995 William Perry <wmperry@indiana.edu> - -* w3-print.el: Few fixes for ps-print 1.6 and 1.10 - -* w3-parse.el: Recognizes the <embed> tag and treats it like XMP for parsing. - - -Sun Jan 8 19:07:28 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-emacs.el, w3-parse.el: -Various changes to make the new display engine work under emacs 18.xx - -* docomp.el: more defvars for cleaner compile - -* w3-draw.el: Fixed more of the spacing problems - -* w3-e19.el: -Fixed some of the spacing problems when using w3-emacs19-hack-faces-p - -* w3.el: Added w3-follow-url-at-point-other-frame - -Sat Jan 7 20:29:06 1995 William Perry <wmperry@indiana.edu> - -* w3-parse.el: -Fix for odd problem where an entity at the very end of a line (or -flush against the next tag) would get left out of the parse structure. -Ugh! - -* w3.el: Added new variable url-inhibit-uncompression for use when dumping to -disk - very wasteful to uncompress it, store it in a buffer, then -recompress when it got written out to disk. Also changed the file: -and ftp: handling to use copy-file when w3-dump-to-disk is bound and -non-nil, so we can hopefully get asynchronous dumping-to-disk done. - -* w3-draw.el: More fixes for funky spacing - -* w3-old.el, w3-parse.el: -Remove \r's in <pre> and <xmp> segments, for ugly DOSisms. - -Fri Jan 6 18:31:07 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-parse.el: -Can now change the index of an ordered list item (<li value=xxx>0 - -* w3-print.el: -w3-print-with-ps-print now works with ps-print 1.6, and uses the headers, etc. - -* w3-draw.el, w3-e19.el: Fixed links menu in v19 -Few drawing fixes - -Thu Jan 5 20:50:06 1995 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Now does 'lazy' creation of faces... this reduces the memory -requirements when in X, since a lot of the faces will probably never -be used. - -* w3-parse.el: Fixed weird spacing problem after <font> tags finally. - -* w3.el: Make sure that facep is defined in all versions of emacs - -* w3-vars.el: -Changed the mail and print menus to be pull-right for xemacs/lemacs - -* w3-e19.el: -Fixed the links menu to gracefully do nothing if there are no links on -the page (was giving an 'Empty menu' error) - -Mon Jan 2 21:51:34 1995 William Perry <wmperry@indiana.edu> - -* w3-e19.el: changed default of the mouse-face for links - -* w3.el: Removed extraneous newline from mail headers - - -* w3-e19.el, w3.el: -w3-mail-current-document can now take an optional 'format' parameter -so that the mail menus can be pull-right. Spiffy, eh? Also now -sticks in content-type and content-transfer-encoding headers. - -* w3-print.el: -w3-print-this-url can now take an optional 'format' parameter so that -the print menus can be pull-right. Spiffy, eh? - -* w3-draw.el: Quicker way of right-justifying something. - -* w3.el, w3-beta.el, w3-print.el: -Moved all the printing code into w3-print.el, and added the postscript -option. Changed the makefile to concatenate all the appropriate files -for the beta or old version, sort of like VM. - - -* w3-draw.el: -Added <menu> and <dir> tags back in, as well as a few hacks to make -Jamie Z.'s page look prettier. :) - -* w3-beta.el: Fixed importing of netscape cache - -* w3-beta.el: Added w3-import-netscape-cache, to convert a netscape-style cache -directory to the emacs-w3 style. - -Sun Jan 1 09:59:25 1995 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Made w3-e19-links-menu buffer-local - -* w3-e19.el: Reinstituted the 'Links' submenu. - - -Sat Dec 31 07:13:21 1994 William Perry <wmperry@indiana.edu> - -* w3-parse.el: Various cleanups - -* w3.el: w3-mail-to-author now checks for the 'Reply-To' header of an HTTP/1.0 -response before checking the 'link' tags. - -Fri Dec 30 17:04:45 1994 William Perry <wmperry@indiana.edu> - -* w3-old.el: Removed use of w3-last to avoid having to use cl. - -* w3.el: Added checks to see if url-view-url returned nil instead of file:nil -Removed definition of w3-last - -* w3-draw.el: Fixed <secret> tag. - -Thu Dec 29 16:03:40 1994 William Perry <wmperry@indiana.edu> - -* w3-parse.el: -Added more stuff to get rid of windows-specific character references. - -* w3.el, w3-old.el: Moved defadvice stuff to w3-old - -* w3-e19.el: -Totally reworked the menus as emacs19 keymaps. This speeds them up. -Also added routines to add AIR Mosaic hotlists to the menus -automatically. Works well. First time through causes a bit of a -slowdown for lots of hotlists, but this is emacs' problem since it -needs to scan all the keymaps to create the menu. - -* w3-draw.el: -New variable w3-indent-level to control how many spaces to indent list -items, blockquotes, etc. This is necessary so that the user doesn't -have to change tab-width or tab-stop-list to change this formatting -(so <pre> segments that use tabs will still be formatted correctly). - -Also made </pre> close out all character-level formatting attributes -ala Arena. - -<pre> will also cause a paragraph break - chunks of text before a -<pre> segment weren't getting filled correctly. - -Made <dt> tags cause a paragraph break. Formatting now looks better, -and beginning of <dl> list is separated better from the rest of the -document. - -Fixed problem with w3-list-chars-assoc causing an error with the new -display engine. - -Fixed problem where > followed immediately by another tag wasn't -showing up in the new display. - -* w3-beta.el: Added parser for AIR Mosaic style hotlists. - -Tue Dec 27 21:24:37 1994 William Perry <wmperry@indiana.edu> - - -* w3-beta.el, w3-e19.el: -Added a dropdown history list that shows the last 5 homepages visited -under the 'Go' menu - -* w3.el: Changed the viewer handling so that temp files have a correct filename -extension (for broken things like Frame that won't read in a file -without the 'correct' file extension). - -Mon Dec 26 18:18:43 1994 William Perry <wmperry@indiana.edu> - - -* w3-beta.el: -(New display engine) Fixed bug in the new personal annotations code -that ws not closing the list. - -* w3-forms.el: -(New display engine) Fixed bug in <select> handling where it would -never find the correct name. Also put back in support for <select -multiple>. - - -* w3-vars.el: Added in all the rest of the entities - -* w3-vars.el: -Fixed problem where reloading of a page would set the 'Referer' field -of an HTTP/1.0 request to the url of the page being loaded. - - -* w3.el: Changed gopher searches and ask block submissions to use the enctyp -attribute like other types of searching. More extensible/easier to -maintain. - -* w3-draw.el, w3-beta.el: -Personal annotations now work in the new display engine. Visible -headers will work soon also. - -* w3-beta.el, w3-draw.el, w3-e19.el, w3-emacs.el, w3-epoch.el, w3-forms.el, w3-lemac.el, w3-mac.el, w3-mule.el, w3-next.el, w3-old.el, w3-parse.el, w3-srch.el, w3-vars.el, w3-wemac.el, w3-xemac.el, w3.el: -Updated copyright notices for 1995 - -Sun Dec 25 22:30:16 1994 William Perry <wmperry@indiana.edu> - -* dist.Makefile: -Renamed w3.el to w3-main.el and create w3.elc from w3-main.elc and -either w3-beta.elc or w3-old.elc - - -* w3-e19.el, w3-lemac.el, w3-wemac.el, w3-xemac.el, w3.el: More menu changes - -* w3-print.el: Initial revision - -* w3-beta.el: Changed w3-face-type to return 'both if a face is bold and italic - - -* w3-beta.el: Initial revision - -* w3-parse.el, w3-forms.el, w3-draw.el: -Added provide statements for easier loading - -* w3.el: Moved loads of old code into w3-old.el - -* dist.Makefile: Added new targets beta and old. - -* w3-old.el: Initial revision - -* w3-draw.el: Made new display engine honor the w3-list-chars-assoc header. - -* w3-vars.el: Moved some old vars out to w3-old.el - -Sat Dec 24 20:41:46 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Fixed w3-mouse-handler to work with the new display engine. - -Fri Dec 23 22:40:38 1994 William Perry <wmperry@indiana.edu> - -* w3-forms.el, w3.el: Added in handler for <input type=range size="min,max"> - - -* w3-draw.el: Added function comments. - -* w3-draw.el: -Rearranged the file a lot, and added support for the named BASE tags -from HTML 3.0 - pretty cool stuff. :) - -Thu Dec 22 23:53:59 1994 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: Various fixes to the parser to deal with bad html. Automatically -include the alt tag for an image if it is a link target, regardless of -the setting of w3-auto-image-alt. - -* w3-parse.el: Various fixes to the parser to deal with bad html - -Mon Dec 19 00:30:38 1994 William Perry <wmperry@indiana.edu> - - -* w3-e19.el: Added 'xterms' as a terminal type. - -* w3.el: Changed w3-submit-bug to only send truly useful info. - -Sun Dec 18 23:42:30 1994 William Perry <wmperry@indiana.edu> - -* docomp.el: Stifle more warnings in new xemacs - -* w3-vars.el, w3.el, w3-draw.el: -Changed the behavior of w3-auto-image-alt so that it could be a string -for 'format'. - -* docomp.el: Stifle more warnings - -* w3-parse.el, w3-draw.el: -Changed w3-handle-unknown-tag to check if 'w3-handle-<tag>' is -defined, and if so, to record that function as the handle for that -tag. This will cut down on maintenance of the top block of code that -just does a lot of (put 'w3-formatters 'xxxx 'w3-handle-xxxx). XMP -sections will now also work correctly. - -* w3-parse.el: -Now deals with comments properly, and can handle the old (broken) -comments of Mosaic/X - -Fri Dec 16 19:23:35 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: More fixes to w3-forward-link - -* w3-draw.el: Fixed a few things with faces - -Thu Dec 15 23:08:54 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Fixed w3-forward-link to work better with the new display engine. - -Wed Dec 14 17:55:30 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed a few problems with forms and the new display engine. - -* w3-xemac.el: Name changes (screen->frame) - -Tue Dec 13 17:56:45 1994 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Added a few optimizations for the <blink> tag. - -* w3-draw.el: Added in creation of 'underline' face if it is not defined. - -* w3-forms.el, w3.el: -Changed the maxlength to being unlimited if unspecified, to conform to -the new HTML 2.0 spec. - -* w3.el: Fixed bug in w3-document-informatino where it was relying on -url-current-mime-headers when it wasn't guaranteed to be the same. - -Mon Dec 12 23:22:21 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el, w3.el: Added function w3-document-information - -* w3-vars.el, w3-wemac.el, w3-xemac.el, w3-e19.el, w3-lemac.el: -Added new 'view' menu. - -* w3.txi: Removed hook for gnus-article-prepare-hook - was corrupting uuencoded -articles. - - -* w3-xemac.el, w3-lemac.el: -Fixed problem with image menus if graphic was a link - -* w3-epoch.el, w3-lemac.el, w3-xemac.el: -More stuff to deal with changed names, and crypt++/jka-compr - -* w3.el: Fixed big problem in reset buttons on forms. - -* w3.el: Now supports the 'action', 'src', and 'prompt' attributes on the -isindex element. (new display engine only) - -* w3-draw.el: Now supports the 'action', 'src', and 'prompt' attributes on the -isindex element. - -* w3-vars.el: Changed lots of the version variables so that they don't rely on -having the RCS headers in them. - -* w3.el: Changed w3-mode so that if it is called interactively it will act like -w3-preview-this-buffer. - -* w3.el: Changed w3-source-document so that it can reuse source buffers if the -users wants to. - -Sun Dec 11 08:41:52 1994 William Perry <wmperry@indiana.edu> - - -* w3-draw.el: -Added in code to scale fonts for <h[1-6]> so they are bigger, etc, if in XEmacs/Lemacs - -* w3.el: Few changes for asynch mode. - - -Sat Dec 10 01:07:05 1994 William Perry <wmperry@indiana.edu> - -* w3-xemac.el: -Added some stuff to optimize the echoing of the URL in the minibuffer -(not so many calls to mode-motion-hook, all done in the mouse-handler -by using the 'help-echo property). Is smart enough to notice if -'help-echo is not defined and still use the old way if necessary. -Also changed the image code so that it sets the 'detachable property -so that images won't get nuked if the text they are attached to is -deleted. - -Fri Dec 9 22:34:04 1994 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Few tweaks - -* w3-forms.el: -Fixed problem with other markup (especially other form info) within a <select>. - -* w3-parse.el: Added status messages to parsing. - -* docomp.el: More vars to get rid of warnings. - -Thu Dec 8 21:16:09 1994 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Added in lots of the 'top ten' html tags. :) - -* w3-draw.el: Added <blink> stuff, and rewrote the init-state function. - -* w3-vars.el: Added w3-do-blinking to control whether <blink> </blink> works - -* w3-draw.el: Handle pinhead - -Wed Dec 7 15:47:47 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixes to wais stuff - -* w3-draw.el: Added indenting for blockquote tags. - -* w3-epoch.el, w3-wemac.el, w3-lemac.el, w3-xemac.el, w3-emacs.el, w3-e19.el: -Let w3-back-link and w3-forward-link accept negative arguments and -call each other if they get one. - -Tue Dec 6 22:16:34 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed typo in docs. - -* w3.el: -Fixed w3-source-document so it will issue an error if done in a non-w3 buffer. - -* w3-vars.el: Fixed typo in docs. - -* w3.el: Patch from Michael Erns (mernst@research.microsoft.com) to make -w3-complete-link act like w3-follow-link when no menu item is -specified. That makes it act more like Info mode, and so is more -intuitive to users used to it. - -* w3.el: Now set default-directory when sourcing a document - -* w3-forms.el: Added error checking to the <textarea> handling to deal with -non-terminated textareas. - -* w3-forms.el: -Added error checking to all the forms code to make sure you are within -a <form> before doing anything. - -* w3-draw.el: Added support for the 'fig tag. - -* w3-draw.el: Changed how the <title> tag is handled. - - -* w3-draw.el: Added SPRY align tag. - -* w3-forms.el: Trimmed lots of crap that is duplicated from w3.el - -* w3-draw.el: -<pre> and <xmp> segments within a list item will now be indented correctly. - -* w3-draw.el: Fixed list filling after headers and br's - -* w3-draw.el: Few changes to the <hr> handling - -* w3.el, w3-draw.el: -New variable w3-auto-image-alt that controls whether emacs-w3 will -automatically generate the 'alt' text on an image where it was not -specified. - - -Mon Dec 5 23:54:51 1994 William Perry <wmperry@indiana.edu> - - -* w3-draw.el, w3-e19.el, w3-parse.el: -Misc Changes to get around idiotic font tag - - -* w3-draw.el: Center tag will now override header/paragraph stuff. - -* w3-draw.el: More image work. - -* w3-parse.el: Fixed problem if a tag was flush against a newline. - -* w3-vars.el: Added jpegs as a default inlined image type. - -* w3-xemac.el, w3-lemac.el: fixed problem with new parser and xemacs/lemacs - -* w3-parse.el: Fixed problem with entities. - -* w3-e19.el, w3-srch.el: more name changes - -* w3.el: Fixed problem if w3-default-homepage was nil. - -* w3-draw.el: <link> tags now work correctly. - -Sat Dec 3 23:05:24 1994 William Perry <wmperry@indiana.edu> - -* w3-parse.el: Problem with entities lt and gt fixed a little. - -* w3.el: More naming changes. - -* w3-draw.el: <select> and <option> tags now work correctly. - -* w3-emacs.el: Added a few checks in for the amiga 18.5x emacs. - -* w3-forms.el: <select> and <option> tags now work correctly. - -* w3-draw.el: Added support for the 'note' tag. - -Fri Dec 2 18:05:31 1994 William Perry <wmperry@indiana.edu> - -* w3.el: -Fixed bug in w3-view-this-url that would message 'nil' in the minibuffer. - -* w3-draw.el: Now remembers "id" and "name" attributes on any tag. - -* w3-draw.el: Various fixes to painting. - -* w3-draw.el, w3-epoch.el, w3-forms.el, w3-parse.el, w3-srch.el: -More name changes, handling or PRE/XMP - -* w3.el: Fixed problem in w3-fetch if url-request-method was nil. - -* w3-draw.el: Now correctly handles pre,/pre,xmp,and /xmp - -Thu Dec 1 17:21:34 1994 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Added new tags - -Wed Nov 30 18:48:41 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Added vt300 to the hack-faces stuff. - -Mon Nov 28 17:11:38 1994 William Perry <wmperry@indiana.edu> - -* w3-epoch.el, w3-lemac.el: More misc. name changes - -Wed Nov 23 21:12:59 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem when posting to a form, w3-reuse-buffers would reuse the -'source' of the form. Ugh. - -Tue Nov 22 15:37:02 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem in 'isindex' forms processing. - -Sun Nov 20 04:44:42 1994 William Perry <wmperry@indiana.edu> - -* w3-draw.el, w3-forms.el, w3-mule.el, w3-vars.el, w3-xemac.el, w3.el: -Lots of name changes from w3-* to use the native url-* functions - -Fri Nov 18 22:46:59 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Added binding of Shift-tab for w3-back-link - -Thu Nov 17 20:52:03 1994 William Perry <wmperry@indiana.edu> - -* w3-mule.el: Fixes for mule 2.1 from Shin-ya Sato <sato@sphere.csl.ntt.jp> - -Mon Nov 14 17:02:29 1994 William Perry <wmperry@indiana.edu> - -* w3-new.el: Initial revision - -Tue Nov 8 17:57:57 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed handling of base tag - -Mon Nov 7 22:09:35 1994 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Correctly reset the state when going into w3-draw-html - -* w3-parse.el: Misc. fixes - -Sun Nov 6 07:19:52 1994 William Perry <wmperry@indiana.edu> - -* w3-draw.el: Relative links work correctly now - -* w3-draw.el, w3-forms.el, w3-parse.el: Initial revision - -Fri Nov 4 22:43:44 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Support for STYLE attribute on ordered lists. Supports i, I, a, A. -Also still supports the HTML+ 'ROMAN' attribute. Supports the VALUE -attribute on the LI tag to change the value of a list item and all -following items. - -* w3.el: Changed the advice for w3-*-link to use deactivate-mark if it is -bound. This gets rid of the problem of w3-*-link highlighting the -region if in emacs-19 and in transient-mark-mode. - -Thu Nov 3 23:50:47 1994 William Perry <wmperry@indiana.edu> - -* w3-epoch.el, w3-lemac.el, w3-xemac.el: -Only send Accept: lines for the inlined images we accept when -transferring an image - -Wed Nov 2 00:47:38 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Let the variable shell-file-name take precedence over environment -variables and guessing - -* w3-e19.el, w3-vars.el: -Added w3-echo-link to control what is displayed in the minibuffer in -emacs-19. 'url, 'text, or nil. - -* w3.el: Added encoding type of application/ramp to forms - -Tue Nov 1 18:36:08 1994 William Perry <wmperry@indiana.edu> - - -* w3-vars.el: Removed definition of w3-using-proxy - -* w3.el: -Fixed w3-find-this-file to work correctly for users other than anonymous - -* w3.el: Fixed problem where sentences ending with ! or ? had the ! or ? eaten. - -* w3.el: Added check for checkboxes/radio boxes that are turned off. - -Mon Oct 31 23:16:04 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed a stupid bug in the ....-other-frame - -* w3-e19.el: Changed binding from [shift mouse-2] to [S-mouse-2] -ugh - -* w3.el: Added functions w3-follow-link-other-frame and w3-fetch-other-frame - -* w3-lemac.el, w3-xemac.el, w3-e19.el: -Added shift-middle-button default binding to be follow-link in other frame. - -Fri Oct 28 22:42:10 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Can now pass parameters to url-current-callback-func - -Thu Oct 27 19:14:08 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Strip spaces off of the title after truncating it to 50 characters. - -Wed Oct 26 15:41:14 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: A few changes to how the entities are interpreted - -* w3.el: Now correctly strips off spaces from the front of a URL -when in w3-fetch - -Tue Oct 25 17:28:43 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed <option value=xxx> handling for multiple selection lists. - -* w3.el: Fixed handling of the SIZE attribute of a SELECT tag. Select MULTIPLE -will now also allow different OPTION tags to have the SELECTED -attribute. Changed w3-insert-entities-in-string to use -w3-html-entities, so it gets all the entities, not just the 6 or 7 -that were hardcoded in. - -Wed Oct 12 16:22:05 1994 William Perry <wmperry@indiana.edu> - - -Tue Oct 11 23:11:34 1994 William Perry <wmperry@indiana.edu> - -* w3.el: More spacing at end of sentences hacks for ? and ! - -* w3-vars.el: No longer rebind C-k - bad thing. - -* w3.el: Don't double-space after Prof. - -Tue Oct 4 01:17:33 1994 William Perry <wmperry@indiana.edu> - - -* w3.el, w3-vars.el: -Changed w3-reuse-buffers to accept 'yes/no 'reuse/reload and 'always/never - -Mon Oct 3 14:04:15 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el, w3.el: -Patch for the inlined image processing for the buggy current release -of ppmdither and viewing black and white gifs. Also added comments to all -the html entities in w3-html-entities. - -Fri Sep 30 21:28:54 1994 William Perry <wmperry@indiana.edu> - -* w3.el: -Fixed problem with paragraph just after an <hr> not being filled correctly. - -* w3-vars.el: Added more HTML entities - -Thu Sep 29 20:13:53 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Removed problem with first header having a blank line in it. - -* w3-e19.el, w3-emacs.el, w3-mule.el, w3-vars.el, w3.el: -Lots of patches from Shin-ya Sato <sato@sphere.csl.ntt.jp> to make -w3 work with mule 2.0 - -Tue Sep 27 23:58:36 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Now sends the NAME and VALUE of submit buttons if the submit button -has a NAME. - - -Mon Sep 26 18:51:52 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Change to w3-form-encode-multipart/x-www-form-data to include the -content-length of each item - -Fri Sep 23 16:14:50 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem in w3-backward-in-history when no back link was found. - -* w3-vars.el: -Fixed setting of w3-running-FSF19 to take into account XEmacs 19.12 - -Thu Sep 22 23:24:48 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: Fixed problem in w3-insert-graphic where it would always do a -url-file-attributes, even if we had the image loaded. (with -url-be-anal-about-file-attributes == t, it would do a HEAD, which was -stupid) - -* w3.el: Fixed forms doubling problem in FSF emacs 19 when doing a reset. - -* w3-vars.el, w3.el: -New variable w3-track-last-buffer. If non-nil, M-x w3 will take you -to the last w3 buffer you fetched, instead of loading your home page. -If the last buffer has been killed, then it acts normally and loads -the home page. - -* w3.el: Changed w3-submit-bug - - -* w3.el: patch from mernst@research.microsoft.com to fix reporter problems in -emacs 19.xx - -Wed Sep 21 17:25:16 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed small bug in DL handling when no <dt> items present - - -* w3.el: Fixed problem in w3-pass-to-viewer if "/" is the filename, would get -"" as the buffer-name, which would choke. - -* w3.el: -Fixed bug in w3-delimit-emphasis w/headers that had spaces/newlines in them - -Tue Sep 20 18:04:03 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: -Fixed handling of blockquote's so they have a <p> at the beginning and end. - - -Sun Sep 18 20:15:42 1994 William Perry <wmperry@indiana.edu> - -* w3.txi: Few minor changes - -* w3.el: Changed w3-upcase-region so that it will take care of entities in the -region. ie: ä -> Ä, etc. - -* w3-e19.el: -Fixed problem where the URL was not shown in the minibuffer if you hit -'f' from a point in the document that was not a link. - -Fri Sep 16 17:18:03 1994 William Perry <wmperry@indiana.edu> - -* w3-mac.el, w3.el: Lots of little fixes - -* w3-vars.el: Removed the old, redundant w3-gateway-x variables - -* w3-hypb.el: Removed all the code, since Hyperbole 3.12 handles it for you. - -Thu Sep 8 15:54:36 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem where the o/*/etc at the front of <dt> items would be -upper-cased sometimes - -* w3.el: Started using reporter.el instead of rolling my own error logging -routines. - -* w3-e19.el: w3-emacs19-unhack-faces now turns w3-delimit-emphasis and -w3-delimit-links on. - -* w3-e19.el: -w3-forward-link and w3-backward-link now ignore links without href's - -* w3.el: w3-complete-link now ignores links without href's - -* w3-vars.el, w3.el: -Added new variable w3-source-file-hooks that is run after sourcing a document. - -* w3.el: Fixed problem with not quoting an align attribute when filling in -defaults in w3-fix-paragraphs-in-region - -* w3.el: Fixed formatting problem with <dl>s finally - -Wed Sep 7 23:22:21 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Patch for not putting 2 spaces after Mr/Ms/Mrs. - -* w3-e19.el, w3.el: -Lots of fixes brought about by Axel Boldt <axel@uni-paderborn.de> - - -* w3.el: Fixed problem in w3-finish-text-entry when deleting the sole window - -* w3-e19.el, w3-lemac.el, w3-wemac.el, w3-xemac.el, w3.el: -Fix from mernst@research.microsoft.com for converting newlines in -menu entries/completions on links to spaces. - - -* w3.el: Fixed dl attribute munging in w3-fixup-bad-html - -* w3-e19.el, w3-mule.el, w3.el: Misc. changes for Mule 2.0 - -Tue Sep 6 21:07:16 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el, w3-emacs.el, w3-epoch.el, w3-lemac.el, w3-xemac.el: -Got rid of code to not interfere with hyperboles mouse-bindings, since -it has changed to only use shift-clicks - -Sat Sep 3 21:50:09 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem where if url-be-asynchronous was non-nil, -w3-show-history and w3-show-hotlist would fail. - -Fri Sep 2 18:42:25 1994 William Perry <wmperry@indiana.edu> - -* w3.el: url-buffer-visiting now strips off the #xxx links. -If reusing a buffer, the #xxx works will now work also. - -* w3-vars.el: Used real symbol for (TM) (™) - -Sun Aug 28 22:41:15 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem with <dl> lists when there were no <dt> items. - -* w3.el: Fixed bug where hotlist urls were getting hexified too often - - -Thu Aug 25 17:15:52 1994 William Perry <wmperry@indiana.edu> - -* w3.txi: Few fixes to @cindex areas - -Tue Aug 23 12:30:18 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Added code to automatically call w3-update-hotlist-menu after all -hotlist modification functions - -Mon Aug 22 02:30:51 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem with the new w3-fix-unknown-tags - -Sun Aug 21 23:34:49 1994 William Perry <wmperry@indiana.edu> - -* w3.el: The isindex tag can now have an action=xxx specifier. Works the same -as link rel=index - -* w3.el: Don't include the [[ and ]] in w3-complete-link - - -* w3-vars.el, w3.el: -Added a 'debug' mode. If w3-debug-html is non-nil, then display -all semi-buggy html with error messages in a separate buffer -that is displayed at the end of the parse. - -* w3-lemac.el, w3-vars.el, w3-wemac.el, w3.el: -Added w3-xemac.el for the upcoming XEmacs 19.12 release - -* w3-xemac.el: Initial revision - -* dist.Makefile: Added w3-xemac.el - - -* w3-vars.el: Changed how w3-version-number is created. - -* w3.txi: Added section on inlined images/mpegs - -* w3.el: w3-goto-last-buffer now works if w3-be-asynchronous == t - -* w3.el, w3-e19.el: -Fixed emacs-19 forms problem - overlays would run together and mess up -form entry. Also fixed problem in the highlighting of links. - -Sat Aug 20 22:21:06 1994 William Perry <wmperry@indiana.edu> - - -* w3.txi, w3.el: Lots of changes suggested by Axel Boldt. - -* w3-e19.el: w3-forward-link and w3-back-link will show the link under point - -Thu Aug 18 12:56:43 1994 William Perry <wmperry@indiana.edu> - - -* w3-e19.el, w3-mac.el, w3.el: removed need for w3-quotify-percent hack - -Mon Aug 15 03:57:29 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed multipart viewer - -Sun Aug 14 22:50:31 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Made w3-popup-info interactive - -* w3-hypb.el: More error checking in hwww:start. - -* w3-vars.el: Added view source to the hyperlink-menu - -* w3-wemac.el, w3.el: More fixes to work under DOS/Windows - - -* w3.el: Fixed x-www-form-urlencoded encoding. Was stripping off the first -character sometimes when it shouldn't have been. - -* w3-vars.el: Removed bogus definition of w3-directory-format - -* w3-lemac.el, w3-e19.el: -Fixed w3-mouse-handler so it doesn't need to muck with the % signs anymore. - -* w3-lemac.el, w3-e19.el: New links menu constructor - -* w3.el: Default URL for w3-fetch is now smarter. - -* w3.el: Fixed w3-complete-link so that it will not show extraneous markup in -the completing-read - -* w3-srch.el, w3-lemac.el, w3-wemac.el, w3-epoch.el, w3-emacs.el, w3-e19.el: -New w3-map-links - now passes the start and end positions to the -appropriate function - - -* w3.el: Forms fix for MAXSIZE, message when storing into the kill ring so the -user has some sort of feedback, <P ID=xxx> works now. - -* w3-vars.el: New hotlist key bindings. - -Fri Aug 12 13:26:02 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: Removed the * .5 so w3-lemac.el can compile under emacs 18 - -* w3.el: Few fixes for using under windows. - -* w3.el: Fixed problem with directory-files with no <title> causing -rename-buffer to fail. - -Thu Aug 11 13:56:35 1994 William Perry <wmperry@indiana.edu> - -* w3.txi: Changes to the VM/Rmail nodes. - -* w3.el: Fixed dumbass problem in both types of forms submission that would -always submit every checkbox and every radio button, regardless of its -checked state. - -Wed Aug 10 13:51:18 1994 William Perry <wmperry@indiana.edu> - - -Tue Aug 9 03:39:45 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem with cleaning up of w3-temporary-directory and -url-temporary-directory - -* w3-e19.el: Fixed a few problems with the loading of lmenu. - -Mon Aug 8 12:59:14 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Made binding of track-mouse buffer-local - -Sat Aug 6 16:32:18 1994 William Perry <wmperry@indiana.edu> - - -* dist.Makefile: -Removed viewers.el from the dist, since it has been moved into mm.el - -* w3-wemac.el, w3-lemac.el: -New url-flush-cache function to remove all entries from the cache. -Menu item in lemacs/wemacs for it. - -* w3.el: Fixed problem if </title> is malformed/nonexistent. - -* w3.el: Fixed problem with some </pre> markup sometimes leaving a trailing > -in the parsed code. - -* w3.el: Fixed problem with mac web pages that use ^M instead of ^J as the -newline char. - -Wed Aug 3 04:15:06 1994 William Perry <wmperry@indiana.edu> - - -* w3-vars.el, w3.el: Moved setting of w3-documents-menu-file, -w3-personal-annotation-directory, and w3-hotlist-file into -w3-do-setup, since they used expand-file-name and ~/, it would mess up -if you dumped w3 with emacs. - -* w3-wemac.el: -Do correct setting of the %#!@ed up .mosaic-xxx-xxx filenames when in windows. - -* w3-wemac.el: -Fix the setting of the mailcap/mime-types file list so that it won't -choke on invalid filenames in windows. Also do smart-checking of the -TEMP environment variable if w3-temporary-directory or -url-temporary-directory doesn't exist. - -* w3-lemac.el, w3.el: -Fixed a problem in w3-kill-emacs-func when w3-temporary-directory -didn't exist. Also moved some stuff from w3-do-setup to -w3-setup-version-specifics (mostly lemacs image stuff, etc) - -* w3.el: Load w3-wemac if running WinEmacs - -* w3.el: Highlighting of links is back... - -* w3-wemac.el: Initial revision - -Mon Aug 1 13:32:35 1994 William Perry <wmperry@indiana.edu> - -* dist.Makefile: -Removed sample-mailcap from distribution - everything is defaulted in -lisp now. - - -Sun Jul 31 23:53:36 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Accept --!> as the ending of an SGML comment. UGH! - - -* w3.el: Now sends off the value parameter of an <option> tag in a form. - - -* w3.el: Use error in w3-save-url if there is no URL. Moved loading of ~/.w3 -higher in w3-do-setup. - -* w3.txi: Fixed lots of grammatical mistakes, all stuff now uses the present -tense instead of "will", and no more first-person crap. Email -addresses are handled in a standard way. - -* w3.el: Added support for the multipart/x-www-form-data enctype. Also -revamped forms support to be easily expandable for the enctype -attribute. Just need to have a function named -w3-form-encode-<content-type> defined. If this returns a cons pair, -then the car is used as the "separator=xxx" chunk in the content-type, -and the cdr is the body of the request. If it returns a string, it -just sends that as the body of the message. - - -* w3.el, w3-vars.el: Rewrote the popup-info functions - - -Sat Jul 30 22:55:31 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Will no highlight the region that matches the ID of a #XXX search in a document - - -Fri Jul 29 04:33:03 1994 William Perry <wmperry@indiana.edu> - -* w3.txi: Few typos - -* w3.el, w3.txi: -Misc. patches from mernst@research.microsoft.com - doc/info fixes - -Thu Jul 28 13:52:49 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Rewrote DL handling - -Tue Jul 26 13:39:24 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed dumb mistake in w3-personal-annotation-finish where I didn't -insert the actual text of the annotation before finishing up. - -Mon Jul 25 14:04:09 1994 William Perry <wmperry@indiana.edu> - -* add-to-dot-emacs: Added a few new autoloads - - -* w3.txi: Fixed a few typos. - -* w3.el: Fixed problem with the rel=useindex support. - -* w3.el: Fixed small formatting problem with w3-delimit-links = 'linkname - -Sun Jul 24 20:19:18 1994 William Perry <wmperry@indiana.edu> - - -* w3-lemac.el: -Several ugly hacks to get the image menus to work for images that -downloaded successfully. - -* w3-lemac.el: New link and graphic specific menus enabled. - -* w3-vars.el: The popup menu has been trimmed down. - - -* w3.el: A few changes for the new hyperlink-specific menus - -* w3-e19.el: Rewrote w3-forward-link - should not get stuck on links anymore - -* w3-e19.el: Implemented popup-menus on a linktype basis. Can change the popup -menu that shows up when you right-click on a hyperlink or an image. -Default menus include viewing headers, dumping to disk, mailing, -printing, and copying the url. - -* w3-vars.el, w3.el: -New personal annotation entry code. Uses a minor mode, and you can -specify what major mode is used. Set the variable w3-annotation-mode -to the name of the major mode. If set to nil, it will use -default-major-mode. - -* w3-e19.el, w3-emacs.el, w3-epoch.el, w3-hypb.el, w3-lemac.el, w3-mac.el, w3-mule.el, w3-next.el, w3-vars.el, w3.el: -Changed all references to wmperry@indiana.edu to use w3-bug-address -instead. Changed all copyright notices to use my new email address -also. - - -* w3.txi: -Lots of changes to variable names, some new sections. Should be about -90% up-to-date now. - - -* w3-vars.el: Removed definition of w3-passwd-entry-func - obsolete. - - -* w3.el: Moved running of w3-mode-hooks to be after the resetting of -w3-persistent-variables. - - -* w3.el: Added in support for using <link rel=useindex href=xxx> for searching -instead of the <ISINDEX> tag. <ISINDEX> is still supported. - -Sat Jul 23 21:26:57 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Rewrote the options menu - -* w3-e19.el: Removed image options from emacs 19 menubar - - -* w3.el: Fixed problem with nested style tags. - -* w3-lemac.el: Fixed problem with images not appearing - -* w3.el: Fixed problem with first lines not being wrapped if no -header/paragraph tags before them in the document. Also added support -for broken base tags - seems like some people are using <base=url> -instead of <base href=url> - - -* w3.el: PRE segments now get correctly put in the w3-tt-style face. - -Fri Jul 22 03:59:40 1994 William Perry <wmperry@indiana.edu> - - -Thu Jul 21 04:46:03 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Changed behavior of w3-show-headers. If 't', then show all headers. -Fixed bug in w3-in-assoc if there was a blank entry in the alist. - -* w3.el: Patch from mernst@research.microsoft.com for not putting nil in the -kill ring with w3-save-url. - -Sun Jul 17 17:17:19 1994 William Perry <wmperry@indiana.edu> - - -* w3-vars.el: New variable w3-dump-to-disk that will automatically download -retrieved files to disk. - -* w3-lemac.el: Added 'dump to disk' item in options->www menu - -* w3-lemac.el: Added option for color filtering to the options->www menu - -* w3-lemac.el: Only read in the url-file-attributes of an image if -w3-image-size-restriction is non-nil and a number. - -Sat Jul 16 18:55:24 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: With prefix-arg, w3-fetch will default to the URL of link under point -if any, otherwise default to current documents url if in w3-mode, -otherwise default to url-get-url-at-point - -* w3.el: With prefix-arg, w3-follow-link will dump the file straight to disk - -Fri Jul 15 14:42:39 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Automatically switch to using giftoppm if giftopnm is not found on the -system. - - -Tue Jul 12 04:38:47 1994 William Perry <wmperry@indiana.edu> - - -Mon Jul 11 05:28:40 1994 William Perry <wmperry@indiana.edu> - -* w3.el: w3-version now returns all the version #s of URL, WWW, and MM - - -Sun Jul 10 19:14:06 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Only use w3-default-style in epoch - - -* w3.el, w3-vars.el: w3-show-headers now takes regexps instead of exact matches - -Fri Jul 8 01:49:25 1994 William Perry <wmperry@indiana.edu> - - -Wed Jul 6 13:56:47 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Patches to make the history work again, as well as keep w3 -from trying to re-select deleted buffers - -Tue Jul 5 07:38:00 1994 William Perry <wmperry@indiana.edu> - -* w3.el: No longer delete the zone when making an ALT tag hot, since there -could have been other text in the link - -* w3.el: -If an IMG is within a <A> tag, then the alt tag will be a hyperlink also. - -* w3.el: Fixed finding of url#xxx links from w3-fetch - -Mon Jul 4 23:48:07 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Forms submissions can now have ? embedded in them, for recursive -creation of subsequent forms. - - -* w3.el: Fixed formatting problems with nested lists, etc. - -* w3-vars.el: Removed C-q binding - -* w3-e19.el: Automatically turn on track-mouse if w3-track-mouse is non-nil. - -* w3.el: Various patches from Alastair Burt - -* w3-lemac.el: Create w3-superscript-style correctly - -Sun Jul 3 05:05:43 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed a problem with fetching of #xxx links. - -* w3.el: Applied patch from Darrell Kindred <dkindred+@CMU.EDU> that -fixed quite a few problems in the news handling. Should be -a lot faster now. - -* w3.txi: Fixed a few problems in the VM, RMAIL, and GNUS sections - -Sat Jul 2 18:31:50 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Removed bogus entry in w3-persistent-variables - -* w3.el: Fixed storing of w3-current-last-buffer and w3-goto-last-buffer - -Thu Jun 30 23:39:02 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: -Changed definition of w3-running-lemacs to take WinEmacs into account. - -* w3-lemac.el: -Changed references to string-to-number to string-to-int for older -lemacs versions - -Wed Jun 29 05:24:53 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el, w3-e19.el: -Added an option for local cacheing of files to the Options menu - -Mon Jun 27 15:03:12 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Added check for whether menu-bar-help-menu was bound before defining -keys in it - -Tue Jun 14 12:25:09 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Fixed problem with the menu - -Mon Jun 13 14:13:56 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Made sure everywhere w3 does a completing-read binds -completion-ignore-case to t - -* w3.el: Few fixes from using url-maybe-relative - -Thu Jun 9 12:51:03 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Activated the Help menu in FSF v19 again. - -Wed Jun 8 01:20:36 1994 William Perry <wmperry@indiana.edu> - - -Tue Jun 7 20:08:20 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem with empty titles. - -* w3-lemac.el: -Fixed references to w3-use-hypertext-gopher and w3-directory-format variables - -* w3.el: Hacked up w3-submit-bug to be able to use mh-smail - - -* w3.el: Changed the color-reducing process to be optional - -Mon Jun 6 19:56:46 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: More HTML+ latin1 entities - -Sun May 29 02:26:30 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: More HTML+ entities - -Sat May 28 14:14:19 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: -Fixed problem with w3-back-link. Could not go back to the only link -in a buffer if you were past its endpoint - -* w3.el: w3-preview-buffer should work again, along with -w3-show-hotlist/history-list, etc. - -* w3-vars.el: Yet more HTML+ entities. Only 22 left to figure out. - -* w3-vars.el: Added more of the HTML+ entities - -Fri May 27 19:54:49 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed a problem with PRE fixing - -Sat May 21 10:23:16 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed the URL completion - -* w3.el: Fixed a problem with the <embed> tag and the url package - - -* w3-e19.el, w3-emacs.el, w3-epoch.el, w3-lemac.el, w3-mac.el, w3-mule.el, w3-srch.el, w3-vars.el, w3.el: -Lots and lots of changes to use the new url.el package - -Fri May 20 16:20:59 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: Fixed problem where graphic entities were disappearing - -Thu May 19 12:18:41 1994 William Perry <wmperry@indiana.edu> - -* w3.txi: Fixed a few bad pointers - -* add-to-dot-emacs: Initial revision - - -* w3-lemac.el: -Moved back in the old code for w3-insert, w3-fix-extent-endpoints to -get around bug in lucid emacs 19.10 with 'start-open and 'end-open -extent properties. - -Wed May 18 20:30:24 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Now can have a max # of password entry attempts before bombing out and -displaying the error message from the server. w3-max-password-attempts - - -* w3.el: Fixed problem in w3-mail-document-under-point - - -* dist.Makefile: The great name change to 8.3 compatible - - -* w3.el: Fixed problem in file/ftp handling if there was no file in the url -(ftp://host.domain), etc. - -* w3-e19.el: Provide w3-e19 - -* w3.txi: Added chapter/example for interfacing with RMAIL - -* w3-lemac.el: -Added definition of emacs-major-version and emacs-minor-version if -they aren't already defined. Use this to merge w3-lemacs.el and -w3-old-lemacs.el - -* w3-vars.el: Removed references to w3-running-old-lemacs - - -Tue May 17 23:30:23 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Honor the new nametemplate mailcap clause - -* w3-e19.el, w3-lemac.el, w3-vars.el, w3.el: -Removed the annotations menu. moved to one entry in the main WWW menu -Cleaned up some of the annotation code. - -* w3-e19.el: -Only allow use of overlays in emacs19, due to some bugfixes in 19.23 - -* w3-lemac.el: Disabled graphics in lemacs 19.9, since I switched to using -annotations, and they don't exist in 19.9 - -Mon May 16 20:49:09 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem with an old mm-mime-viewer call that didn't get fixed, -and a work around for the autoloading of ange-ftp in emacs19 - -* w3.el: Change to w3-grok-file-href to check for whether a file exists, even -if a // is in the string (for something like file://usr/local/ blah -blah blah. Thanks to David Hughes for the patch. - -* w3.el: Removed group annotation code. -Sped up the removal of whitespace by using subst-char-in-region -instead of replace-regexp . - -* w3-lemac.el: -Changed the options menu -> delay by image type to be actual toggle items. - - -* w3.el: Removed klunky caching strategy. -w3-current-mime-viewer now holds the complete information returned by -mm-mime-info. -The viewer code now only shows the output of commands if it gets any. -No more prompting or setting of w3-always-show-output is necessary. - -* w3-vars.el: Removed obsolete w3-always-show-output - -Sun May 15 19:23:57 1994 William Perry <wmperry@indiana.edu> - -* dist.Makefile: Now distribute mm.el - - -* w3-lemac.el: -Now add options menu before the Save Options menu in lemacs 19.10 - - -* w3.el: Switched to using my new mm.el package for mime stuff. - -* w3-vars.el: Removed old w3-xxx vars related to mailcap and mimetype parsing. - -* w3-mac.el: The Macintosh menus now work. - -Fri May 13 20:45:39 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Added ` to the syntax table as a quote operator - -* w3-vars.el: Switched from giftoppm to giftopnm - -* w3.el: Changed the x-exec handling so that it can't mess up the -process-environment by accident (thanks to Jamie Zawinski) for the -info. Also changed it so that the environment is only messed with if -the executable is actually found somewhere in w3-local-exec-path. -Save a few conses and string creations. - -Thu May 12 18:11:51 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed a few problems in the cleanup of unrecognized tags, as well as -header handling. - -* w3-lemac.el: Fixed a few image-related quirks. - - -* w3-lemac.el: Removed cursor changing code. - - -* w3.el: Forgot to (widen) after the new MIME parasing code. - - -* w3.el: Rewrote w3-parse-mime-headers to extract its information from the -buffer instead of doing lots of work on strings/etc. Also rewrote -part of the guessing of mime-types when no content-type explicitly -given. - -* w3.el: The no_proxy environment variable can now hold a unix-shell-type -comma-separated list of wildcards, and it will be transformed into a -real regular expression. - -* w3.el: Will now send Pragma: no-cache when doing a reload. . . -Also now supports the no_proxy environment variable. - -* w3.el: -Fixed a few places where w3-insert-graphic was still called the old way. -Also fixed problem where local images weren't being converted correctly. - -* w3-lemac.el, w3.el: Fixed various compilation errors - -* w3-lemac.el: -Basis for ismap image clicking enabled. Sends off quite the wrong -area (x,y relative to emacs frame, not the image). Should be trivial -to fix with a few additions to the C code. - - -* w3.el: -Seem to have fixed the problem of inlined images not being used as links. - - -* w3-lemac.el: -w3-find-specific-link will now highlight the correct extent until -input is available. - -* w3.el: Finally really fixed the bug in the infinite recursion when building -lists. Problem was with unterminated lists. - -* w3.el: Following a named link (#XXX) will now push the mark so you can get -back to it with C-u C-space - -Wed May 11 22:35:33 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed problem of remote files being formatted incorrectly. -w3-buffer-is-hypertext was not always returning the correct value. - - -* w3.el: Links within headers should look better now. - -* w3-e19.el: New versions of the overlay-specific functions, plus changed the -default under emacs19 to be using overlays. - -* w3-e19.el: Few patches for highlighting headers. - -* w3.el: No longer assume temporary files go in /tmp... now uses -w3-temporary-directory and expand-file-name for all temporary file -creations - - -* w3.el: Patches from Bob Weiner to get asynchronous retrieval through a 'host -gateway working. - -* w3.el: -Hopefully fixed the not-guessing-if-a-buffer-is-html bug for remote file access - -* w3.el: Fixed problem in w3-follow-link with NAMEd links with no href. - -* w3.el: Fixed problem with infinite recursion during list building. - -* w3-vars.el: -w3-mime-viewers has been trimmed down a lot, will depend on the users -mailcap much more. - -* dist.Makefile: Can now 'make mailcap' - -* w3.el: w3-parse-mailcap can now take a URL. - -* w3.el: Killing of HTML comments will now make sure there is whitespace where -the comment used to be. ie: (some text<!-- ack -->more text ==> some -text more text) - -* w3.el: Fixed problem where text immediately after a </pre> tag but before a -<p> tag weren't filled correctly. - -* w3.el: Changed w3-mailcap-entry-passes-test to check for the common "test -n -$DISPLAY" cases and handle them automatically in elisp instead of -shelling out to check the return status. - -* w3.el: Changed all after-hook-function references to be after-hook-functions, -and use add-hook instead of explicit setq's - -* w3.el: The mailcap parsing routine now honors the 'test' clause - -* w3.el: fixed problem in w3-parse-args - -Tue May 10 23:56:29 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: Few changes to the extent handling code. No more hacks for -w3-fix-extent-endpoints or w3-insert - -* w3.txi: Few bug fixes to the docs. - -Mon May 9 20:41:03 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: -If an image is more than 1/2 the size of the current screen, it will -be moved down onto a line by itself. - -* w3.el: Fixed bug in title handling if there was an end tag like <title > - -* w3-lemac.el: -Workaround for bug in lucid emacs where deleting text in map-extents -would do _very_ bad things. Loading inlined images/mpegs would -sometimes cause it to crash. - -* w3-lemac.el: More changes to the image handling - -Sun May 8 17:46:14 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: Changed to using annotations for inlined images - -Sat May 7 16:22:58 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Changed w3-file-attributes to not use HTTP/1.0 to HEAD a file unless -w3-be-anal-about-file-attributes is non-nil - -* w3-lemac.el: -Can now filter inlined image loads based on MIME type and/or file size. - -Thu May 5 16:26:19 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: New submenu for lemacs - restrict image loads by type. - -* w3.el: Fixed problem in the after-change-function yet again. - - -* w3.el: Few changes to the after-change-function handling, as well as changes -to the mpeg loading code - -* w3-lemac.el: -New menu items for showing inlined mpegs or not, as well as functions -to load single and multiple delayed mpegs. - -* w3-vars.el: New variable w3-delay-mpeg-loads - -* w3-e19.el: -Builtin support for mouse-movement keys, if 19.23 ever works with them... - -Tue May 3 20:25:40 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el, w3-vars.el, w3.el: -Lucid emacs 19.10 or higher can now display inlined mpegs by default. -Use <embed src="url of mpeg to play" type="video/mpeg"> to try it out. - -Mon May 2 22:02:21 1994 William Perry <wmperry@indiana.edu> - -* w3.txi: -Added in documentation of the emacs19 faces hacking for dumb terminals - -* w3-lemac.el: Applied patch by Alastair Burt to fix dumb typo on my part. - -* w3.el: Few changes to the 'host gateway code - -* w3-e19.el: Fixed problem in w3-find-specific-link in emacs19 - -* w3.el: Changed w3-parse-args to extract the information out f the original -buffer instead of wasting 2 or 3 string/buffer creations - -* w3-vars.el: Changes to the w3-parse-args-syntax-table - -Sun May 1 22:58:34 1994 William Perry <wmperry@indiana.edu> - -* w3.el: -Fixed problem in w3-after-change-function and escaping % from w3-lazy-message - -Fri Apr 29 21:48:26 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: New variables for keeping track of status messages better - -* w3.el: New way of doing the HTTP transfer status messages. Now uses the -after-change-function if available. This way even asynchronous -transfers get the good XXX of YYY (ZZ%) transfer messages. Also now -support the Status: header, which will be shown instead of the normal -XXX bytes message. - -* w3-vars.el: More HTML+ entities - -Thu Apr 28 14:51:32 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed a few problems with the x-exec stuff. - -* w3-emacs.el: Fixed problem in v18 mouse support - -Wed Apr 27 16:14:01 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: -New variables w3-mime-editors, w3-mime-bitmaps, w3-mime-composers, and -w3-mime-printers that are initialized from the entries in the mailcap -file - -* w3.el: Rewrote w3-parse-mailcap so that it keeps a _LOT_ more information -from the mailcap file, including composers, editors, labels, and -bitmaps. - -* w3-e19.el: Few changes to the options and popup menus - -* w3-lemac.el: New options menu for new lemacs - -* w3-vars.el: Revamped the main menu and popup menus to be shorter - -* w3-lemac.el: -Changed w3-zone-at and w3-zone-data to use new 'w3delayed for delayed images. - -* w3.el: Reworked who delayed image processing works. You can now click on a -delayed image and it will load just that image. Similar to how the -Mosaic clients work. Also, the ALT tag is inserted if available. It -is deleted from the buffer when the image is loaded. - -Tue Apr 26 21:33:26 1994 William Perry <wmperry@indiana.edu> - - -Mon Apr 25 21:16:33 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: -Should have fixed the ugly interaction between emacs-vers.el and lemacs 19.9 - -* w3.el: Fixed problem in w3-fix-unknown-tags - -Sun Apr 24 19:30:51 1994 William Perry <wmperry@indiana.edu> - -* w3.el: -A few fixes to the native wais handling - still a little broken though. - -* w3-vars.el: -Changed the help on xxxx menu item to fetch the .html files instead of -the ones with no extensions - our server sends text/plain with no -extension - ugh - - -Sat Apr 23 18:57:30 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed a problem in w3-parse-relative-link that would cause #X links to -be doubled to #X#X - -* w3-e19.el: -Can now choose whether you want to use overlays or text properties for -keeping track of the internal w3 information. Try -(put 'w3-emacs19 'use-overlays t) in your .emacs to try it out. - -Fri Apr 22 14:53:15 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: Removed ugly emacs 19.23 hack that could mess up buffers - -* w3.el: Added a function to generate a FORM for posting/mailing a reply to a -newsgroup. - -* w3-lemac.el: Added w3-view-ppm to view p[bp]m files in an xwindow glyph - -Thu Apr 21 20:37:24 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Redid the help menu - -* w3-lemac.el: -Changed button binding and menu stuff to conform to new lucid emacs style - -* w3.el: Changed w3-prepare-buffer to return the title of the document - -Tue Apr 19 23:17:48 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed up w3-parse-args so that it can deal with no trailing " or ' on -an attribute that started with one. - -* w3-lemac.el: Fixed a few of the w3-toggle-xxxx - -* w3.el: Made epoch use the old V18-style kill-emacs-hook - -* w3.el: Fixed problem with headers having the last char moved down onto a new -line when using w3-emacs19-hack-faces-p - - -* w3.el: Try using .newsrc-SERVERNAME before just plain old .newsrc. - -* docomp.el: More defvar's - -* w3.el: -Backed out one optimization of w3-parse-args that caused emacs19 to barf. - -* w3.el: w3-news-server now consults gnus-default-nntp-server, -gnus-nntp-server, and nntp-server-name if they're bound and non-nil -and != "". - -* w3-e19.el: -Use glyphs in the display table so that emacs doesn't get as confused -about the cursor position when using w3-emacs19-hack-faces-p - - -* w3.el: Moved the finding of #xxx links after the loading of images, just in -case point gets confused. If no #xxx link, make sure to go to -(point-min) - -Mon Apr 18 23:40:19 1994 William Perry <wmperry@indiana.edu> - -* w3.el: -Optimized w3-parse-args some more. Thanks to jwz@lucid.com for the input - -* w3.el: Fixed problems with ../ as the first part of a relative url - -* w3-lemac.el: -Wrapped the new definition of the options menu in a check for the -latest version of lemacs - -* w3-lemac.el: -Changed the menus to use the new 19.10 method of menus so that it uses -Toggle buttons, etc. - -* w3.el: Finished implementing the SRC attribute for SUBMIT buttons - -* w3-e19.el: Added a hack-vt102 function - -* w3.el: New w3-parse-args - - -* w3.el: Added support for a SRC attribute to the submit button - -Sun Apr 17 22:28:08 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed error message in w3-hotlist-add-entry, and added function -w3-hotlist-refresh. - -* w3.txi: New hotlist func - -Fri Apr 15 21:25:21 1994 William Perry <wmperry@indiana.edu> - - -* w3-vars.el: Removed some obsolete variables - -* w3.el: Fixed the history mechanisms - - -* w3-vars.el: Moved defvar of w3-emacs19-hack-faces-p into main variables file. -Also moved the default setting of w3-delimit-emphasis and -w3-delimit-links into w3-do-setup so they will be set correctly if -dumped with emacs. - - -* w3-e19.el: Can now hack faces for xterm and linux console - -* w3.el: Added in support for user:password@hostname ftp URLs - - -* w3-e19.el: Fixed problems in w3-mouse-handler - -* w3-e19.el: If you are using VT100's and emacs 19.22, you CAN GET BOLD AND -UNDERLINED text now. Please try setting the variable -w3-emacs19-hack-faces-p to non-nil. To get rid of it, use M-x -w3-emacs19-unhack-vt100 - - -* w3.el: -Fixed bug in w3-parse-relative-link that could cause major problems with -~ and w3-current-file = nil. - -Thu Apr 14 22:28:06 1994 William Perry <wmperry@indiana.edu> - -* w3-lemac.el: -Removed colorize-pixmap call since lemacs takes care of that now. - -* w3.el: Fixed problem in w3-search where it did not nuke the last search term -from the url before appending the latest search string. - -* w3.el: the x-exec URL handler will now make sure that all returned messages -are HTTP/1.0 messages, using the return value of call-process-region -to get the HTTP/1.0 return status code if one is not explicitly given -by the script. - -* w3.el: Include definition of emacs19-ism 'setenv' for old versions of emacs. -This function is required to use the x-exec URL. - -* w3.el: Fixed some odd formatting of <hr> - - -* w3.el: Added support for the x-exec url - -Wed Apr 13 21:58:09 1994 William Perry <wmperry@indiana.edu> - - -* w3.el: Fixed problem in w3-fix-proxy - -* w3-e19.el: -Fixed a problem with emacs 19.23 and the previous-single-property-change - -* w3-lemac.el: Fixed w3-insert to deal with extent-start > extent-end - -* w3.el: Fixed the proxy support so that w3-view-url will show the url of the -proxy'd document, not the entiry 'proxyservice''realurl' garbage - -* w3.el: Fixed w3-parse-args yet again... - -* w3.el: Few fixes to the newsrc parsing (unbound variables from cut&paste) - -* w3.el: Lots more news work. Now supports parsing the newsrc and only showing -unread articles in newsgroups, as well as displaying a list of all the -newsgroups (distinguishes subscribed and unsubscribed groups). - -* w3.el: Added links to post to the newsgroup and reply to the author in news -handling - -* w3-vars.el: Added newspost to the list of allowable link types - -* w3.el: w3-view-url now works with news: urls -w3-parse-relative-link now works with news: urls -w3-format-whole-newsgroup now spits out valid HTML+, and better looking too -w3-format-news now spits out valid HTML+, looks like GNUS under lucid - -Tue Apr 12 08:01:20 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem where using a gateway could screw up the recognition of -an http/1.0 response - -* w3-e19.el, w3-emacs.el, w3-epoch.el, w3-lemac.el: -Changed w3-forward-link and w3-back-link to take a prefix-arg for -how many links to go forward. - -* w3.el: -Fixed a bug in w3-parse-relative-link that would expand ~/ when it shouldn't - -Mon Apr 11 23:27:43 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Revamped w3-create-multipart-request to only use valid separator chars - - -* w3.el: Fixed problem in w3-parse-docs-menu. Added code to create a MIME -multi-part request. - -* w3.el: Fixed problem in w3-form-encode for name=isindex when it wasn't the -only entry area in the form (a submit button, etc) - -* w3.el: fixed problem in list-expansion - -* w3.el: Fixed problem in w3-parse-args if something was (read) as a number -instead of a string. - -* w3.el: Fixed a problem in w3-parse-args with emacs19 - -Sun Apr 10 21:51:40 1994 William Perry <wmperry@indiana.edu> - -* w3-e19.el: w3-add-zone now uses the mouse-face property in emacs 19.23 - -* w3-e19.el: Fixed various problems related to lmenu in emacs 19.23 - -* w3.el: Fix to the mosaic docs-menu parsing - -* w3.el: No longer send the SUBMIT button when submitting forms - -* w3.el: New code to parse the Mosaic documents.menu file to add user-specified -menus in lucid/FSF19 - - -Sat Apr 9 20:49:30 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Rewrote the SGML-comment killing code... should work better now. Not -sure if it is still compatible with the Mosaic way of killing -comments, but Mosaic is broken in that regard, so I don't really -care. :) - -* w3.el: w3-show-hotlist will show the hotlist entries in the same order that -they were stored, instead of the old reverse-order behavior. Also -changed some of the automatically generated HTML to be strictly -correct HTML+. - -* w3-vars.el: -Also removed www.cis.ohio-state.edu from the bad-server-list... is now -an HTTP/1.0 server - -* w3-vars.el: -Removed cs.indiana.edu from the w3-bad-server-list, as we have finally -upgraded to plexus. - -* w3.el: w3-submit-bug now sends me the URL of the current buffer (if any) - -* w3.el: Fixed a problem with file:./foo being interpreted wrong. - -* w3.el: Rewrote w3-basepath and w3-parse-relative-link to use -expand-file-name, file-name-nondirectory, and file-name-directory. -More reliable than the old regular expressions - - -* w3.txi: Fixed more texinfo bugs. - -* w3-srch.el: Few tweaks in searching. - -* w3.el: Another bugfix to w3-parse-args - -* w3.el: Generate errors for non-existent local files now - -Fri Apr 8 23:10:20 1994 William Perry <wmperry@indiana.edu> - -* w3-vars.el: Fixed all the missing HTML entities, and fixed several others. - -* w3.el: Fixed problem in w3-insert-entities-in-string using &nsp; instead of -  - -* w3.el: Added a 'binary' option to w3-save-as - -* w3.el: New w3-parse-args - - -* w3.txi: Wrote the PGP/PEM doc. (well, borrowed them from robm@ncsa.uiuc.edu). - -* w3.txi: Wrote the using with vm and using with gnus nodes. - -* w3.el: Added an autoload for w3-follow-link - -* w3.txi: Fixed a few reference problems. - -* w3.txi: Lots of variable definitions added. - -Thu Apr 7 22:32:06 1994 William Perry <wmperry@indiana.edu> - -* w3.txi: Actually wrote the gateway/firewall documentation. - -* w3-e19.el: Fix-extent-endpoints will now work better. - -* w3.el: Fixed a problem with w3-create-mime-request and interaction with the -CMU-BEAK server - -* w3.el: Fixed w3-parse-args for good I hope... now infers missing "s - -* w3.txi: Fixed some validation errors - -* w3.el: Ignore case in completing-read in w3-use-links - -<hr> parsing should now be more robust. Paragraph filling after the -<hr> will no longer be hosed. - -* w3.el: More work on w3-parse-args - think I got it right this time. - -* w3.txi: Fixed problem with setting the info filename - -* w3.txi: Fixed a few heirarchy bugs - -* w3.el: Rewrote w3-insert-entities-in-string to use mapconcat - quicker/more -efficient than lots of string-matches and substrings, especially for -small strings. - -Fixed problem in w3-parse-args that would swallow multiple spaces, -even from quoted attributes (ALT=" " => ALT=" ") - -* w3-vars.el: Added < back into the w3-html-entities list. - -* w3.el: Fixed bug in the single-form-entry-in-a-form submission. Was only -sending the form value, not the name/value pair. - -Reworded the 'fixing bad html' messages to be 'checking for bad html' -so that it wouldn't confuse people and make them look for bad html -that wasn't there. - -Also fixed w3-fixup-bad-html so that it would work more often. - -Fixed the annoying problem of a blank line between the first and -second lines of any type of list if there was a <p> tag before it. - -Fixed problem with the <p align=indent> handling. Was inserting the -extra tab too early sometimes. - -Fixed a problem in w3-parse-args that would cause it to return the -wrong values for attributes like alt="" - it would return ("alt=") -instead of ("alt" . ""). - -* w3.el: -Added in code to try and load the file w3-site-init. To fix site-wide stuff. - -Wed Apr 6 23:13:59 1994 William Perry <wmperry@indiana.edu> - -* w3.el: Fixed problem with unbound data-directory in v18 emacs - -* w3.txi, w3.el, w3-vars.el, w3-srch.el, w3-next.el, w3-mule.el, w3-mac.el, w3-lemac.el, w3-hypb.el, w3-epoch.el, w3-e19.el, w3-emacs.el, docomp.el, dist.Makefile: -Initial revision - -Wed Apr 6 20:34:34 1994 William M. Perry (wmperry@indiana.edu) -* Release version 2.1 -* w3.texinfo: Merged in new texinfo documentation. -* w3-vars.el: More keybindings -* w3.el: Added in first pass at a multi-part/www-form creation function. -* w3.el: Fixed a problem with setting up the kill-emacs-hook in emacs 18 - -Tue Apr 5 21:53:52 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Added back in support for the <em> tag. -* w3-vars.el, w3.el: Added new w3-gateway-method 'tcp. This will do a - (require 'tcp), then set the w3-gateway-method to be 'native. -* w3-vars.el: Fixed typo in w3-html-entities - left off a ; in < -* w3.el: Fixed problem with handling upper-case types in urls (HTTP did - not go to w3-http, etc.) -* w3-vars.el: Fixed wrong-case entity &Szlig... -* w3-vars.el: Added application/postscript to the default - w3-embedded-data-converters variable. -* w3.el: Fixed bug in unordered list building - would sometimes not insert - a ' ' after the indentation. Also added a function to embed postscript - in a document. -* w3.el: Added function w3-embed-eqn to embed 'application/eqn' types in - the forms of bitmaps. Requires 'pstoxbm' 'groff' and 'eqn'. -* w3.el: Added code to w3-kill-emacs-func to clean up the /tmp storage - area. -* w3-vars.el, w3.el: Added support for the <embed> attribute. -* w3-lemacs.el: Check for errors in colorize-pixmap, or else further - conversions will fail if one does. - -Mon Apr 4 21:42:40 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Added _ALL_ known entities from the latest HTML+ specification. -* w3.el: unNAMEd input fields will now have their TYPE as the name. -* w3.el: The submit buttons name/value pair will now be passed to the - server when a form is submitted. -* w3-emacs19.el: Added in a fix for http:/xxxxx/yyy/ to become - http://xxxxx/yyy/ for the file-name-handler-alist -* w3.el: Added handling of <UL PLAIN> lists - no bullets. -* w3-lemacs.el, w3-vars.el, w3.el: Got rid of kludgey way of colorizing - Xbitmaps in newer versions of lucid emacs. Now uses the built-in - function colorize-pixmap. Much faster/reliable than piping it through - 'sed'. -* w3-lemacs.el: Removed the 1+ error with extents. Since I no longer use - 'end-open and 'start-open properties in lucid its no longer necessary. - -Sun Apr 3 18:55:42 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: w3-handle-graphics now resolves relative links when - w3-insert-graphic is undefined. Was causing problems with documents - with a <BASE ...> tag. Thanks to Stephen G Simpson for noticing the - problem. -* w3-vars.el: Added keybinding M-return to be w3-follow-inlined-image -* w3.el: Expanded lots of function doc strings. Fixed bug in resetting - radio buttons so that they all don't turn on. -* w3-lemacs.el: Working versions of w3-hide-zone, w3-unhide-zone, and - w3-zone-hidden-p for lucid emacs. - -Sat Apr 2 21:26:18 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem in invisible list handling -* w3.el: Fix for headers bleeding over into the body when filling - paragraphs. -* w3.el: <BR> now works for right/left/center/just aligned paragraphs. -* w3-vars.el: Fixed a few problems in w3-persistent-variables -* w3.el: More informative messages during parsing. Fixed <BR> tags in - lists. More messing with paragraph filling. -* w3.el: Fix to w3-process-status for w3-gateway-method of 'host. Fix to - w3-save-as. Lots of changes to the non-list paragraph filling. Now - supports the align attribute of HTML+ (center, left, right, indent, and - justify work) - -Fri Apr 1 18:02:51 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem in w3-handle-graphics with the new w3-parse-args - routine -* w3.el: More use of w3-parse-args instead of old crufty regexps 20 times -* w3.el: <HR> is now honored within <PRE> segments. -* w3-lemacs.el, w3-vars.el, w3.el: Changed some more of the internal - caching - should be able to just (load-file (w3-find-in-cache - "someurl")) and get the exact same buffer. -* w3.el: Use rings for the internal cache of documents. - -Thu Mar 31 19:37:58 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: New way to parse out <link> tags... keep rel and rev separate... - -Wed Mar 30 20:41:49 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Few documentation string changes - -Tue Mar 29 22:10:10 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Added application/x-tar to the default mime-viewers list -* w3.el: Show what filename is being passed to the viewer subprocess in - w3-pass-to-viewer, slightly more informative this way. -* w3-emacs19.el: Rewrote w3-fix-extent-endpoints for emacs19 so that a few - forms formatting bugs would be fixed. -* w3.el: Fixed problem with previewing buffers who's name started with a - '/'. Thanks to Carl Witty (cwitty@ai.mit.edu) for noticing the problem. -* w3.el, w3-vars.el: New variable w3-graphics-always-show-entities. If t - (the default), then the small inlined graphics will always be shown, - regardless of the value of w3-delay-image-loads. -* w3.el: Fixed problem with removing carriage returns from binary gopher - transfers. - -Mon Mar 28 23:36:39 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Changed w3-parse-args to not screw up on quoted multi-word - attribute values - -Wed Mar 30 20:41:49 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Few documentation string changes - -Tue Mar 29 22:10:10 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Added application/x-tar to the default mime-viewers list -* w3.el: Show what filename is being passed to the viewer subprocess in - w3-pass-to-viewer, slightly more informative this way. -* w3-emacs19.el: Rewrote w3-fix-extent-endpoints for emacs19 so that a few - forms formatting bugs would be fixed. -* w3.el: Fixed problem with previewing buffers who's name started with a - '/'. Thanks to Carl Witty (cwitty@ai.mit.edu) for noticing the problem. -* w3.el, w3-vars.el: New variable w3-graphics-always-show-entities. If t - (the default), then the small inlined graphics will always be shown, - regardless of the value of w3-delay-image-loads. -* w3.el: More fixes for binary gopher transfers -* w3.el: Fixed problem with removing carriage returns from binary gopher - transfers. - -Mon Mar 28 23:36:39 1994 William M. Perry (wmperry@indiana.edu) -* w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-lemacs.el, w3-old-lemacs.el: - New function w3-zone-hidden-p -* w3.el: Changed w3-parse-args to not screw up on quoted multi-word - attribute values - -Thu Mar 24 22:49:50 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed w3-hexify-string so it strips out entity references -* w3-emacs19.el: Fixed problem where w3-zone-start/w3-zone-end could - return nil if the end of the zone was at point-min/point-max -* w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-lemacs.el, w3-old-lemacs.el: - Added functions w3-hide-zone and w3-unhide-zone -* w3.el: Can now unhide expandable lists (all this only works in FSF emacs - 19) -* w3.el: Added in support for <OL|UL|DL FOLDED="yes">, to hide sublists. -* w3.el: Removed changing of w3-xxx-delimit-links when following links for - now. Did not work 100% of the time. -* w3-emacs19.el: Now get rid of annoying automatically-turned-on-menubar - in emacs19... - -Wed Mar 23 23:53:22 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Changed all calls to process-status to be w3-process-status -* w3.el: Added function w3-accept-process-output that will block and - timeout on a read instead of exiting immediately in emacs' that support - it (everything but vanilla 18.59 and mule) -* dist.Makefile: Added target to compile w3-mac - - -Tue Mar 22 23:05:07 1994 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: Wrote a w3-insert for emacs19 that nukes all text - properties after insertion -* w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-lemacs.el, w3-old-lemacs.el, - w3-vars.el: Now check for whether hyperbole has been loaded before - binding any mouse keys so as not to interfere with it. -* w3.el: Fixed problem with graphic entities. -* w3-lemacs.el: Slightly better formatting of the image error buffer -* dist.Makefile: Fixed install problem with w3-mac.el -* w3-emacs19.el, w3-vars.el, w3.el: Changed all references from dps-xxx to - ns-xxx to make w3 work with the beta1 release of emacs19 for NeXTstep -* w3.el: More work on the 'host type gateway -* w3.el: Lots of work on the new gateway support. -* w3.el: Few cleanups... work on the history mechanism -* w3.el: A hypertext link in the current buffer is changed to use the - w3-visited-node-style when it is followed. -* w3-emacs.el: Check to make sure that system-type is next-mach before - loading the Emacs 18.xx NeXT extensions -* w3.el: Fixes to the image code and the OPTION/SELECT form parsing. -* w3-vars.el: Changes to w3-graphic-converter-alist -* w3-lemacs.el: Stop using start-open and 'end-open properties - -Mon Mar 21 22:40:01 1994 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el, w3-epoch.el, w3-lemacs.el, w3-old-lemacs.el: Put in code - to actually create the new w3-visited-node-style face. -* w3-lemacs.el: Fixed problem with w3-insert at the end of the buffer -* w3.el: Changed the icon directory to be a list of possible sites, keep - the hits in w3-icon-path-cache to save time. Adds the ..../etc/w3/ - directory to the search path automatically in w3-do-setup -* w3.el: Stuck in a few nntp-XXXX macros from gnus.el so I don't have to - require 'gnus -* w3.el: New variable w3-link-delimiter-info. This can be a function that - should return a string to insert at the end of a hypertext link. - Intended for things like 'interestingness' functions, etc, but can be - used for just about anything. It is passed the full url of the link as - its only argument. -* w3.el: Must now specify w3-link-start-delimiter and - w3-link-end-delimiter as a cons pair. The car is the string to insert - before/after a link that has not been visited before, and the cdr is the - string to insert before/after a link that has been visited. -* w3.el: Can now specify whether personal annotations should appear at the - top or bottom of a document. Variable w3-annotation-position can be - either 'top or 'bottom. -* w3-emacs19.el: Fixed the problem with going from the first form button - on a page to a previous hyperlink button. -* w3-lemacs.el: Rewrote w3-insert for lucid 19.9+... -* w3.el: Fixed several forms-related problems. -* w3.el: Input type=hidden implemented -* w3.el: Now strips out ?... from urls that you are searching on. No more - xxxx?xxx?yyy. -* New definition of b0, so authentication shouldn't bomb on some urls - anymore -* w3-vars.el: Added new face - w3-visited-node-style - that is used - instead of w3-node-style if the url has been visited already. - -Fri Mar 18 13:50:59 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem with usernames in ftp links not being carried over - with relative links (w3-parse-relative-link xxx). -* w3-emacs19.el: w3-zone-data now correctly returns w3graphic zones. -* w3-docomp.el: Added in stuff so that new lucid doesn't barf out warnings - when compiling w3-old-lemacs.el - -Thu Mar 17 18:54:08 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Minor change to w3-link-begin-regexp -* w3.el: New function w3-parse-args that takes an attribute block from an - SGML element and returns an assoc list of attributes and their values. - Lots of changes throughout the code to take advantage of it. No more - (string-match <funky regexp> x), etc. -* w3-vars.el: Added entry for x-pixmap in graphic converter alist -* w3-vars.el: Fixed dumb problem with menus and the newly renamed hotlist - functions -* w3.el: Fixed problem with double typing when w3-use-hypertext-gopher is nil. -* w3.el: Added code in to keep the old value of kill-emacs-hook laying - around in emacs18 so that w3 doesn't overwrite any of the other hooks. - -Mon Mar 14 22:10:37 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Added a few items to the menus - -Sun Mar 13 22:43:16 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed dumb problem in w3-save-as... thanks to Eyvind Ness - <Eyvind.Ness@hrp.no> for pointing it out - -Fri Mar 11 23:05:04 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Set w3-delayed-images to nil so you can't load them twice... -* w3-vars.el: New variable w3-form-cursor that specifies the cursor to use - when entering a form. -* w3-lemacs.el: Clicking on an image will work correctly in lucid emacs - now... was not returning a 'w3graphic object with w3-zone-data -* w3-lemacs.el: Changed w3-add-zone to take advantage of my proposed - change to x-track-pointer, just in case it is included... -* w3-vars.el: Fixed problem in the entities list with &Szlig; being - capitalized... - -Wed Mar 9 21:29:25 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Make sure that the delimiters around headers don't extend over - two or more lines - looked real ugly if you had multi-line headers. -* w3.el: Fixed emacs-18 problem with kill-emacs-hook being a list of - functions. Also changed the way w3-mode saves/restores a list of - buffer-local variables - new variable w3-persistent-variables is a list - of variables to preserve when entering w3-mode. Much easier to add new - vars to than adding in a (setq xxx (nth yyyy tmp)) in w3-mode. - -Mon Mar 7 13:34:28 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Rewrote w3-grok-gopher-link so it doesn't create huge strings - every time it is invoked. Caused LOTS of garbage collection. Using - skip-chars-forward works _much_ faster and is more efficient. - -Sun Mar 6 23:05:21 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: New variable w3-personal-mail-address that is sent as the - From: field in http/1.0 requests -* w3-vars.el: Fixed documentation strings to not have entity references in - them. Also extended documentation for several variables. -* w3-vars.el: Changed default value of w3-track-mouse to be t. -* w3-old-lemacs.el: New version of w3-mouse-handler for old versions of - lucid. -* w3.el: Rewrote w3-load-delayed images to use mapcar and apply instead of - taking the (nth x (car something) to extract the info. Should be - faster, although probably not noticeable. Also load the images in - reverse order, so they appear in the correct order. -* w3.el: Fixed DUMBASS problem in w3-create-mime-request. Was sending a - full url instead of just the filename portion in an HTTP/1.0 request. -* w3-vars.el, w3.el: Added uuencoding and uudecoding functions. Needed - for sending ripem auth requests - -Sat Mar 5 21:09:46 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem with w3-basepath and null arguments. -* w3.el: Fixed relative links from within previewed buffers. -* w3.el: Fixed fill-out forms post submissions, and general problem with - w3-create-mime-request and w3-request-extra-headers -* w3.el: Fixed problem with dired-type listings of files in w3-mode -* w3.el: Corrected check for file size of -1 in w3-format-directory -* w3.el: Changed default content-type to be text/plain. If there is no - content-type defined, try to figure out if a buffer is hypertext or not, - and set the content-type to text/html if it is. -* w3.el: The graphical entities can now be specified as a list of two - strings. First is the bitmap filename, the second is similar to the ALT - tag in images. - -Fri Mar 4 21:57:48 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: New variable w3-wais-to-mime that converts wais doctypes - into MIME content-types -* w3.el: New way to retrieve wais doc-ids... doesn't work all the time - though - why not? -* w3.el: Removed the call to dps-display-color-cells, as it causes a - coredump in all the versions I have ever tried on the NeXT. -* w3-lemacs.el: Fixed problem with quoting percents in w3-track-mouse. - -Thu Mar 3 18:57:03 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem in new header handling. -* w3.el: w3-file-attributes will no longer choke if given a null argument. -* w3-search.el: Remove all '#XXXX' references from URLs, so it is easier - to tell if we have visited them before -* w3-vars.el: Changed w3-header-chars-assoc to use characters instead of - strings, and use make-string to make the header delimiters the same size - as the header. This can still mess up on headers with inlined images, - but all in all it looks much better. Thanks to Jared Rhine for the - suggestion. -* w3.el: Changed lots of functions to use mapcar instead of while loops - - sould be slightly faster. -* w3.el: Added hook to kill-emacs-hook to write out the global history if - necessary. Also rewrote part of w3-write-global-history - -Wed Mar 2 21:57:44 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem with w3-file-attributes and non-existend - local/remote files. -* dist.Makefile: Added mac and searching files to the distribution. -* w3.el: w3-retrieve now updates w3-global-history-completion-list -* w3.el: w3-fetch now does a completing read so that you can have - completion based on your .mosaic-global-history file. -* w3-search.el: w3-do-search can now take an optional BASE argument, that - is the url to start searching from. The search function also now checks - to see if there is a buffer visiting a url in the queue before - retrieving it. -* w3.el: w3-save-as now uses w3-current-source if possible. Saves time on - retrieval. -* w3-vars.el: Fixed menu entry for 'View Source' that was still calling - old function names. -* w3-lemacs.el: If w3-track-mouse is non-nil, and w3-link-cursor is - defined, change the mouse cursor to w3-link-cursor when over a link. - w3-link-cursor defaults to "hand2". w3-link-cursor is set up in - w3-do-setup only if w3-link-cursor is a string, so the user can set it - to a pixmap in their .emacs file if they wish. -* w3.el: <BR>s in lists now handled better. -* w3.el: The new graphic entity support now honors the - w3-delay-image-loads variable - -Tue Mar 1 23:55:50 1994 William M. Perry (wmperry@indiana.edu) -* w3-lemacs.el, w3-epoch.el: Added binding of w3-source to 't' so that - w3-retrieve will always grab a buffer for retrieving inlined images -* w3-search.el: Miscellaneous fixes... -* w3.el: More changes to w3-file-attributes to compensate for HTTP/1.0 - servers that don't implement HEAD -* w3.el: Fixed error in determining if a URL exists or not in - w3-file-attributes -* w3.el: w3-file-attributes won't send a HEAD request to a known - non-http/1.0 server -* w3-search.el: Can now specify the search term as a function, and it will - be funcall'd with the URL as an argument. RESTRICTION can be either a - regular expression or a function name - if string-match or funcall - against the URL fails, don't insert it into the queue. Also now smarter - about not visiting the same URL multiple times. -* w3.el: Fixed a dumb mistake in w3-file-attributes -* w3-search.el: The searching functions work now. Takes a regular - expression and a max-hops argument. Returns a list of URLs that the - regular expression was found in. -* w3-emacs19.el: Fixed problem with radio buttons/checkboxes at the end of - lines in emacs19 -* w3.el: Don't send the referer: field if using as a home-page or manually - requested URL - -Mon Feb 28 22:12:18 1994 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el, w3-lemacs.el, w3-old-lemacs.el, w3-vars.el: Removed - redundant definitions of w3-XXXX-menu. w3-options-menu is still in each - file, since new lucid emacs has some extra features I can use in it. -* w3.el: Will no longer copy local files into a buffer, then into /tmp - when passing to an external viewer - creates a symbolic link instead. - -Mon Feb 28 03:24:33 1994 William M. Perry (wmperry@indiana.edu) -* Release of v2.0.22 -* w3.texinfo: Description of new proxy services. -* w3.el: Fixed problem in w3-fix-ampersands - -Sun Feb 27 23:37:53 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Fixed un-escaped "s in defvar for w3-proxy-services -* w3.el: Changed gopher/ftp/file directory handling to use the new - graphical entities instead of IMG -* w3-vars.el: New variable w3-graphics-entities-alist holds an assoc list - of entities and the names of bitmaps to replace them with. - w3-icon-directory is appended to the front of each filename - automatically. - New variable w3-gopher-icons which holds the new graphic entity - references to describe each type of object. -* w3.el: Tweaks to wais code... seems to be working now. -* w3.el: Fixed stupid problem in the basic authorization code where I - wasn't setting the variable in a while loop to (cdr var) -* w3.el: Added in proxy gateway support as put forth by Lou Montulli and - others. Uses the new ACCESS_proxy environment variables. -* w3.el: Multiline text entry boxes now reset correctly when - w3-revert-form is called -* w3.el: Single input-area forms now submit themselves after you enter the - data. No need for a submit button. -* w3.el: Fixed error in w3-http, where it was sending the output of - w3-view-this-url instead of w3-view-url to w3-create-mime-request. - Referer: fields will work better now. - Basic authorization will now work with inheritance from protected - directories. (/foo/bar/baz.html is protected, then so is - /foo/bar/quuux.html, as is /foo/bar/baz/temp.html, etc) -* w3.el: Wais support seems to be working... -* w3.el: More fixes to the wais searching functions. - -Sat Feb 26 20:44:39 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Changed w3-prepare-buffer to take an optional argument, - no-display, which if t will keep it from renaming the buffer and - displaying it. -* w3-vars.el: Added < and > to the list of entities, even though they - are wrong, since so many people seem to be using them. -* w3.el: Strip out port numbers in ftp requests. -* w3-lemacs.el: Spaces are now inserted after a graphic in lucid, and the - graphic extent is only on that one space. -* w3-emacs19.el, w3-lemacs.el, w3-old-lemacs.el: Changed w3-zone-at to - return the extent, not the data. -* w3.el: Better cleaning of telnet buffers before parsing. -* w3.el: Fully implemented the Referer: field. Also, w3-mime-response-p - should be a little more robust. Should also kill an http request when - using the gateway support. -* w3-vars.el: New variable w3-telnet-header-regexp that takes the place of - w3-telnet-header-length. Addition of dvi, tex, and texinfo files to the - w3-mime-extensions list. -* w3.el: Few changes to w3-format-directory in case file-attributes - returns nil -* w3-emacs.el: w3-map-links will actually work in emacs 18 now. - -Fri Feb 25 23:17:51 1994 William M. Perry (wmperry@indiana.edu) -* w3-lemacs.el: Another dumb mistake in w3-zone-at -* w3-emacs.el, w3-emacs19.el, w3-lemacs.el, w3-old-lemacs.el, w3.el: Fixed - dumb mistakes in w3-zone-at and the newly rewritten commands -* w3.el: Fixed a few typos in w3-source-document -* w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-lemacs.el, w3-old-lemacs.el, - w3.el: Rewrote w3-load-delayed-images, w3-view-this-url, and - w3-follow-link to use the generic w3-zone-at/w3-zone-data functions, so - they won't have to be in the emacs-specific files anymore. Much easier - to maintain them this way. -* w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-lemacs.el, w3-old-lemacs.el, - w3.el: Removed all emacs-specific versions of w3-complete-link, and put - w3-complete-link into w3.el and have it use the new w3-map-links. - Easier to maintain. -* w3-emacs.el, w3-emacs19.el, w3-lemacs.el, w3-old-lemacs.el: New function - w3-map-links that calls a specified function on all the links in a - certain buffer. -* w3-mac.el: Basic support for Macintosh menus... wrote a function to use - the lucid style menu descriptions. -* w3-lemacs.el: Fixed problem with bad add-menu structure when the Options - menu already exists. - -Thu Feb 24 22:37:32 1994 William M. Perry (wmperry@indiana.edu) -* w3.texinfo: New chapter on future directions -* w3-epoch.el: Fixed epoch graphics handling so it won't get a buffer - read-only-error, and also won't always look in w3-working-buffer, in - case the buffer has been renamed by the time it gets called. -* w3.el: Renamed several functions so that it will be easier for new users - to do command completion (all hotlist stuff is w3-hotlist-XXX, etc). - Also several new functions to operate on the url the cursor is on - (w3-mail-document-under-point, w3-source-document-at-point, others). -* w3-vars.el: Changed lots of keybindings. General rule is now that - lowercase keys act on the current URL, and uppercase works on the url - under point. Major changes: - s -> document source, NOT SEARCH - M-s -> search document - p -> print document, NOT back link - Q -> w3-leave-buffer -* w3.el: Rewrote w3-store-in-cache so that it stores info on disk instead - of in memory - can have a larger cache this way and not use up all your - memory. -* w3-lemacs.el: New function w3-write-zones that creates lisp expressions - that restores extents when it is eval'd. - -Wed Feb 23 03:50:06 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: A few more changes to the wais code -* w3.el: More refinements to the WAIS code... now outputs URLs that are - like lynx/Mosaic, and also compatible with the WAIS gateway that NCSA - provides. - -Tue Feb 22 23:39:43 1994 William M. Perry (wmperry@indiana.edu) -* w3-old-lemacs.el: Fixed a few nesting errors in w3-view-this-url -* w3-emacs19.el: Few fixes to file-name-handler stuff -* w3.el: WAIS handling can now output an html document of a search. - Outputs the score and the file name. Also function to retrieve a - document given its doc-id. -* w3-emacs19.el: Patch for setting up the file-name-handler-alist from - jsc@mit.edu -* w3.el: New function to parse out the .mosaic-global-history file and - store it in an assoc list for use in completion. -* w3-mac.el: Initial revision -* w3.el: More changes to the wais handling code. -* w3-vars.el: New variable w3-waisq-prog that controls where the waisq - executable is looked for. -* w3.el: Small change to w3-convert-html-to-latex to have slightly better - stripping of unknown tags. - Skeleton of wais support - requires waisq from Thinking Machines Corp's - wais8-5b1. - -Mon Feb 21 17:36:25 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: New function w3-quotify-attributes to try and fix bad html docs. -* w3.el: Added a few changes to convert-html-to-latex to honor - w3-latex-docstyle, and also allows inlining of postscript images. - Thanks to benno@rainbow.ldgo.columbia.edu (Benno Blumenthal) for the - batches. - -* w3-vars.el: New variable w3-latex-docstyle that controls what - documentstyle a latex document has. Useful for going into two-column - mode or doublesided, etc. -* w3-lemacs.el: Changed w3-back-link to go to 1+ the extent start position - to get around (extent-at) bug -* w3-vars.el: Added www to the nonrelative link regular expression so that - links of that type will be parsed correctly. New variable - w3-current-source holds the HTML source of a document. -* w3.el: Most of the automatically generated html can now be referenced - with URLs like WWW://type/data. Errors are generated this way, and you - can get the source for things like hotlists, history lists, help items, - etc. - Now stores the complete source of a document in a buffer-local variable, - so printing/mailing HTML and/or LaTeX is _MUCH_ faster, as is getting - the documents source - never any need to refetch it. w3-reload-document - still does a fresh fetch though. -* w3-emacs.el: w3-next-zone and w3-previous-zone now skip 'w3graphic zones -* w3.el: Fixed small bug in re-insertion of SELECT menu items. Stuck too - many spaces at the end of it. -* w3-emacs.el: Make sure that x-popup-menu is bound before fset'ing - w3-x-popup-menu to it when in emacs 18 - -Fri Feb 18 02:50:42 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem in the textarea handling... misplaced a )... - -Thu Feb 17 19:38:50 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem with w3-quotify-percents and null arguments... -* w3-emacs.el, w3-emacs19.el, w3-lemacs.el, w3-old-lemacs.el, w3.el: Use - w3-quotify-percents in the (format ...) command in w3-view-this-url and - w3-view-url so that form queries don't mess up the format command` and - make it think it needs more arguments. -* w3-emacs.el: Use insert-before markes in emacs 18 -* w3.el: Append fill-prefix to the paragraph parsing code. - -Wed Feb 16 21:47:33 1994 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: Fixed dumb mistake in the setting up of - file-name-handler-alist... losing because of a misplaced ')'. Gotta - love lisp :) -* w3.el: Lots more file-ish type functions that will work with URLs. - w3-directory-p, real file-attributes, and stubs for more. -* w3-emacs19.el: Redid the file-name-handler functions. Stole - layout/ideas from the ange-ftp stuff from v19. -* w3.el: Will check if running on a mono display and do dithering if it - is. Fixed problem with <LINK> parsing where it would delete too many - chars. Fixed problem with queries in w3-form-encode... too many &'s - Few more NeXTstep changes. -* w3-lemacs.el: Lemacs menu's should no longer nuke people's Options menu - if it already exists. Will add a submenu called 'WWW' to the - already-existing menu. -* w3-emacs19.el: Added file-name-handler-alist support for emacs 19. - Works for find-file-other-window, find-file-other-screen, file-exists-p, - file-readable-p, file-executable-p, file-attributes, and - file-directory-p. -* w3.el: Added new functions w3-file-size and w3-file-exists. -* w3-emacs19.el: A few changes for NeXTstep emacs 19. Menus now work, - storing URLS into the kill ring/NeXT clipboard, and loading of lmenu if - in dps. Still no [x|dps]-popup-menu though. - -Tue Feb 15 03:42:45 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed w3-form-encode so that it actually returns the correct - query string if in a gopher or isindex form area... - -Mon Feb 14 19:12:31 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Multiline text area entry should now work in emacs 18 (put the - w3-do-text-entry outside of the save-excursion) -* w3.el: Make w3-prepare-buffer mark the buffer as not modified. -* w3-lemacs.el: Change w3-insert to insert-before-markers so that inlined - images will show up in the right place more often. - -Sat Feb 12 03:15:46 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed a read-only buffer problem when fetching images... -* w3-lemacs.el: New version of w3-track-mouse that doesn't need to move - (point) in the buffer... should be faster. - -Thu Feb 10 21:47:56 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Moved the image parsing until after everything else has been - parsed... this should fix everyones problems with inlined images - disappearing sometimes - they were attached to parts of the buffer that - was removed by other parsing routines. -* dist.Makefile: The making of w3.info now changes the setfilename - directive in w3.texinfo to point to INFODIR. -* w3-lemacs.el: Set end-open and start-open extent properties if setting - up a form. -* w3.el: Fixed a type in one of the mule/forms patches. -* w3-mule.el, w3-vars.el, w3.el: Miscellaneous fixes from Shin-ya Sato - <sato@mahler.NTT.JP> that make forms work much better in Mule. - -Wed Feb 9 23:37:11 1994 William M. Perry (wmperry@indiana.edu) -* w3-lemacs.el: Don't mess with graphic extents in w3-fix-extent-endpoints -* w3-epoch.el, w3-lemacs.el, w3-vars.el, w3.el: More error checking in the - image code -* w3.el: Fixed typo in w3-fetch-with-pgp... -* w3.el: Slightly more intelligent way of doing w3-form-encode. - -Mon Feb 7 03:31:17 1994 William M. Perry (wmperry@indiana.edu) -* w3.texinfo: miscellaneous fixes/grammatical fixups -* w3-epoch.el, w3-lemacs.el: Removed stupid message about possibly failing - to load an image because of the color map. - -Sun Feb 6 19:24:27 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Changed w3-default-homepage to be defvar'd to nil, so that - w3-do-setup will grab the WWW_HOME variable if it can. -* w3.texinfo: Fixed a few stupid bugs in @node structures that occurred - because I removed a node. -* w3.el: Fix entity references in <TITLE> of documents. - -Sat Feb 5 02:55:05 1994 William M. Perry (wmperry@indiana.edu) -* Version 2.0 released. -* w3.el: w3-public-key-exists will actually work now. -* w3.el: Moved the w3-handle-graphics call within the let binding of - w3-handle-base, so that inlined images will work with <BASE> tags. This - also fixes the problem of not being able to select the link an image is - covering with an ALT tag. -* w3.el: Renamed w3-lemacs-19.8 to w3-old-lemacs because of problems with - v18 byte compiler. - -Fri Feb 4 17:11:03 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Change w3-running-lemacs and w3-running-new-lucid to be - w3-running-old-lemacs and w3-running-lemacs, respectively. -* w3-epoch.el, w3-lemacs.el, w3-vars.el, w3.el: Revamped some of the - w3-insert-graphic code so the conversion functions can be shared between - epoch & lucid. Also added in code so that people with only XBM support - can use the inlined image code. -* w3.el: Added functions to grab the servers public key from finger - information if possible when using PGP and PEM encryption -* w3-html+.el: Much better table parsing routines - still not finished yet. - -Thu Feb 3 22:17:19 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Allow ~s in urls in w3-get-url-at-point -* w3.el: Moved just the variable definitions to an outside file to ease - byte-compiling. No longer loads whole w3.el just to get variable - definitions -* w3.el: Moved w3-load-flavors into w3-do-setup - -Wed Feb 2 22:41:48 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: w3-make-sequence now returns the sequence in ascending order. -* w3.el: Changed the nntp/flee handling in w3-nntp-stat-newsgroup so that - it won't hang indefinitely. -* w3.el: Made a few changes to the require functions so that mailcrypt and - nntp are not required until absolutely necessary. -* w3-hyperbole.el: New version from jsc@mit.edu -* w3-mule.el: Changed w3-grok-gopher-url to w3-grok-gopher-href -* w3-docomp.el, w3-new-lucid.el: More compiler warnings fixed - -Tue Feb 1 21:47:04 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed a few problems in w3-grok-http-href -* w3.el: Support for the <BASE> tag. New w3-grok-*-href functions that - can be used anywhere and return lists of server/port/file/etc. - -Mon Jan 31 22:32:52 1994 William M. Perry (wmperry@indiana.edu) -* w3-new-lucid.el: Fixed a free variable reference in w3-insert-graphics -* w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-lucid.el, w3-new-lucid.el, - w3-next.el, w3.el: Moved some version-specific stuff out of the - definition of w3-mode and into the function w3-mode-version-specifics in - the w3-*.el files. -* w3.el: Set w3-delimit-emphasis and w3-delimit-links to nil when doing - batch fetches. -* w3.el: Mailing and batch-fetching now insert a <BASE> tag if - sending/saving the raw HTML. -* w3.el: Fixed a few typos in w3-tn3270 -* w3-emacs19.el: Fixed a misplaced ( so that w3-follow-inlined-image works - in emacs19 -* w3.el: Added more descriptive function documentation to the autoloaded - functions. -* w3.el: New variable w3-use-transparent. If t, then it will use - transparent.el to do telnet/tn3270 links. This is automatically set to - nil if you are in lucid emacs, epoch, or in a windowing system. -* w3-mule.el: Added function w3-m2psbuffer that will print a buffer as - postscript in mule. -* Renamed w3.texi to w3.texinfo -* w3.el: Replaced <= with equal in case file size is nil... - -Sun Jan 30 18:40:16 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Added support for PGP and PEM encryption of requests. Requires - the excellent mailcrypt.el by Jin S Choi (jsc@mit.edu) -* w3.el: Added autoloads for 'gopher-dispatch-object and 'html-mode if - they didn't already exist. Also added a patch from Jamie Zawinski that - fixes the ###autoload statements used by autoload.el -* w3.texi: Now creates .info files just fine from makeinfo. - -Sat Jan 29 23:35:59 1994 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el, w3-epoch.el, w3-lucid.el, w3-new-lucid.el, w3.el: Added - an (fset 'w3-insert 'insert) to all but the epoch file, and used the - w3-insert written by Henry A. Rowley that will keep the zones intact. - Replaced all occurences of (insert) with (w3-insert) -* w3-epoch.el: Getting the resource for underlining should work now. -* w3.el: w3-add-document-to-hotlist now checks to see if the current - document is already in the hotlist. If it is, it signals an error. -* w3-new-lucid.el: Fixed problem in converting xbitmaps - left out a ' in - the sed command -* w3-epoch.el, w3-new-lucid.el, w3.el: Changed how the - w3-graphic-converter-alist is specified. Must now leave off the - ppmtoxpm command, and leave a stray '| ' at the en end of the - conversion. The contents of the variable w3-ppmtoxpm-command are - appended to this string. -* w3.el: Added a w3-convert-code-for-mule call in w3-sentinel if - w3-be-asynchronous is t. -* w3-new-lucid.el: Several changes suggested by Jamie Zawinski - (jwz@lucid.com) More errror checking for the image loading, and display - a buffer describing each error in a buffer after parsing the buffer. - Also, if the image load fails, put a 'w3graphic zone over the [alt] tag. -* w3.el: Several changes suggested by Jamie Zawinski (jwz@lucid.com) The - small extent made for graphics has the 'w3graphic property, so using - w3-follow-inlined-image on it will retrieve the full picture (for things - like lucid where it gets clipped to the line height). No longer shows - 'read 1 byte' messages - will only show a message when it has acually - received some info. -* w3.el: Removed assumption that /usr/lib/X11/rgb.txt exists when using - ppmtoxpm - -Fri Jan 28 13:39:11 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Applied patch from dliu@faraday-gw.njit.edu (Dong Liu) that fixed - a stupid problem with the w3-use-starting-points function. - -Wed Jan 26 23:36:02 1994 William M. Perry (wmperry@indiana.edu) -* w3-new-lucid.el: Changed w3-add-zone to always set end-open and - start-open - need more data for bug fixes. -* w3-new-lucid.el: Added patch from Alastair Burt <burt@dfki.uni-kl.de> to - fix not being able to get past graphic extents in 19.9 -* w3.el: The w3-nonrelative-link regexp now includes wais link types. -* w3-emacs.el: Added a patch from arup@cmu.edu that fixed yet another dumb - mistake on my part in the emacs 18 w3-follow-link function. -* w3.el: Basics of w3-pem-auth for the new httpd pgp/pem security -* w3.texi: Documentation mime-types parsing, and viewer specifications. -* w3.el: Viewers can now be lists, in which case it will be passed thru - 'eval'. - -Tue Jan 25 20:33:15 1994 William M. Perry (wmperry@indiana.edu) -* w3-emacs.el: Fix from arup@cmu.edu for a problem in w3-follow-link for - emacs 18 -* w3-new-lucid.el: The problem with coredumps with lots of empty links in - lemacs 19.9 should (hopefully) be fixed. -* w3.el: Added wais gateway support - not sure if it works, but I get the - same results as I do with Mosaic, so good enough. -* w3.el: Asynchronous retrieval over http works again. -* w3-new-lucid.el, w3-epoch.el: Made sure w3-insert-graphic retrieved - graphics synchronously. - -Mon Jan 24 23:30:40 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Added w3-use-starting-documents and w3-show-starting-documents - that display the contents of the hotlist-type w3-starting-documents - variable. -* w3.el: Added function w3-insert-formatted-url... inserts a formatted <A - HREF...></A> construct in a buffer. Url is the url of the current - buffer (or link under point with prefix arg), text of the link defaults - to the title of the buffer or the text of the link under cursor. Buffer - to insert into is prompted for. -* w3-emacs19.el, w3-epoch.el, w3-lucid.el, w3-new-lucid.el: Added function - w3-zone-at that returns the zone at the position passed to the function - (can be point or marker). -* w3.el: Changed the inlined images to have the highlight attribute if - possible. -* w3-emacs.el, w3-emacs19.el, w3-new-lucid.el, w3.el: Rewrote lots of - functions so that inlined images are stored in their own zone, and - control-middle-mouse-button or M-x w3-follow-inlined-image will fetch - the inlined image and send it to an external viewer. w3-follow-link will - also get an inlined image if it cannot find a hyperlink or a form entry - area under cursor. -* w3-emacs.el: Added w3-zone-eq for emacs 18 so that radio buttons will - work. -* w3.el: Changed w3-handle-graphics so that if w3-delay-image-loads is t, - use a marker instead of an absolute (point) reference. -* w3-new-lucid.el: Fixed a problem in the delayed image loading - would - always try to find w3-working-buffer, which would (should) not exist - when doing a delayed load. -* w3-new-lucid.el: Added missing interactive spec to - w3-load-delayed-images -* w3-new-lucid.el: Added function w3-load-delayed-images, and activated - the delay image load menu choice, added load delayed images menu choice. -* w3.el: A few changes to the gopher support - should recognize gopher - directories more reliably. -* dist.Makefile: Fixed distribution makefile to use the new system of 1 - large file. -* w3.el: Fixed problem with radio buttons - if more than one was set due - to bad use of the CHECKED argument, then it would not let you turn one - of them off. - -Sat Jan 22 12:36:28 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Fixed problem where unknown tags in a <PRE> or <XMP> segment were - getting nuked - bad when trying to show source code with < and > in them - - large chunks would disappear. Thanks to Magnus Y Alvestad - <magnus@ii.uib.no> for noticing the problem. - -Fri Jan 21 20:52:24 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Merged most of the files into one large one. -* w3.el: Parse out mime-types file if it exists at startup. -* w3-epoch.el: Changed epoch to use the class name Emacs instead of emacs. -* w3.texi: Fixed dumb mistake in documentation about w3-mode-hooks and - list indentation -* w3.el: Keep/restore tab-stop-list when going into w3-mode -* w3-new-lucid.el, w3-lucid.el, w3-emacs19.el: Renamed a few menu items, - and activated 'forward' and 'back' buttons. - -Thu Jan 20 23:27:31 1994 William M. Perry (wmperry@indiana.edu) -* w3-epoch.el: No longer remove numbers and periods from zones in - w3-fix-extent-endpoints -* dist.Makefile: Fixed the 'make install' target. - -Thu Jan 20 15:55:04 1994 William M. Perry (wmperry@indiana.edu) -* w3-parse.el: Did a bit of cleaning up in the parsing code - - obsolete/short functions removed or merged. - -Wed Jan 19 20:15:14 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Added version # of efs/ange-ftp to the bug report template. -* w3-new-lucid.el: Took out deletion of region when conversion of pixmaps - failed . . . don't need it in lucid -* w3-new-lucid.el: Put in quick hack to go to 1+ extent-start-position to - get around bug in lemacs 19.9 -* w3-new-lucid.el, w3-epoch.el: Changes to the graphics code to work with - the new w3-request-* variables -* w3-forms.el, w3-mime.el, w3-misc.el, w3-url.el, w3-vars.el: Using new - variables to control extra headers in MIME requests, as well as - specifying methods/data. - -Tue Jan 18 15:13:33 1994 William M. Perry (wmperry@indiana.edu) -* w3-mime.el: Changed mailcap parsing to strip out leading/trailing spaces -* w3-forms.el: Changed w3-form-encode to check if the query is empty - before doing a substring. Thanks to Michael Jankowski for noticing the - problem -* w3-forms.el: Applied patch from Michael Jankowski to fix a problem in - w3-finish-text-entry in emacs 19 - tried to change text properties in a - read-only buffer -* w3-misc.el, w3-mule.el, w3-url.el, w3-viewers.el: Miscellaneous patches - by Shin-ya Sato <sato@mahler.ntt.jp> for MULE support -* w3-lucid.el, w3-new-lucid.el: Removed reference to 'value' from - w3-x-popup-menu - might not always be bound. -* w3-url.el: Changed newsgroup handling yet again - can now work with - either Flee's nntp or the original nntp.el by Umeda. No longer - require's gnus. -* w3-new-lucid.el: Wrapped the make-pixmap call in a condition-case for - safety. -* w3-epoch.el: Changed w3-insert-graphic to insert a '^' to attach the - graphic to. -* w3-new-lucid.el: Changed w3-insert-graphic to create a larger extent - instead of using '^' - looks much better now. -* w3-parse.el: Changed w3-handle-graphics to not insert a '^' for each - graphic - leave that up to w3-insert-graphic if it needs it. - -Mon Jan 17 22:32:40 1994 William M. Perry (wmperry@indiana.edu) -* w3-vars.el: Added image/x-xbitmap to the list of graphics converters. -* w3-lists.el, w3-parse.el: Changed handling of <LI SRC> to only check if - w3-insert-graphic is defined, not hardcoded just for epoch. -* w3-url.el: Directory listings in local file and ftp access now have - icons. -* w3-epoch.el: Cacheing of images will now only store the image once, not - once for every time it is used. -* w3-new-lucid.el: Graphics work now - image/xbm's are translated into the - foreground and background color of the 'default face. -* w3-gopher.el: Gopher handling now spits out icons with appropriate ALT - refs. -* w3-epoch.el: w3-insert-graphic is now only defined if epoch was compiled - with graphic zone support. - -Sat Jan 15 20:20:59 1994 William M. Perry (wmperry@indiana.edu) -* w3-gopher.el: Added patch to w3-grok-gopher-link from Alastair Burt. - Also added support for gopher urls with searches embedded in them - (Mosaic-style searches with '?' instead of tab. -* w3.el: Added printing of whether you are in Mule, and the window system - andd window system version in w3-submit-bug. - -Fri Jan 14 22:37:42 1994 William M. Perry (wmperry@indiana.edu) -* w3-mime.el: Fixed authentication - was looking for the wrong header. - Also added support for using the URI: field instead of the Location: - field to get in sync with the latest HTTP/1.0 specification. -* w3-lists.el: Few more message->w3-lazy-message conversion - -Thu Jan 13 23:15:36 1994 William M. Perry (wmperry@indiana.edu) -* w3-gopher.el: Added patches to w3-gopher.el from Alastair Burt - <burt@dfki.uni-kl.de> that fixed a few problems. -* w3-mule.el, w3-url.el: Miscellaneous mule enhancements - -Wed Jan 12 19:41:05 1994 William M. Perry (wmperry@indiana.edu) -* w3-new-lucid.el: Fixed problem with my misunderstanding of the 'end-open - and 'start-open extent properties. -* w3-lucid.el, w3-new-lucid.el: Added patch by Alastair Burt - <burt@dfki.uni-kl.de> that changes w3-x-popup-menu to do a - completing-read if the last event was not a button/menu event. -* w3-viewers.el: Fixed w3-save-binary-file -* w3-mime.el: Changed w3-parse-mailcap to use new variable - w3-mime-mailcap-overrides. If t, then entries in the users mailcap file - will replace the defaults in w3-mime-viewers. -* w3-misc.el: Changed w3-upcase-region so that it will not touch entity - declarations either. - -Mon Jan 10 22:43:51 1994 William M. Perry (wmperry@indiana.edu) -* w3-parse.el: REL and REV attributes of links can now be comma-separated - lists. -* w3-parse.el: Fixed broken regular expression in <LINK> parsing -* w3-lists.el: Fixed problem of paragraphs within lists having the - highlighting stripped from the first character. -* w3-parse.el, w3-url.el: Changed most of the unimportant 'message's to - use w3-lazy-message instead. -* w3-url.el: Added variable w3-show-status. If nil, no messages will be - shown in the modeline showing where the current retrieval/parse is at. -* w3-parse.el: Added patch by Rainer Pruy - <Rainer.Pruy@informatik.uni-erlangen.de> that shows the SRC attribute of - IMG tags if no ALT tag is given. -* w3-emacs.el: Added mouse support for emacs 18 - -Sat Jan 8 20:32:46 1994 William M. Perry (wmperry@indiana.edu) -* w3-url.el: more support for bad HTTP: links -* w3-misc.el, w3-mule.el, w3-viewers.el: Applied a patch from Shin-ya Sato - <sato@mahler.ntt.jp> that keeps MULE from encoding binary data it - receives from subprocesses, etc. -* w3.el: Added tab-width to the list of variables saved in w3-mode. -* w3-gopher.el: CSO searching now works. -* w3-vars.el: Changed default value of w3-delimit-emphasis to take MULE - into account. -* w3-url.el: Added function w3-build-url that will build a URL in stages. - Not used anywhere yet. Thanks to T.V. Raman for suggesting it. -* w3-gopher.el: Fixed gopher support for using gateways. Won't give - errors at top and bottom of buffer. -* w3-misc.el: Changed w3-hexify-string so that it won't hex slashes in the - string. -* w3.el: Another check for efs-auto added - -Fri Jan 7 23:53:19 1994 William M. Perry (wmperry@indiana.edu) -* w3.el: Changed checking of efs/ange-ftp to also check for efs-auto - before loading ange-ftp. -* w3-emacs19.el, w3-lucid.el, w3-new-lucid.el: Changed menu handling to - ignore links with nil HREFs when making the 'links...' menu. -* w3-gopher.el: Changed w3-convert-ask-to-form for better handling of - SELECT boxes that have no choices. -* w3.el: Added w3-leave-buffer. Does a bury-buffer on the current buffer - instead of killing it. -* w3-mime.el: Fixed problem where using telnet in a subprocess would chop - off lots of front of incoming data. Bad kill-line in - w3-is-mime-response. -* w3-misc.el, w3-url.el, w3-viewers.el: Changed all yes-or-no-p/y-or-n-p - functions to use the function specified by w3-confirmation-func - -Thu Jan 6 23:58:37 1994 William M. Perry (wmperry@indiana.edu) -* w3-gopher.el: Changed gopher parsing routines to print the type of the - link in the listing. The text describing the link is configurable by - the variable w3-gopher-labels. -* w3-gopher.el: More tweaks for more mosaic-like behavior -* w3-parse.el: Searchable gopher objects no longer become inlined forms - - selecting them creates the form, as in Mosaic. -* w3-gopher.el, w3-url.el: Switched gopher handling to use Mosaic's type - of double-typing. This makes it much easier to get searching done right - (whether it needs a 7/ or not, etc). - -Wed Jan 5 14:15:02 1994 William M. Perry (wmperry@indiana.edu) -* w3-typecheck.el: Use new variable w3-passwd-entry-func instead of - hard-coding ange-ftp-read-passwd. -* w3.el: Reworked some of w3-do-setup, and added comments -* w3.el: Changed to only require 'ange-ftp if not using efs. -* w3-lists.el: Did some work on the DL handling -* w3-url.el: Directory formatting routine will now include last file - modification date and size if possible. If not date data is returned by - file-attributes, or current-time-string does not take a parameter, then - no date is shown. Size is usually shown (almost always if you use EFS - instead of ange-ftp) -* w3.texi: Round and round he texinfo's, where he stops, noone knows. - -Tue Jan 4 23:00:35 1994 William M. Perry (wmperry@indiana.edu) -* w3-gopher.el: Fixed problem in handling of gopher text files . . . were - always being parsed as HTML. -* w3-forms.el: Fixed dumb problem in encoding a gopher+ ASK form. -* w3.texi: Initial revision - -Mon Jan 3 19:06:17 1994 William M. Perry (wmperry@indiana.edu) -* All files: Updated copyright notices -* w3-lists.el: UL and OL lists can now have <LI ALT="some text" SRC="some - image"> -* w3-misc.el: Renamed w3-rassq-with-equal to w3-rassoc -* w3-emacs.el, w3-emacs19.el: Fixed stupid problem where I was trying to - call the x-store-cut-buffer function even if not in X - -Sun Jan 2 22:47:02 1994 William M. Perry (wmperry@indiana.edu) -* w3-misc.el: Added a function to break up a menu description into smaller - chunks and submenus. -* w3-gopher.el: Now smarter about when to parse out a gopher object as a - directory listing -* w3-emacs19.el, w3-lucid.el, w3-new-lucid.el, w3-emacs.el, w3-epoch.el: - Added function w3-store-in-x-clipboard -* w3.el: w3-save-url will now copy the url into the X clipboard -* w3.el: Added autoloads that autoload.el can understand. -* w3-forms.el: Forms links will now highlight when the mouse moves over - them in lucid emacs (and any other flavor that eventually supports them - in its version of w3-add-zone) -* w3-gopher.el: Fixed dumb problem where parts of the gopher+ selector - string were being left in w3-current-file, so things like w3-view-url, - etc were getting the wrong information. -* w3-gopher.el: Fixed stupid problem where I didn't convert the gopher - selector strings into url encoding before creating the <A> tags in - w3-format-gopher-link. This caused gopher links with spaces/tabs/etc to - not be parsed correctly. Thanks to John Ladwig <jladwig@soils.umn.edu> - for noticing the problem. - -Sat Jan 1 20:08:19 1994 William M. Perry (wmperry@indiana.edu) -* w3-parse.el: Added support for showing some of the HTTP/1.0 headers in a - buffer. Controlled by the new variable w3-show-headers. Should be a - list of HTTP/1.0 headers (all lowercase) to include at the end of the - buffer. If nil, nothing will be shown. Thanks to Jared Rhine for - suggesting it. -* w3-gopher.el: Removed multiple definitions of w3-parse-gopher, and - revamped the handling of gopher titles. -* w3-misc.el: Changed w3-batch-fetch to be more robust - is now able to - retrieve any type of information, and the user can specify whether they - want formatted text, raw HTML, or transfer in binary mode. -* w3-parse.el: Changed the fill-column and <HR> calculation routines to - honor the new variable w3-strict-width. -* w3-misc.el: Removed some useless variables from w3-get-url-at-point in - the eternal quest for less compilation warnings. -* w3-misc.el: Fixed problem in w3-strip-leading-spaces and - w3-eat-trailing-space -* w3-parse.el: The link building code will now remove all entity - references in the link text before storing it in the zone - this means - that the menu building code and w3-complete-link will no longer have - unresolved entities in them looking nasty. -* w3-misc.el: Added function w3-fix-entities-in-string. Takes any string - and removes all entity references within it, and replaces it with normal - text (uses the w3-html-entities assoc list). -* w3-new-lucid.el, w3-lucid.el: Added function w3-x-popup-dialog - -Fri Dec 31 21:45:04 1993 William M. Perry (wmperry@indiana.edu) -* w3-new-lucid.el, w3-lucid.el: Fixed problem in w3-fix-extent-endpoints -* w3-misc.el: Fixed problem in w3-eat-trailing-space that would always - remove one too many spaces. -* w3-mosaic.el: Added function w3-rename-hotlist-entry to give a new title - to an item in your hotlist. Will not let you use a title that is - already a member of the hotlist. -* w3-emacs19.el, w3-lucid.el, w3-new-lucid.el: Added a few options to the - navigation menu -* w3-url.el: Added a patch from Fran Litterio <franl@centerline.com> that - adds variable w3-reuse-buffers. Also changed the buffer reusing code - will skip over w3-working-buffer in its search for a matching url. -* w3-url.el: Fixed problem in passing things off to gopher-mode with blank - selector strings - was not defining a good type (type was set to 0 - instead of ?1). -* w3-url.el: Fixed typo in gopher handling -* w3-gopher.el: Added % retrieved messages when retrieving a gopher+ - object, fixed problem in gopher parsing for emacs 19. - -Thu Dec 30 23:58:19 1993 William M. Perry (wmperry@indiana.edu) -* w3-gopher.el: Fixed dumb problem in gopher formatting - didn't check if - the selector string was longer than 1 character before trying to extract - the first char. -* w3-misc.el: Fixed major problems with w3-strip-leading-spaces and - w3-eat-trailing-space again. -* w3-forms.el: Added support for submitting gopher+ ASK blocks -* w3-url.el: Changed gopher support/url parsing routines to handle gopher+ - and gopher ASK blocks without warping the URLs too much. -* w3-gopher.el: Added in gopher+ support -* w3.el: Fixed viewing of gopher links for new storage format. -* w3-gopher.el, w3-url.el: Revamping gopher -* w3-vars.el: Added variable w3-gopher-to-mime -* w3-vars.el: Added variable w3-gopher-types - -Thu Dec 30 13:57:53 1993 William M. Perry (wmperry@indiana.edu) -* Added support for Mule (Multi-Lingual Emacs), mainly highlighting of - links. Thanks to takada@seraph.ntt.jp for the patches. -* w3-next.el: Added provide 'w3-next -* w3-parse.el: Might have fixed the over-run into other words/spaces - in link highlighting. - -Wed Dec 29 23:33:07 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el: Added function w3-fetch-url-at-point... thanks to Torre - J. Wenaus <wenaus@gem1.llnl.gov> for the code. -* w3-parse.el: Back to using window-width as starting point for - w3-right-border. -* w3-vars.el: Removed variable w3-hypertext-extns -* w3-mosaic.el: Removed support for adding old gopher-mode pages to - the hotlist. Trying to get people to use hypertext-gopher-mode. -* w3-next.el: Initial revision -* w3-gopher+.el: Added new function w3-convert-ask-to-form that - converts a Gopher+ ASK block into an HTML form. -* w3-forms.el: Value and default value are now reset for each SELECT - area in forms. -* w3-vars.el: Changed default gopher handling to be in hypertext. - -Tue Dec 28 17:41:51 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: Can now handle http:/somefile - it will substitute the - server and port of the current document to make a complete url. -* w3-forms.el: Names in INPUT tags can be empty -* w3-auth.el, w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-forms.el, - w3-lists.el, w3-mime.el, w3-misc.el, w3-parse.el, w3-typecheck.el, - w3-url.el, w3-vars.el, w3.el: Removed lots of references to bound - but unreferenced variables. -* w3-misc.el, w3-url.el, w3-vars.el, w3.el: Added new variables - w3-mail-command and w3-mail-other-window-command. These variables - will control what functions are called when w3 needs to send mail. - W3 tries w3-mail-other-window-command only if w3-mutable-windows is - t, then w3-mail-command if this function is not bound. Then goes to - mail-other-window, then just to mail. - -Fri Dec 24 03:21:58 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: Formatting directories now gives a progress indicator in - % of files converted to hypertext listing. -* w3-url.el: Added code to check for whether a file is a symbolic - link. If it is, then put in an arrow and the name of the link (like - ls -l). - -Thu Dec 23 18:53:54 1993 William M. Perry (wmperry@indiana.edu) -* w3-epoch.el, w3-misc.el, w3-parse.el, w3-typecheck.el, w3-vars.el: - Replaced long regular expressions for checking whether a URL is - relative or not with a variable w3-nonrelative-link to save - space/typing, and it will be easier to change in the future. -* w3-misc.el: Added function w3-batch-fetch to retrieve all the urls - passed to it on the command line and save them as text files. - Thanks to Jared Rhine for suggesting it. -* w3-parse.el: Removed use of screen-width/window-width when computing - fill column. Uses old value of fill-column. -* w3-mosaic.el: Fixed problem in new personal annotation parsing code - that would barf if you didn't have any personal annotations. - -Thu Dec 23 16:28:22 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el: Made lots of changes to the personal annotation - handling. Deletion will work properly now (won't mess up the - internal representation of the annotations), support for the real - Mosaic annotation format (more than one annotation on a url yields - only one line in the annotation LOG file), figures out the highest - annotation number instead of using the last line in the file +1. -* w3-emacs.el: Added definition of w3-create-faces. -* w3-gopher+.el: Initial revision -* w3-gopher.el: Fixed quite a few problems with gopher support. - -Tue Dec 21 06:47:50 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el: Fixed idiotic problem where no PRE segments were being - rendered. *sigh* - -Sat Dec 18 15:03:59 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el, w3-gopher.el, w3-forms.el: Added support for searching in - gopher. Transforms into a special type of form, like <ISINDEX> - tags. Only works if retrieved from a gopher listing right now. -* w3-vars.el: Changed default viewer for text/plain to be w3-mode -* w3-parse.el: Fixed problem with recursive filling of paragraphs - if - there were too many <PRE> segments, then it would die from recursing - too much. Thanks to Tom Tromey <tromey@busco.lanl.gov> for pointing - out the problem. - -Fri Dec 17 23:01:57 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: Changed the display of XX of YY bytes transferred in - HTTP/1.0 responses to be optional. Would mess some people up that - are behind gateways using telnet, etc. Variable is - w3-show-http2-transfer. -* w3-lists.el: Added support for <LI SRC="blahblahblah"> for list - items with icons, etc. -* w3-epoch.el: Rewrote the resource fetching routines to me - consistent with emacs 19 and lucid emacs. -* w3-lucid.el, w3-emacs19.el, w3-epoch.el, w3-new-lucid.el: Moved all - face creation stuff into w3-create-faces. -* w3-vars.el: Fixed typo in w3-graphic-converter-alist -* w3-vars.el: Added keybindings > & < to go to end/beginning of - document. Added functions w3-end-of-document and - w3-start-of-document to go the end and beginning of a document - respectively. -* w3-forms.el: Fixed a problem in the new text area support. -* w3-forms.el, w3-typecheck.el: Reworked quite a bit of stuff to get - forms submissions working correctly. You no longer have to keep - buffers around until you submit the form, and the default text (or - the current value of the button) is inserted each time you edit the - form area. -* w3-mime.el: Changed w3-parse-mime-viewers to split the Accept: - string onto one or more lines as appropriate, as the NCSA server - doesn't seem to like the long Accept: line when POSTing a form. -* w3.el: Merged in support for NeXT emacs from Laurent Dami - <dami@cui.unige.ch> (emacs 18.58 on NeXTstep) -* w3-emacs.el, w3-emacs19.el, w3-epoch.el, w3-lucid.el, - w3-new-lucid.el: Added function w3-setup-version-specifics that will - do any required fiddling for each version of emacs. - -Thu Dec 16 23:22:08 1993 William M. Perry (wmperry@indiana.edu) -* w3-new-lucid.el: Fixed problem with w3-fix-extent-endpoints failing - when an extent was completey spaces/newlines -* w3-forms.el: Changed regular expressions to allow one or more = - signs in name/value tags. -* w3-forms.el: Made input tags with NAME of isindex do an automatic - submission, ala Mosaic, and marca@ncsa.uiuc.edu's suggestion on - www-talk that browsers should standardize on this hack. -* w3-parse.el: Changed form-based searching to use an input tag of - NAME isindex like Mosaic. -* w3-parse.el: Fixed error in new header routines. Would bomb if a - header was not terminated correctly. -* w3-parse.el: No longer remove tabs at the beginning of the buffer - - was messing up lists. Still removes spaces/newlines -* w3-forms.el, w3-parse.el: Added real support for TEXTAREA tags, and - wrap TEXTAREA input tags in PRE segments. -* w3-forms.el: Fixed bad regular expression in forms mode that would - cause tags with VALUE="" to be drawn wrong. -* w3-newparse.el, w3-url.el: Use new function w3-lazy-message instead - of message. Will not update the modeline if called more than once a - second. Thanks to Jamie Zawinski <jwz@lucid.com> for the patches. -* w3-viewers.el: Starting viewers no longer starts an interactive - shell & exec. Thanks to Jamie Zawinski for showing me that it was a - dumb thing to do :) -* w3-new-lucid.el: Initial revision -* w3-vars.el, w3.el, w3-lists.el: Changed occurences of w3-running-era - to w3-running-new-lucid -* w3.el: Moved creation of w3-mime-accept-string into w3-do-setup -* w3-epoch.el: Fixed problem in epoch form entry. -* w3-forms.el: Changed assignment to free variable method in w3-handle-forms. -* w3-forms.el: Fixed the revert button bugs in emacs 19. -* w3-emacs19.el: changed w3-delete-zone to use remove-text-properties - instead of putting nil text properties. -* w3-emacs19.el: Changed w3-delete-zone to remove the face and - mouse-face properties. - -Wed Dec 15 22:56:43 1993 William M. Perry (wmperry@indiana.edu) -* w3-lists.el: Added a 't' to calls to replace-match so that the case - is preserved. -* w3-vars.el: Added variable w3-list-chars-assoc for specifying what - characters to insert at the front of lists. -* w3-lists.el: Can now control what characters are inserted at the - front of a list. See w3-list-chars-assoc for details. - -Wed Dec 15 20:41:02 1993 William M. Perry (wmperry@indiana.edu) -* Version 1.7.14 -* w3-forms.el: Fixed problem with resetting popdown menus to the - defaults. -* w3-epoch.el: Rewrote w3-fix-extent-endpoints to remove - newlines/whitespace from front of zones also, as well as numbers & - periods. This will fix lists, but might mess up real links once in a - while. Oh well, epoch won't be around much longer anyway. -* w3-mosaic.el: Fixed bug in w3-write-global-history where 'nil' in - the history would cause it to choke. Thanks to franl@centerline.com - for noticing the problem. -* w3-emacs.el: Changed the w3-fix-extent-endpoints to remove - newlines/whitespace from the front of zones also. -* w3-lists.el: Changed the list handling code to use - insert-before-markers if using emacs 18. This keeps the - indentation/numbering to not become part of the zones. -* w3-emacs19.el: Fixed a few errors with the new forms/link movement - code -* w3-emacs19.el: Changed w3-follow-link to not die on links with no - data. -* w3-emacs19.el: Changed w3-forward-link and w3-back-link to honor - forms entry areas. -* w3-vars.el: Changed definition of w3-header-char-assoc to use BR correctly -* w3-parse.el: <BR> tags are rendered a little better now - no extra - spaces from the fill-region will make them look odd. - -Tue Dec 14 21:41:29 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: Added checking to w3-fetch to see if a buffer visiting a - URL already exists before fetching it. Offers to reuse the old one if - found. -* w3.el: Changed w3-save-url to be more consistent with the other - commands that muck with URLs. C-k grabs the current URL into the kill - ring, and C-k with a prefix arg grabs the URL under pt into the kill - ring. Thanks to Jared Rhine for pointing out the inconsistency. -* w3-mosaic.el: Added function w3-append-hotlist. This will append a - hotlist to the one currently in memory. -* w3-parse.el: Fixed problem where <P> breaks after a header item were - not being erased. -* w3-misc.el: Added function w3-upcase-region that will convert a - region of text to uppercase, but ignore any text in it that is between - < and >. This will stop it from changing the links references within - <A> tags. -* w3-vars.el: Changed the header assoc list to use w3-upcase-region - instead of upcase region. Was causing links in headers to point to - the wrong files. -* w3-era.el, w3-lucid.el: Added patch from Alastair Burt that fixes a - few problems in the lucid menu handling code (malformed, plus trims - the menu items to w3-lucid-max-item-size so that they don't shoot off - the sides of your screen. -* w3-url.el: Added a space at the end of the prompt in w3-open-local -* w3.el: Changed w3-reload-document so that it remembers where you - were in the buffer and repositions you there. -* w3-mime.el: Changed the format of w3-mime-accept-string so that it - can be used in other places. -* w3-misc.el: Added functions w3-forward-in-history and - w3-backward-in-history. This will first try to find the actual buffer - recorded in the history list, then any buffer with the same URL, then - goes to point in those buffers. -* w3-vars.el: Added new variable w3-current-next-link and - w3-current-last-link that are buffer-local. These store the history - information for this buffer. -* w3.el: Changed a few functions to use the new history mechanism -* w3-url.el: Modified w3-fetch to store history items in the new - variables - -Mon Dec 13 23:39:20 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs.el: Finished function w3-fix-extent-endpoints, but need to - do something about the markers moving in front of list items. - w3-fix-extent-startpoints or something similar. -* w3-lucid.el: Added missing function 'w3-delete-zone Fixed menu - generation error -* w3-misc.el: Changed w3-maybe-relative and a few other functions to - take an optional 'DATA' parameter for using the POST command,etc. -* w3-forms.el: Fixed a few problems with non-POSTing forms submissions -* w3-parse.el: Removed code to eat newlines/whitespace at the - beginning/end of links. Was causing errors if links were within PRE - segmens (actually, only if a link was the last thing in a PRE segment, - and it had whitespace after it, and before the </PRE> -* w3-forms.el: Fixed problem with forms <SELECTION MULTIPLE> support. - Wasn't giving the fake checkboxes any 'value's, so it was reported as - 'ON' to the server, not the name of what was selected. Also fixed a - problem where the option variable in SELECTION handling wasn't being - set to nil each time, so each successive SELECTION tag would get more - and more choices. -* w3-parse.el: Added call to function w3-fix-extent-endpoints. Should - fix the problem with forms eating newlines/spaces at the end of form - entry areas when new data is entere. -* w3-forms.el: Fixed problem in forms submission. Would die if the - first item in a form was a SELECTION - it was not storing the - method/actionurl if it was. - -Sun Dec 12 20:54:44 1993 William M. Perry (wmperry@indiana.edu) -* w3-epoch.el: Added function w3-fix-extent-endpoints -* w3-emacs.el, w3-emacs19.el, w3-era.el, w3-lucid.el: Added new - function w3-fix-extent-endpoints. Makes extents smaller if they have - newlines/whitespace at the end. This will keep the forms support from - killing newlines whenever you do a form entry. -* w3-cache.el: Added code to store stuff in cache as compressed - (gzipped) data. -* w3-url.el: HTTP links like http://cs.indiana.edu are now recognized - (no longer needs the trailing '/' -* w3-lists.el: Fixed problem where alternating <P> tags would - disappear within lists. Over-aggressive regular expression. -* w3-url.el: Changed the handling of content-length - using - w3-parse-mime-headers was causing an infinite loop in redirection. -* w3-mime.el: Fixed a few problems in the redirection handling because - of switching to lower-case headers in w3-current-mime-headers. -* w3-url.el: Added support for using the content-length header in - HTTP/1.0 responses to show how big the file is in the minibuffer. -* w3-mime.el: Changed the MIME parsing routines to save the header - fields in lowercase. -* w3-emacs.el: Fixed dumb problem in w3-complete-link for emacs 18. - Left out a call to w3-zone-data. -* w3-url.el, w3-forms.el: Replaced use of member with w3-member. -* w3-forms.el: Fixed error in regular expression where buttons with - spaces in their VALUE fields would not be rendered. -* w3-viewers.el: New way to specify whether to view process output or - not. w3-working-buffer is always destroyed if a viewer is invoked. -* w3-vars.el: Added variable w3-always-show-output. -* w3-vars.el: Changed def. of ÿ to be ?\377 instead of the actual - character 377. Was causing problems with CVS. -* w3-parse.el: Whitespace at the beginning of buffers will now be - erased. Headers will now be a little more intelligent about how they - do line/paragraph breaks. Headers can now be shown on text terminals - by the variable w3-header-chars-assoc. Thanks to Jared Rhine for the - suggestion. -* w3-parse.el: Added support for user-customizable text before and - after headers -* w3-misc.el: Changed w3-eat-trailing-spaces and - w3-strip-leading-spaces to get ride of newlines too. -* w3-vars.el: Added the variable w3-header-chars-assoc to have - formatting of headers on dumb terminals. - -Fri Dec 10 21:14:07 1993 William M. Perry (wmperry@indiana.edu) -* w3-lists.el: Fixed bug where lowercase list tags (ol instead of OL) - would cause an infinite loop if there were within another list. Left - out an (upcase (..)) - -Thu Dec 9 23:24:10 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el: Changed the handling of MULITPLE selections in option - lists to be a <UL> of the options, all checkboxes with the same name. - -Wed Dec 8 22:46:07 1993 William M. Perry (wmperry@indiana.edu) -* w3-lists.el: Fixed a bug where PRE segments within lists would be - ignored and filled. -* w3-forms.el: Added support for the SEVERAL/MULTIPLE attribute on the - SELECT input tag. Rendered as a preformatted list of checkboxes. -* w3-misc.el: Added function w3-eat-trailing-space -* w3-mime.el: Fixed a dumb problem where I forgot a "%s" in a format - string and so wasn't sending any data during a POST forms submission -* w3-forms.el: Added support for POST submission of forms -* w3-mime.el: Added a 'data' field to the w3-create-mime-request - function. This will make it easy to implement post in a more - generalized way later. -* w3-url.el: Added ability to send arbitrary data down through - w3-fetch, w3-retrieve, and w3-http. Useful for POST method. -* w3-emacs19.el: Removed patch for double-skipping of links in early - versions of emacs. People using < 19.21 should upgrade. -* w3-lists.el: Nested lists should now be a little quicker. Also - fixed the problem where paragraphs within lists would have an extra - space at the beginning of the first line. -* w3-forms.el: Changed w3-do-form-entry to do w3-delete-zone before - deleting the text contained by the zone. Previous behavior would make - emacs19 bomb with an error. -* w3-typecheck.el: Changed the option reading so that it checks - whether w3-x-popup-menu returns a cons pair or a plain string and acts - accordingly. -* w3-docomp.el: Added lots of autoloads to get rid of compilation errors -* w3-mime.el: Changed the header parsing to get _ALL_ the headers and - store them in an assoc list instead of just getting the 3 or 4 I need - now. Will make it easier to expand on later when the HTTP/1.0 spec - grows. -* w3-vars.el: New variable w3-current-mime-headers, which is an assoc - list of MIME headers for each document. -* w3-url.el: Changed w3-retrieve so that if a response it not an - HTTP/1.0 response, add its name to w3-bad-server-list if it is not - already a 'member'. -* w3-mime.el: Added support for the new '204 NoResponse' HTTP/1.0 - response. No new document is displayed. - -Tue Dec 7 21:09:21 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el: Some revisions to try and make the radio button - toggling faster. Will now only change the radio button(s) that are - set to be off, and the one that is supposed to be on, on. -* w3-lucid.el, w3-epoch.el, w3-era.el, w3-emacs19.el: Added function - w3-zone-eq -* w3-era.el: Fixed typo in w3-zone-data that was causing forms to - screw up. -* w3-forms.el, w3-newparse.el: Use 'intern' instead of read -* w3-emacs19.el: Removed the local-map from the text properties. Put - it in the distribution by mistake. -* w3-emacs19.el: applied patch from <michalj@fuw.edu.pl> to fix - skipping 2 links when going backwards. -* w3-html+.el: Fixed a missing ) or two -* w3-cache.el: Initial revision -* w3-vars.el: Added variables for document caching. -* w3-html+.el: Trying to get tables working better - -Mon Dec 6 23:04:01 1993 William M. Perry (wmperry@indiana.edu) -* w3-era.el: Fixed dumb error where w3-follow-link would try to fetch - the text of the link, not the url of the link. -* w3-emacs19.el: Fixed a few things with the new text properties - support. -* w3-forms.el: Removed reference to free variable prompt in - w3-do-form-entry. Cut & pasted a few too many lines. -* w3-forms.el: Changed all the form handling routines that reformatted - the buffer to use w3-form-format-<input-tag-type> instead of reusing - the code. Was causing some inconsistent redraws. Thanks to Arup - Mukherjee <arup@cs.cmu.edu> for noticing the problem. -* w3-parse.el: Styles will now work again in epoch. Needed to - re-apply a patch that got lost in a hard drive crash. Thanks to Henry - A. Rowley <har@cs.cmu.edu> for the patch. -* w3-emacs19.el: Fixed problem in the making of menus. Had a (list - ...) that included the 'displayable' option in the menu vectors. - Thanks to Jorge Sousa Pinto <mesjsp@di.uminho.pt> for noticing the - problem. -* w3-emacs19.el: Fixed a cut&paste error - multiply defined functions - and a lot of typos in w3-complete-link -* w3-misc.el: Added function w3-strip-leading-spaces -* w3-era.el: Changed the w3-complete-link routine to strip spaces from - the front of links so that all of them will be visible. -* w3-lucid.el, w3-epoch.el, w3-emacs19.el, w3-emacs.el: Changed the - w3-complete-link routine to strip spaces from the front of links so - that all of them will be visible. -* w3-vars.el: A few revisions to the default settings of - w3-style-chars-assoc -* w3-vars.el: Added the variables w3-style-chars-assoc and - w3-delimit-emphasis for doing text-based markup. -* w3-parse.el: Added the ability to have characters that define the - start and end of a region of formatting (ie: * surrounds bold text, _ - surrounds underlined text, etc). Controlled by w3-style-chars-assoc - and w3-delimit-emphasis variables. Thanks to Jared Rhine for - suggesting it. - -Sun Dec 5 21:38:23 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: fixed typo in w3-open-local-internal. -* w3-url.el: Disabled use of w3-be-asynchronous for now -* w3-era.el: Enabling/disabling of Era menus now cleaner than in lucid -* w3.el: Menus will now be created when running in Era -* w3-vars.el: Added face-specific stuff for Era, and modified the - default value of w3-delimit-links to take the w3-running-era variable - into account. -* w3-vars.el: Better checking of the various w3-running-* variables. - I long for the day when they will all merge. :) -* w3-era.el: Added support for 'viewing' a form entry area with - w3-view-this-url Will message the name and type of the form entry - area, but returns nil if called with no-show 't'. -* w3-era.el: More changes to be era-specific -* w3-era.el: Basic switch to era-specific functions from the lucid - cust. file -* w3-epoch.el: Added alias w3-delete-zone (to epoch::delete-zone) -* w3-emacs19.el: Added function w3-delete-zone -* w3-forms.el: Use function w3-delete-zone instead of a large (cond - (...)) for using delete-zone, etc. Easier to add support for new - flavors of emacs. -* w3-vars.el: Added the variable w3-running-era -* w3.el: Added loading of specific routines for 'era' - the - epoch/lucid merge -* w3-era.el: Initial revision -* w3-emacs19.el: Fixed a problem in w3-only-links that would return - the wrong position if the link was only one character long. -* w3-misc.el: Added the function w3-reload-all-files. This will - remove all the 'features' 'provided by w3, and then do a (require 'w3) - so that the files will all be reloaded. -* w3-mime.el: Changed the w3-is-mime-response function so that it will - remove the HTTP/1.0 request if it has been echoed to the screen, - either by telnet or by the tcp.el emulation package. Thanks to - everyone who reported the bug. -* w3-parse.el: Moved handling of telnet header lines into - w3-is-mime-response -* w3-emacs19.el: Believe I have fixed the w3-complete-links to work - with the new use of text properties instead of overlays. This should - fix the problem of the links menu not showing up in X also. Thanks to - T V Raman <raman@cs.cornell.edu> for noticing it was broken. -* w3-mime.el: Framework for '204 No Response' put in -* w3-auth.el: Removed function w3-encode-password, and put the code - into the actual w3-basic-auth, since future versions will probably use - different encodings for the username/password pair. - -Sat Dec 4 12:54:43 1993 William M. Perry (wmperry@monolith) -* w3-forms.el (w3-handle-selections): Added <OPTION SELECTED> support. - Thanks to Darrell Kindred for telling me to do it. -* w3-mime.el (w3-parse-mime-headers): Fixed a problem where redirection of - URLS would lose the content-type and other headers of the URL it was - redirected to. Thanks to Jared Rhine for noticing the problem. -* w3-forms.el (w3-do-form-entry): Fixed a problem where form submission - buffers would not stay on top of the buffer stack. Moved the submit - code outside the save-excursion. Thanks to Darrell Kindred for the - suggestion on how to fix it. -* w3-lists.el (w3-fill-paragraphs-in-list): Dumb problem with too many - newlines in paragraphs within lists. Thanks to Jared Rhine for noticing - the problem. -* w3-parse.el (w3-fix-paragraphs): Fixed a problem where paragraphs before - the last <HR> in a buffer were not filled. Thanks to Jared Rhine and - Darrell Kindred for fixes. -* w3-typecheck.el (w3-read-correct-format): Added a default type checker - for unknown tag types. -* w3-emacs19.el (w3-follow-link): This no longer signals an error if there - is no link under point. -* w3-mime.el (w3-parse-mime-headers): Changed the regexp to extract the - Location header from an HTTP/1.0 response so that newlines are stripped - from it correctly. Thanks to Darrell Kindred for sending me the patch. -* w3-misc.el (w3-open-stream): Added a pause in when connections failed. - Thanks to Jost Krieger <Jost.Krieger@rz.ruhr-uni-bochum.de> for - suggesting it. -* w3-emacs.el (w3-add-zone): Fixed a problem in normal emacs where - highlighted text <CODE>TEXT</CODE> would be interpreted as a link. - Thanks to T V Raman <raman@cs.cornell.edu> for noticing the problem. -* w3-vars.el (w3-mime-extensions): Changed the default MIME content type - to be text/html so that pages like http://cs.indiana.edu/ will be - formatted when they don't have a file extension. -* w3-forms.el: Applied a path from Darrell Kindred that fixed some very - odd radio button behavior. -* w3-forms.el: Believe I have fixed the problem in lucid emacs where - choosing a form entry box would eat the character immediately after the - input tag. -* w3-forms.el: Fixed a regexp that would gobble newlines/paragraph breaks - after an input tag. Thanks to Skip Montanaro - <montanaro@ausable.crd.ge.com> for noticing the problem. -* w3-lists.el: Dumb error in a regexp that would make all <DL> lists - disappear was fixed. -* w3-lists.el: Added roman numeral handing to ordered lists. Thanks to - Tom Loos (tloos@indiana.edu) for explaining the algorithm and writing - some C code I could translate into lisp. - -Fri Dec 3 12:04:18 1993 William M. Perry (wmperry@indiana.edu) -* w3-lucid.el: Fixed stupid problem where going backwards by 1 link always - took you to the first link of a buffer. Mispaced ) in - w3-previous-extent. -* w3-emacs19.el: Changed everything to use text-properties instead of - overlays. -* w3-emacs19.el (w3-add-zone): Added preliminary support for just typing - into the emacs19 forms. Will talk to jwz about adding this - functionality to lucid emacs. - -Wed Dec 1 08:05:02 1993 William M. Perry (wmperry@indiana.edu) -* w3-newparse.el: Created this file - has new parsing routines. Very - experimental. Don't use unless you want it to choke, and then figure - out why it choked. :) - -Fri Nov 26 03:52:19 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el: Changed the forms handling routines so that it handles - METHOD, ACTION, and ENCTYPE attributes of the <FORM> tag. METHOD and - ENCTYPE aren't used yet. Thanks to Darrell Kindred for noticing the - problem. -* w3-parse.el: Fixed a formatting problem with the ISINDEX forms - replacements. Was doing a fixed-case replace. Thanks to Jared Rhine - <Jared_Rhine@hmc.edu> for noticing the problem. -* w3-parse.el: Fixed a formatting error with <BR> tags - sometimes spaces - were left at the beginning of the continued line. Thanks to Erich - Schneider <erich@bush.cs.tamu.edu> for noticing the problem. -* w3-misc.el (w3-lookup-style): Fixed dumb bug where I was not - de-referencing the variables to the actual #<style> value in epoch. - Thanks to Paul Furnanz <paul_furnanz@mentorg.com> for the initial fix. - I generalized it a little. -* w3-parse.el: Added a check to make sure that long URLs don't show up as - extremely long buffer names. Thanks to Heiko Muenkel - <muenkel@tnt.uni-hannover.de> for noticing the problem. -* w3-lucid.el: Added a patch from Sjoerd Mullender - <Sjoerd.Mullender@cwi.nl> to add a menu bar to lucid emacs if there - wasn't one by default. -* w3-emacs19.el: Added a few patches from Jin S Choi (jsc@mit.edu). - Mostly fixed the hotlist menu updating code, as well as a few cosmetic - changes to the FSF19 menus. -* w3-epoch.el: Added a few patches from Henry Rowley <har@cs.cmu.edu> to - fix a few functions that assumed epoch was compiled with - add-graphic-zone. -* w3-lists.el (w3-fill-paragraphs-in-list): Fixed a stupid bug where the - first letter of every paragraph would be removed when filling. Thanks - to Arup Mukherjee <arup@cmu.edu> for noticing the problem, and Darrell - Kindred for the fix. - -Tue Nov 16 10:55:56 1993 William M. Perry (wmperry@indiana.edu) -* Makefile (install): Fixed problem where I was only copying W3FILES to - the install directory, and should have used W3FILES and W3BINS. -* w3-forms.el: Stupid problem where I was always trying to call - w3-form-format-unknown. Simple 'not' around a statement to fix. -* w3-forms.el: Yet another stupid typo - w3-format-unkown instead of - w3-format-unknown. Thanks to Dan Sullivan - <sullivan@quinn.physics.ncsu.edu> for the fix. - -Mon Nov 15 21:02:50 1993 William M. Perry (wmperry@indiana.edu) -* Various small changes (wrote over the new ChangeLog when doing a restore - of some files). -* w3-vars.el: Changed the order of w3-html-entities so that & is at - the end. This was causing the entities later in the list to be messed - up if they occurred in the same document. -* w3-lucid.el: Changed the w3-extent-at, w3-find-specific-link, and - w3-next-extent to not use a free variable. Thanks to Jamie Zawinksi - <jwz@lucid.com> for the patch. Dumb oversite on my part. -* w3-forms.el: Made the forms formatting very extensible. The formatting - function is determined by reading in lisp expression from a formatted - string. w3-form-format-<type> will now be called and expected to return - a string to use as the prompt. -* w3-emacs19.el: Fixed dumb problem where emacs19 on a tty would not be - able to find a list of links in the current document for - w3-complete-link. -* w3-lists.el: Fixed the filling of paragraphs within lists. No longer - inserts too many newlines. -* Fixed a few problems where w3-do-setup was not being called correctly at - startup. This would result in an error about w3-style-regexp being nil. -* w3-mosaic.el: Fixed a problem with the hotlist handling code. Mistake - in a regular expression. Thanks to Jin S Choi (jsc@mit.edu) for - reporting the problem and sending a fix. - -Fri Nov 12 07:31:36 1993 William M. Perry (wmperry@indiana.edu) -* w3.el: The mailcap entries are now parsed at startup. -* Made changes to several files so that the new NeXTstep port of emacs 19 - will use faces, and not think its on a dumb terminal. Mostly involved - changing a bunch of (eq window-system 'x) to an or (eq window-system - 'dps). While I was at it I also changed the statements so that the - Presentation Manager port of emacs 19 under OS/2 will use faces, etc. - -Thu Nov 11 07:20:13 1993 William M. Perry (wmperry@indiana.edu) -* Realized I should get sick more often - I seem to get more done. :) -* w3-vars.el: Added the ABSTRACT, QUOTE, and BYLINE tags to the list of - emphasis tags. -* w3-parse.el (w3-handle-notes): Added support for the HTML+ NOTE tags. - Handles any role, and also honors the SRC= for the warning image. -* w3-parse.el (w3-handle-footnotes): Added support for the HTML+ footnote - and margin-note tags. Handles as links to footnotes at the end of the - document. -* w3-parse.el (w3-fix-render-hints): Added support for the HTML+ RENDER - tag to extend the set of logical emphasis roles on a per-document basis. -* w3-parse.el: Changed the emphasis handling to be more extensible. New - variables w3-style-assoc and w3-style-regexp. w3-style-assoc maps tags - onto style names. -* w3-parse.el: Added ability to have IDS within headers. This is in - conformance with the HTML+ specification. -* w3-lists.el: Added ability to have IDs within <P> tags. This is in - conformance with the HTML+ specification. -* w3-lists.el: Added function w3-fill-paragraphs-in-list. This will fill - all paragraphs within any type of list. This allows for <P> elements - within lists without odd looking results. -* w3-forms.el (w3-split): Changed this so that it no longer puts strings - with only spaces and tabs in the assoc list that is returned. This - error caused every popup FORM item to have a blank line at the end. -* Added new variable w3-default-action. This specifies the lisp function - to run instead of w3-prepare-buffer when W3 can't figure out the MIME - type by looking at the file extension. (Things like .README or .patch - would be parsed as HTML - not good). Thanks to Alastair Burt - <burt@dfki.uni-kl.de> for noticing the problem. - -Wed Nov 10 08:02:31 1993 William M. Perry (wmperry@indiana.edu) -* General cleanup, better documentation in all files. Trying to merge - files so that there are fewer dependencies between files. Thank - goodness for the optimizing byte compiler and call-trees. :) -* w3-parse.el: Removed the handling of <EM> tags. No longer part of the - HTML+ specification. -* w3-vars.el: Excercise in anal-retentiveness. :) Organized and - alphabetized all the variables and added to quite a few documentation - strings. Yeah yeah yeah, but it needed it! :) -* w3-vars.el: Added a few more new keybindings from Tom Tromey - <tromey@busco.lanl.gov>. -* w3-misc.el (w3-maybe-eval): Added new MIME type application/emacs-lisp - along with a viewer that asks whether to evaluate it after viewing it. -* w3-url.el (w3-open-local): Made this a stub to call w3-fetch with file: - prepended to the filename you type in. w3-open-local-internal now does - all the work. Thanks to Bill Benedetto <benedett@gentire.com> for - noticing it was bombing out when called non-interactively. -* w3-url.el (w3-news): Added the ability to specify a news server in the - news url in the proposed news://server:port/article|newsgroup method. -* w3-typecheck.el (w3-optionp): Changed this to correctly handle when you - don't select anything from the menu. Would mess up the page and remove - the link before dying on an error. Thanks to Jin S. Choi <jsc@mit.edu> - for noticing the problem. - -Tue Nov 9 14:59:59 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el (w3-file): Added proper handling of ftp://user@host commands. -* w3-forms.el (w3-revert-form): Fixed this function so it will work if - there are pull-down lists in the form. Also changed the forms parsing - code to use the first item in a list as the default. -* w3-forms.el (w3-submit-form): TEXTAREA's will now be submitted - correctly. The buffer containing the information you typed in must not - be killed though. I need to find a better way to store it. Maybe a new - major mode? But then how to relay the info back to the w3-typecheck - function as the value? - -Mon Nov 8 13:05:29 1993 William M. Perry (wmperry@indiana.edu) -* Added function w3-complete-link to do a completing-read on all the links - in a buffer. Should work in all emacsen. -* Changed printing, saving, and mailing of documents so that you can - print/mail/save LaTeX, formatted text, or HTML source. -* w3-url.el, w3-gopher.el: Changed the reading.... messages to display the - actual number of bytes retrieved. - -Sun Nov 7 11:37:53 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el (w3-http): Fixed a problem where fetching something that had a - viewer associated with it when the connection was down or the file was - not found would still drop you into the viewer... often with odd - results. -* w3-lucid.el: Fixed a few bugs in the new lucid menus - was adding a nil - menu item (buffers with no links, no hotlist in memory, etc). Caused - system crashes on linux, headaches on other operating systems. Thanks - to Alastair Burt <burt@dfki.uni-kl.de> and Arup Mukherjee - <arup@KALI.FTM.CS.CMU.EDU> for noticing the problem and for the initial - patches. -* w3-mosaic.el: Think I fixed a problem with the hotlist parsing code. - Thanks to Jin S. Choi <jsc@slayer.mit.edu> for noticing the problem. - -Wed Nov 3 21:35:44 1993 William M. Perry (wmperry@indiana.edu) -* w3-lucid.el: Completely reworked the menu setup. Several different - menus, mirroring the setup of Xmosaic. -* w3-vars.el: Assigned a few new keybindings to make w3 a little closer to - info mode. Also redefined the M-C-v and M-b keys to use the C-c prefix - as they should. - -Mon Nov 1 09:42:18 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-build-links-list): Changed this so that it no longer - puts the delimiters around links with no HREFs. Thanks to Ivan Herman - <Ivan.Herman@cwi.nl> for noticing that it was still broken. -* w3-epoch.el (w3-insert-graphic): Changed this function to redirect - the output into the file instead of outputting it to STDOUT and then - saving it in a buffer and then writing the buffer. Faster, - especially for large files, and don't have to worry about how many - lines to delete at the top of the buffer. - -Sun Oct 31 10:31:04 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-build-links-list): Think I've fixed the problem of - links in headers being formatted with newlines. -* w3.el (w3-parse-relative-link): Fixed a problem where links of the - type "#something" would retrieve the current directory. Stupid - mistake. Thanks to Ivan.Herman@cwi.nl for noticing it. -* w3-forms.el: Fixed quite a few problems with the Emacs 18 support. - Problem was with using markers as start and end positions to - creating new zones - they got set to nil when the whole region was - deleted, so subsequent delete-regions failed. This also caused a - problem when trying to use the submit or reset buttons. -* w3-typecheck.el (w3-read-correct-format): Fixed a problem with the - pulldown menu support in emacs 18. The last-input-event variable - doesn't exist, so wrapped its use in an if boundp ..., etc. -* w3-gopher.el (w3-do-gopher): Fixed problem where links like - gopher://somesite/11/etc/etc/ would not get parsed - was seeing 11 - and thinking it wasn't a directory. -* w3-url.el (w3-gopher): Fixed a problem where a match-beginning got - lost because of a misplaced w3-unhex-string. Thanks to Arup - Mukherjee <arup@cmu.edu> for noticing the problem. -* w3-emacs.el: Changed the forward and backward link handling code so - that it will skip white space at the beginning of a link. Thanks to - Arup Mukherjee <arup@cmu.edu> for noticing the problem. -* w3-parse.el (w3-handle-comments): Fixed this function to handle either - comments written according to the HTML spec (with a trailing -->) or the - Xmosaic-handled way (with no --). Thanks to Darrell Kindred - <dkindred@KALI.FTM.CS.CMU.EDU> for noticing the problem. -* w3-mosaic.el (w3-parse-hotlist): Applied a patch by Arup Mukherjee - <arup@cmu.edu> and Darrell Kindred <dkindred@KALI.FTM.CS.CMU.EDU> to fix - an annoying problem where the first page you retrieved in a w3 session - would not be shown, and the buffer you started out in would be put into - w3-mode. - -Sat Oct 30 13:38:43 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el (w3-preview-this-buffer): Fixed this so that it does a - buffer-file-name instead of just buffer-name so that it will be able - to reload documents correctly. -* w3-epoch.el: Fixed stupid problem in w3-follow-link where it called - w3-do-form-entry with the arguments in the wrong order. -* w3-emacs19.el: Removed requirement of cl. Took up lots of space - was - old anyway. 'last' is no longer needed. -* Applied patches to Makefile from Jamie Zawinskie <jwz@lucid.com> so it - will compile in a better way. -* Added full GNU copyleft notice to all the source files so that it can be - distributed with Lucid Emacs. Also changed lots of functions to make the - files compile with fewer warnings about unbound variables. - -Wed Oct 27 07:10:56 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el (w3-handle-selections): Added this function to handle the - new <SELECT> tag in HTML+. Supercedes the TYPE="OPTION" tag. This also - handles the scrolling list boxes and multiple pick lists. Multiple pick - lists don't work correctly yet though. -* w3-mime.el (w3-parse-mailcap): New function to parse the .mailcap file - used by Mosaic/metamail/etc. Appends it to the w3-mime-viewers assoct - list - format is preserved correctly. If the MIME type is already in - the assoc list, then it is skipped. - -Tue Oct 26 08:39:23 1993 William M. Perry (wmperry@indiana.edu) -* w3-epoch.el (w3-follow-link): Fixed a problem where w3-follow-link - would not work correctly - needed to wrap the 't' start of an if - statement with a progn. -* w3-epoch.el (w3-create-hrule): Created this function to generate a - pixmap the size of the current window width to use for horizontal - rules. Also changed the parser to use add-graphic-zone if it is in - epoch and it finds an <HR>, otherwise it will use the dashes. - -Mon Oct 25 17:15:05 1993 William M. Perry (wmperry@indiana.edu) -* w3-vars.el (w3-mime-extensions): Added _LOTS_ more MIME types + - descriptions of _ALL_ of them. -* w3-lucid.el (w3-mouse-handler): Changed this to use the new function - w3-link-info. Is a little easier to use. -* w3-misc.el (w3-link-info): New function to give an intelligent guess of - what the link is pointing to. ie: 'A hypertext file on the local file - system' or 'A newsgroup (comp.infosystems.www) from NNTP server - usenet.ucs.indiana.edu' -* w3-url.el (w3-open-local): Fixed a problem where opening a local file as - ~/..../fname.html would cause an error if you had a relative reference - past the ~/ point. Thanks to Benjamin Pierce <bcp@dcs.ed.ac.uk> for - noticing the problem. -* w3.el (w3-search): Changed this function to make sure that only 1 '?' is - appeneded to the url when searching. Thanks to Arup Mukherjee - <arup@cmu.edu> for noticing the problem. - -Sat Oct 23 10:25:32 1993 William M. Perry (wmperry@indiana.edu) -* w3-epoch.el: Fixed w3-follow-link so it will work again - was - messing up once in a while because of the new code to let images be - used as links. -* w3-epoch.el: Using images as links should work now. Need to have it - check for failure of reading the XPM and use the ALT attribute if it - does. -* w3-url.el (w3-format-news): Fixed this function so that it will no - longer call w3-sentinel on its own. Also changed it so that the <TITLE> - is set to the subject, not the newsgroup name. -* w3-epoch.el: redid the image code to limit the images to 40 colors. - This allows more images to be read in before the conversions start - failing. Can change this arbitrary limit by changing the argument - to ppmquant in w3-graphic-converter-alist. -* w3-misc.el (w3-hexify-string): Fixed this function - it would mess - up when sending hex codes < F. (ie: %F instead of %0F). - -Fri Oct 22 12:37:26 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: Removed all the references to &optional source in all the - different retrieval areas (w3-http, w3-file, w3-gopher, etc). This will - all be handled in w3-build-continuation from now on. Also changed it so - that printing/sourcing a document doesn't explicitly set the w3-source - variable or w3-print-next, it just wraps the calls to w3-sentinel in a - let statement. -* w3-url.el (w3-http): Changed w3-http to insert an error message into - w3-working-buffer if it couldn't connect to the server. Thanks to - Bengt Andersson <Bengt.Andersson@telelogic.se> for noticing the problem. - -Thu Oct 21 06:31:09 1993 William M. Perry (wmperry@indiana.edu) -* w3-mime.el (w3-parse-mime-headers): Changed the detection of circular - redirection to insert a warning at the end of whatever it did retrieve - instead of signalling an error. This way people will know who to - contact for the problem. -* w3-epoch.el (w3-insert-graphic): Added support for ALIGN attribute - of the IMG tag. -* w3-parse.el (w3-fix-paragraphs-in-region): Fixed stupid problem where - ordered lists would not be filled correctly if unordered lists were - positioned before them in the buffer. Thanks to Bengt Andersson - <Bengt.Andersson@telelogic.se> for noticing the problem. - -Wed Oct 20 11:35:40 1993 William M. Perry (wmperry@indiana.edu) -* w3-auth.el (w3-basic-auth): Fixed a stupid problem in a regular - expression that caused it to only do access-authorization lookups on the - first part of the path. Now passes all cern tests successfully. On to - pubkey! -* w3-mime.el (w3-create-mime-request): Took out all the \r's. Was - screwing up Cern's experimental authorization server. -* w3-forms.el: Fixed problem in the handling of TEXT input tags when the - initial value was longer than the visible size. Also fixed problem where - typing in a password longer than the visible size caused an error. -* w3-url.el (w3-open-local): Changed this function to call w3-sentinel - if it was called interactively. This way 'o' in a w3 buffer still - works. -* w3-epoch.el (w3-insert-graphic): Completely rewrote this function. - It should be able to get graphics over any type of protocol (it - goes thru w3-retrieve). w3-graphic-converter-alist also now goes by - MIME types. - -Tue Oct 19 10:12:49 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el (w3-use-links): New function to do a completing read on the - <LINK> tags in the current document. No keybinding yet. -* w3-misc.el (w3-mail-to-author): New function to send mail to the author - of a document. Uses the <LINK> tag with REV=made if any is found. -* w3-parse.el: Added storage of the <LINK> attributes. w3-mail-to-author - will send mail to the author if the 'made' LINK is found. -* w3-url.el (w3-fetch): Added in check to see if w3-working-buffer exists - before calling w3-sentinel. Would give error "No such buffer *W3*" if - you followed a telnet/tn3270/rlogin link. -* w3-gopher.el: Changed the hypertext gopher support to just return raw - HTML like all the other functions now. -* w3.el (w3-parse-relative-link): Changed w3-relative-link to just call - w3-fetch on the results of this function so I could use it in - w3-parse-mime-headers for redirection. -* w3-url.el (w3-retrieve): Moved everything from w3-fetch into this - function. It just returns the name of the buffer the raw HTML is put - into - no processing is done. w3-fetch is now just a call to this - function and then w3-sentinel. HTTP/1.0 redirection and authorization - are handled before exiting. -* w3-auth.el: Added an optional argument to the w3-XXX-auth functions. If - third argument OVERWRITE is non-nil, and a password is found, it is - ignored and a new user/pass combination are prompted for. - -Mon Oct 18 08:38:00 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-prepare-buffer): Moved the call to w3-handle-forms to be - after w3-restore-pre so that forms inside <PRE> segments would turn out - right. Not part of the spec, but useful. Thanks to Rob Tillotson - <cq@staff.cc.purdue.edu> for noticing the problem and suggesting the - fix. -* w3-auth.el (w3-b64-encoding): Actually wrote the base 64 encoding - function in lisp. Much faster than using the subprocess. -* w3-lucid.el (x-popup-menu): Added this function to do a blocking popup - menu. Thanks to Jamie Zawinski (jwz@lucid.com) for telling me where to - look - its a hacked up version of yes-or-no-p-dialog-box from - prim/menubar.el. -* w3-mime.el (w3-create-mime-request): Added in checking for authorization - into the MIME request. If a match is found using w3-basic-auth, then a - new line is added with the encoded password. -* w3-auth.el (w3-basic-auth): This now takes an optional parameter PROMPT, - that if non-nil and a server and/or directory is not found in the list, - then the user is prompted for a username/password. If nil, it just - returns nil if not user/pass found. -* w3-auth.el (w3-encode-password): Due to some problems with numbers - getting too large when doing base64 encoding, have reworked this - function to call a program in a subprocess. Program is specified by the - variable w3-b64-encoder, and defaults to b64encode, from - ftp://cs.utk.edu/pub/MIME/b64encode.c. - -Sun Oct 17 10:21:06 1993 William M. Perry (wmperry@indiana.edu) -* w3-auth.el (w3-encode-password): I think this does base64 encoding - correctly now. Have to test it more though. -* w3-auth.el: Started work on 'Basic' authentication. Not working yet, - but storage of servers/usernames/passwords/paths works. Subdirectories - of 'protected' directories will find the username/password for the - parent directory, as per the specification (/foo/bar/baz.html will - locate the password entered before for /foo/test.html or / if any were - entered). -* w3-mime.el (w3-parse-mime-headers): Added error checking into the server - redirection to see if something points to itself. -* w3-typecheck.el (w3-floatp): Fixed regular expression problem where - floating point numbers would not be parsed correctly. -* w3-typecheck.el (w3-urlp): Wrote this function to do basic typechecking - of URLS that are input into a <FORM>. -* w3-mime.el (w3-parse-mime-headers): Added support for server-side - redirection (301, 302) and the Method: header also (303). -* w3-forms.el (w3-set-radio-button): First pass at doing Radio buttons the - correct way. Works (to a point) - it doesn't delete one of the zones - after changing their values though. Not sure why. - -Sat Oct 16 14:55:39 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el: Added support for PASSWORD input tag. Will use - ange-ftp-read-passwd and display '*****' as the value. -* w3-forms.el: Added support for OPTIONS INPUT tag. If in Xwindows and - able to use x-popup-menu it will pop up a menu. If not in Xwindows, - will use a completing read of the possible options. - -Fri Oct 15 16:15:59 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-nuke-unsupported): Changed this so that it will support - the ALT tag in IMG statements. -* w3-gopher.el: Changed the gopher handling so that it will pass - everything but directories off to the main viewer-handling procedures. - -Thu Oct 14 18:26:55 1993 William M. Perry (wmperry@indiana.edu) -* w3.el (w3-save-url): Fixed problem in w3-save-url where the text was - saved in the kill-ring, but the kill-ring-yank-pointer was not updated. - Thanks to Bengt Andersson <Bengt.Andersson@telelogic.se> for noticing - it. -* w3.el (w3-quit): Fixed a problem where quitting from links would take - you back one level of buffers too far. Thanks to Bill Benedetto - <benedett@gentire.com> for noticing it. - -Wed Oct 13 07:10:04 1993 William M. Perry (wmperry@indiana.edu) -* w3.el (w3-quit): Added the variable w3-keep-old-buffers. If t, old w3 - buffers are kept. If nil, w3 buffers are deleted after you follow a - link from them. Need to work on getting the parent of a w3 buffer now - though. -* w3-lucid.el (w3-extent-at): Fixed problem where Lucid would not realize - that you were on a link if it was at the first character. -* w3-url.el (w3-build-continuation): Fixed problem where a file with no - MIME viewer would die - just a misplaced set of parentheses. -* w3-parse.el (w3-check-index): Changed this function so it only inserts - the <FORM> tags if protocol is HTTP. - -Mon Oct 11 07:19:59 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-prepare-buffer): Ordered lists will now have their - numbers aligned correctly. -* w3-misc.el (w3-fix-fake-urls): This function will turn 'fake' urls like - ftp://somesite/some/file/ into real links like <A - HREF="ftp://somesite/some/file/"> - the text of the link is the text it - replaces. Will be useful for mail/news reading hooks. - -Sat Oct 9 08:14:45 1993 William M. Perry (wmperry@indiana.edu) -* w3.el (w3-quit): fixed a problem where quitting from a 'previewed' - buffer would signal an error. -* w3-parse.el (w3-prepare-buffer): Fixed this so that <PLAINTEXT> can - appear anywhere in a buffer, and will be treated appropriately. Thanks - to Darrell Kindred (Darrell.Kindred@CMU.EDU) for noticing the problem. - -Fri Oct 8 08:51:37 1993 William M. Perry (wmperry@indiana.edu) -* Changed all the (set buffer " *W3*") to now use the variable - w3-work-buffer instead - this will allow me to have multiple receives - going at the same time. Also allow me to parse out different buffers - for urls and not have to copy back and forth to " *W3*". Not fully - implemented yet. - -Tue Oct 5 11:56:30 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el (w3-in-assoc): Changed this funcion so that it returns the - first match. Was messing up on some of the wildcards in the default - MIME viewers. -* w3-viewers.el: Several bugfixese/enhancements to the MIME viewer - handling. Everything (including printing, sourcing, and presentation of - hypertext) is now handled by the MIME viewers. -* w3.el: Will now load the file "~/.w3" if it exists. Will let you store - all your w3 variables in the same place. Only loaded after all the - different modules. -* w3-viewers.el, w3-url.el: Changed the viewer handling to be by MIME - content-types all the time. A new variable, w3-mime-extensions, - controls how file extensions are mapped onto MIME content-types. - Inspired by the way MacMosaic handles its viewers. Should be easier to - maintain just one viewer list. - -Mon Oct 4 06:19:10 1993 William M. Perry (wmperry@indiana.edu) -* w3-viewers.el: Changed the viewing to ask if you wish to view the output - of the process. Generates unique buffer names, etc. Thanks to T.V. - Raman <raman@cs.cornell.edu> for suggesting it. -* w3-viewers.el: Moved all the external/internal viewer handling into this - file. -* w3.el (w3-quit): Fixed problem where w3 would signal an error when you - quit and the buffer that preceded it has been killed. Just goes to the - next buffer now. Thanks to Bengt Andersson - <Bengt.Andersson@telelogic.se> for noticing it. -* w3-lucid.el: Applied patch from Darrell Kindred - <Darrell_Kindred@cmu.edu> which fixed a problem with finding tags of - hyperlinks when it had other attributes (<ADDRESS>,<B>, etc) as well. - -Fri Oct 1 06:29:37 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-fix-paragraphs-in-region): Added support for the <HR> - tag (horizontal rule). -* w3-mime.el (w3-mime-viewer): Fixed a problem where this returned a cons - where it should have returned a string. Thanks to Bengt Andersson - <Bengt.Andersson@telelogic.se> for noticing it (yet again). - -* w3-gopher.el: Fixed a few problems with searching -* w3-url.el: removed newlines from regexps - were messing up <PRE> - segments. -* w3-url.el: changed mailto to include the url that it was sent from. - -Mon Sep 27 13:57:34 1993 William M. Perry (wmperry@indiana.edu) -* w3-typecheck.el (w3-intp): Changed the function to check whether an - integer was valid. Would mess up in emacs19, where 12.5 is a good - parameter to string-to-int. - -Sat Sep 25 06:48:55 1993 William M. Perry (wmperry@indiana.edu) -* w3-typecheck.el: Added this file to control typechecking of forms entry - fields. Checks dates, ints, floats, urls, and text. -* w3-forms.el (w3-do-form-entry): changed so that it will use the new - typechecking functions. - -Fri Sep 24 14:01:54 1993 William M. Perry (wmperry@indiana.edu) -* w3-lucid.el: completely rewrote the forward and backward link movement. - Works a lot better now. - -Thu Sep 23 11:36:35 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-prepare-buffer): fixed <TITLE> handling so it takes out - leading and trailing spaces/tabs. Could make it difficult to find a - buffer when the name began with a space. -* w3-parse.el (w3-build-links-list): Fixed problem where link names would - be too long (would include part of the HREF) when the HREF was not - quoted. Thanks to Dong-Ping Deng (deng@owl.rhic.bnl.gov) for noticing - it. - -Wed Sep 22 10:49:37 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el (w3-maybe-relative): Fixed stupid bug where I didn't add the - new tn3270 link type to a few regular expressions. - -Tue Sep 21 10:51:09 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: Added support for tn3270://... links. Thanks to T V Raman - <raman@cs.cornell.edu> for noticing its lack. -* w3-parse.el (w3-check-index): Added variable w3-use-forms-index. If - non-nil, will replace <ISINDEX> tags with a very short <FORM> for - searching. Default is t, like Xmosaic. -* w3-vars.el: Added more styles for the <EM> tag. - -Mon Sep 20 07:02:28 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el (w3-find-specific-link): Emacs19 can now find #identifier - marks in documents. -* w3-gopher.el (w3-gopher-retrieve): Fixed a problem with gopher sending - more than one character 'description' to the server. Would result in - 'Can't open 1/whatever' in some cases. -* w3-misc.el (w3-show-hotlist): Added this function to show the hotlist in - a hypertext form. Thanks to Stephen Simpson (simpson@math.psu.edu) for - suggesting it. -* w3-forms.el: Added in support for emacs 18 -* w3-emacs.el: Added in support for deleting an arbitrary zone. This - was needed to make forms support work correctly. -* w3-vars.el (w3-be-asynchronous): added this variable to control whether - documents would be retrieved in a non-blocking way over HTTP. - -Sun Sep 19 14:15:39 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-handle-em-tags): Fixed problem where emacs18 would - die on handling any <EM> tag. Thanks to mcr@ccs.carleton.ca - (Michael Richardson) for pointing it out. -* w3-mime.el (w3-mime-viewer): Fixed problem with the viewer finder - was - trying to do a car of a string Keith Waclena - <keith@neuromancer.lib.uchicago.edu> for sending me the fix. - -Fri Sep 17 09:23:08 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el: fixed problem where deleting or adding hotlist entries - would not update the menubar. Thanks to jsc@mit.edu for noticing the - problem. - -Mon Sep 13 06:40:35 1993 William M. Perry (wmperry@indiana.edu) -* Added the <REMOVED> and <ADDED> tags (both as containers and roles of - the <EM> tag. -* w3-parse.el: took out the conversion of IMG tags to hyperlinks - was - messing up when links were nested - need to work on it. -* w3-lists.el (w3-build-table): tables should now handle <DD> with no - matching <DT> a little better. Don't know why people bother writing - HTML this bad, but oh well. -* w3-mime.el (w3-parse-mime-headers): Had a problem parsing out the mime - headers if there wasn't a crlf at each endline, which broke parsing - NCSA's new 1.0 server. Fixed now. - -Fri Sep 10 05:52:06 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: took out blank definition of w3-submit-form that - would screw up submitting forms. (Emacs19.el got loaded after - w3-forms.el so would have a blank definition) - -Thu Sep 9 07:57:58 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el: Added support for <SP> (nonbreaking spaces), and <BR> - (force line breaks), and <EM> tags - the EM tags don't allow multiple - tags right now (ala <EM B I> </EM>, but nesting of <EM> tags works.) - -Wed Sep 8 11:58:21 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el (w3-build-continuation): the fetching of grouop annotations - has been removed, as the experiment at NCSA has ended. -* w3-forms.el (w3-revert-form): finished this function - now works - correctly. -* Added code to all emacs-specific files to call w3-do-form-entry if - w3-follow-link is called on a zone that is tagged with 'w3form. -* I have serious doubts whether the form support will work in emacs18 - I - need to write a delete-zone function for it, but that might be a bear. - Will toy with it later. - -Tue Sep 7 07:13:36 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el: added a (delete-overlay zone) if running FSF19 so that not - all edits are sent when you submit a form. -* w3-forms.el: now, if a checkbox's VALUE/DEFAULT field is empty, it is - sent as name=PRIMED, ala xmosaic. -* w3-forms.el: fixed bug where the maxlength would be set to 20 instead of - unlimited if it was not specified. (Actually, its set to 10,000 but I - think that should be enough for a while. :) - -Mon Sep 6 08:59:43 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el: Eureka! They actually work now. Successfully submits to - the NCSA server/demo pages. Still a little kludgey, but cleaning it up - should be too difficult. -* w3-forms.el: forms now keyed by number so it will be easier to submit - them back to the server. Also changed the submit and reset buttons to - take their button labels from the VALUE tag as xmosaic does. - -Sun Sep 5 09:17:42 1993 William M. Perry (wmperry@indiana.edu) -* w3-forms.el: more work on forms support - can now click on check boxes - and enter text in the entry areas. -* w3-forms.el: added support for the parsing of forms - -Sat Sep 4 11:06:12 1993 William M. Perry (wmperry@indiana.edu) -* w3-mime.el: Fixed a problem where mime viewers would not work correctly - - tried to do a car() on a string. -* w3-mosaic.el (w3-add-document-to-hotlist): fixed a bug in the creation - of gopher hotlist entries. Thanks to Erik Ostrom - (eostrom@mcs-server.gac.edu) for noticing and patching it. -* w3-gopher.el: more work on trying to get searching to work - almost - there. - -Wed Sep 1 09:17:00 1993 William M. Perry (wmperry@indiana.edu) -* w3-gopher.el: Did quite a bit of work on the gopher support. Lots of - ideas, some code from the original gopher.el, but this keeps it in - hypertext - can print, get the document source, add to hotlist, etc. - Searching still does not work. - -Tue Aug 31 10:03:04 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el: Changed the viewer handling so that it creates unique - filenames - if you viewed several things at once, it would write over - the old file, and kill the old viewers. Also fixed problem where it - wouldn't delete the w3-tmp file when it was done viewing. - -Mon Aug 30 10:19:07 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el (w3-gopher): added variable w3-use-hypertext-gopher. If 't' - use the gopher interface I just wrote, or use Scott Snyder's gopher - mode. (The gopher mode is a slightly more complete, but mine preserves - the hypertext feel) -* w3-gopher.el: added this file - rolled my own gopher interface this - afternoon. Needs more work, but seems functional. -* w3-misc.el: changed the viewer handling so that it handles the viewers - asynchronously again. - -Fri Aug 27 07:06:39 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-handle-address): address handling handles newlines - before and after ADDRESS tags better - so multiple ADDRESS tags - following each other don't have more than one newline, etc. - -Thu Aug 26 14:49:28 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-fix-paragraphs-in-region): fixed problem where the - fleading spaces/tabs of a line in a PRE or XMP segment would get - nuked. Thanks to Bob Olson (olson@mcs.anl.gov) for noticing it. - -Tue Aug 24 22:49:38 1993 William M. Perry (wmperry@indiana.edu) -* w3-epoch.el: fixed a typo - left out a " in a defvar which caused the - compiles to fail. Thanks to Andrew Violette (violett@indiana.edu) for - noticing it. - -Mon Aug 23 07:12:05 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el (w3-lookup-style): Fixed stupid mistake where emacs19 - wouldn't return any styles from this function -* w3-parse.el: Fixed a problem where it would not fill paragraphs - correctly after the last PRE segment of the text. -* w3-parse.el: Made the parser a lot less destructive (not as many - delete-regions) - this should make it handle overlapping formatting - better in most cases. And maybe a little faster, since it doesn't have - to create as many strings and do as many re-insertions. - -Sun Aug 22 09:25:14 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: rewrote w3-view-this-url and w3-follow-link so that they - won't sometimes choke on links at the end of bold/italic/whatever zones. -* w3-url.el (w3-http): now prints outi ts reading status (Reading.....) -* w3-lucid.el: Took out the copying of a non-existent 'underline face. - -Wed Aug 18 06:27:12 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el (w3-write-global-history): fixed this so it actually works - again - forgot to change it when I changed the format of w3-history-list - to be an assoc list. - -Tue Aug 17 18:01:00 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el (w3-fetch-annotations): Fixe problem where the annotation - fetch would die if the server couldn't be contacted. - -Mon Aug 16 17:04:23 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: took out the xresource reading - will depend on - emacs*w3-XXX-style.AttributeFont like the lucid emacs stuff. -* w3-lucid.el, w3-emacs19.el: changed these so that if the newly created - faces aren't set up in the xdefaults, it will copy the appropriate face - (header-style copies 'bold-italic, etc). Thanks Michael J. Lamoureux - (tolamour@engin.umich.edu) - -Sun Aug 15 09:22:52 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: Added #linkname finding for local files and ftp html files. -* w3.latex: added a section on going through firewalls/telnet, and using - the new tcp.c and tcp.el package. -* w3.el: Changed the w3-help function to make sure a function is defined - before checking for documentation strings, etc. Also changed it so that - it puts it in a hypertext buffer. This opens up the idea of putting - links in the documentation strings. :) -* Made tcp.c and tcp.el part of the 'extras' distribution. -* w3-mosaic.el: Fixed problem where it would try to send the annotation - request to a string if w3-open-stream failed. -* w3-misc.el: changed the telnet handling so that it will return 'nil' if - telnet could not connect to the remote host. -* w3-vars.el (w3-color-display): this will now be set correctly in emacs19 - - had spelled a function name wrong. -* w3-url.el: Change w3-open-local and w3-file to respect new variable - w3-directory-format, which tells it whether to have a hypertext - directory listing, or just pass off to dired. - -Fri Aug 13 07:50:50 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el: Fixed problem with not killing the "Process *anno* - finished" in http bufffers. -* w3-lists.el: Fixed bug where w3-sublists-exist would bomb in epoch. - Epoch's re-search-forward returns t or nil, not the point of the - match like lucid/emac18/emacs19. Several people pointed it out. - -Thu Aug 12 17:51:09 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el (w3-pass-to-viewer): Fixed problem where this would not - display a picture if you were in Xwindows - flaw in a logical statement. - Thanks to Phil Kime (philkime@cogsci.edinburgh.ac.uk) for noticing it. -* w3-parse.el (w3-build-links-list): Added a few patches from Erik Ostrom - (fiicmds04.tu-graz.ac.at) - fixes bug with only recognizing NAMEd hrefs - when the NAMEs are quoted, and botching of relative #links. -* w3-url.el: changed w3-http and w3-gopher to check the port # - if it is - in w3-bad-port-list, ask for confirmation before opening the connection. - -Tue Aug 10 13:07:04 1993 William M. Perry (wmperry@indiana.edu) -* New variable w3-bad-server-list, that is a list of HTTP/0.9 servers that - can barf on HTTP/1.0 requests. Generally just servers that have a - decent amount of lag from your site (or that completely barf on - HTTP/1.0, like the TeXinfo gateway at ohio-state). -* w3-mime.el: changed w3-create-mime-request to check w3-bad-server-list - for the current server and the value of w3-use-http2. If both are - false, then generate an HTTP/1.0 request, otherwise HTTP/0.9 -* w3-url.el: changed w3-http to always use w3-create-mime-request. - -Mon Aug 9 08:52:10 1993 William M. Perry (wmperry@indiana.edu) -* w3.el: Added w3-documents-menu, an assoc list of titls and urls to turn - into a menu if you are in lemacs or emacs19. Add support for running it - on dumb terminals via completing-read later. -* w3.el: Ripped out all the variable definitions into w3-vars.el -* w3-mime.el: fixed quite a few problems with w3-create-mime-request -* w3-misc.el: think I finally got the truncated pages problem fixed. - (yeah, right :) -* w3.el: Added code from Erik Ostrom (eostrom@fiicmds04.tu-graz.ac.at) to - patch gopher-mode to throw you back into w3 when encountering a WWW link - in gopher. Hopefully these will make it back into the main gopher.el. -* w3-emacs19.el (w3-back-link): Added fix from Erik Ostrom - (eostrom@fiicmds04.tu-graz.ac.at) so it won't give you an error in files - with only 1 link when you try to move backward. -* w3-epoch.el: fixed a typo where you wouldn't be able to retrieve - images over http. - -Sun Aug 8 13:56:11 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: added support for file://localhost urls. Thanks to - witbrock@cmu.edu for pointing out that they didn't work -* w3-emacs.el: took out the searching forward for '[' in the - goto-start-of-zone routine. Would fail if w3-delimit-links was nil. - Thanks to witbrock@cmu.edu for pointing it out. -* Revamped w3-url.el, w3-mosaic.el, and w3-misc.el to get the telnet - support working better. No more mucking around with filters, etc. -* w3-parse.el (w3-build-links-list): Changed the link routine so that it - will default to putting the end of a link at the end of the current line - if none is found normally. -* w3-url.el: Local directories are now put into a hypertext buffer, and - parsed by w3. Not sure if I should leave it this way or not. - -Sat Aug 7 03:28:58 1993 William M. Perry (wmperry@indiana.edu) -* w3-lists.el (w3-build-table): Changed it so you don't need to have a - DT in a DL list. -* w3-mime.el (w3-mime-viewer): fixed this function to actually work! :) - (Was returning a list of the viewer, had to add a (car).) -* Applied several patches from Jin S Choi (jsc@monolith.mit.edu), fixing - several stupid mistakes I had made. :) Including, too many ')' in - emacs19, bad font setting in emacs19, noticed truncated pages via http2, - underlining of headings is off by default now. -* w3-url.el: no longer print out "Reading..." when receiving documents - - would sometimes scramble the document. -* w3-misc.el: w3-open-stream no longer errors when it can't connect to a - server - this would cause w3 to bomb if the annotation server were down. - Thanks to Jin S Choi (jsc@monolith.mit.edu) for noticing it. -* w3-misc.el: w3-send-string should be a little better about not sending - mulitple lines to the server now, especially in emacs19 & epoch(?) where - accept-process-output accepts a timeout. - -Fri Aug 6 14:45:20 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el: changed the gopher handling to pass off everything to gopher - mode, so it can now handle gifs, images, etc. -* w3-lists.el: Made DL be compact by default until I get the code to - change it based on DL COMPACT working right. -* w3.el: removed the w3-useful-documents function - not really worth - having. -* w3-lists.el: Totally rewrote the main loop so its not recursive, and - doesn't use save-restriction. Much faster now. Also truly fixed - problem with not nesting correctly. -* w3-html+.el: a few tweaks, not ready for prime time yet though. - -Thu Aug 5 08:22:16 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el: Fixed bug in w3-fix-paragraphs that would cause it to loop - indefinitely if there were more than 2 PRE sections in a document. -* w3-misc.el: Will now print out "Reading....." when receiving input. -* w3-misc.el: w3-open-stream will now try to open the stream - w3-connection-retries times until it receives a valid connection. - -Wed Aug 4 08:49:44 1993 William M. Perry (wmperry@indiana.edu) -* w3-html+.el: can now include links as data table elements. Don't wrap - stuff onto next lines yet though. - -Tue Aug 3 00:39:50 1993 William M. Perry (wmperry@indiana.edu) -* w3-lists.el: nested lists don't indent too far now. Normal lists are - only indented 1 tab. -* w3-html+.el: started work on this file to contain experimental HTML+ - parsing routines. Will probably eventually rewrite most of the parser. - Mostly support for tables in right now. Will release soon. - -Mon Aug 2 09:21:23 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el: Added support for arbitrary tags (!ENTITY ...), and - support for endash and emdash entities. -* w3-parse.el: Fixed problem where links with no HREF field would bomb out - the parser (trying to string-match on nil). - -Thu Jul 29 10:35:06 1993 William M. Perry (wmperry@indiana.edu) -* w3-lists.el: found major bug with nesting multiple ULs inside of an - OL Seems to be fixed now though. - -Wed Jul 28 08:29:31 1993 William M. Perry (wmperry@indiana.edu) -* w3.latex: revamped this so I can now use the latex2html perl script by N - F Drakos (nikos@cbl.leeds.ac.uk). This will (almost) guarantee that the - online documentation is as up-to-date as the latex files. -* w3-parse.el: Will now be able to find titles that don't have TITLE and - /TITLE on the same line. -* w3-parse.el: Now stores the full url in each link's data zone - this - will allow print-url-under-point to work, and will make it easier to - write something that prints out a string of html documents. -* w3-lists.el: Added this file. Contains new functions to do better - nesting of lists. Shouldn't hang emacs, but if it does, let me know - right away and I'll try to fix it. Works great on the NCSA demo - document - and it has DLs inside ULs inside DLs inside ULs, so I figured - it was a good torture test for it. :) -* w3-mosaic.el: changed the hotlist parsing code to remove empty lines so - you won't get a document type of ^Jhttp: if there are spurious blank - lines in the hotlist file. - -Mon Jul 26 09:45:34 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: Fixed forward and backward link movement. -* w3-parse.el: Now transforms IMG ... tags into HREFs. - -Sun Jul 25 15:00:43 1993 William M. Perry (wmperry@indiana.edu) -* w3-misc.el: added function w3-find-this-file, which will do a find file - on the current w3 documents source (if in FTP or local file mode). Will - be able to do it over HTTP when HTTP/1.0 becomes supported. Thanks to - Heiko Muenkel (muenkel@tnt.uni-hannover.de) for suggesting it. -* w3-misc.el (w3-send-string): Added a sit-for statement so it will wait - for process output - if the process is closed, then don't send any more - lines of the request. This seems to have stopped the truncation of - pages. - -Fri Jul 23 07:23:05 1993 William M. Perry (wmperry@indiana.edu) -* w3.el: Added patches by mhpower@athena.mit.edu. Fixed a problem with a - non-existent gopher directory in w3-interesting-docs, and a typo. -* w3-url.el (w3-unhex): Added patches by mhpower@athena.mit.edu. This - should give the correct values now. Was off by 6. - -Thu Jul 22 12:05:17 1993 William M. Perry (wmperry@indiana.edu) -* w3.el: Added new variable w3-use-http2. If 't', w3 will use the - HTTP/1.0 support that for some reason truncates pages. Default is t -* Makefile: fixed stupid mistake where I left out a ${LISPDIR} so it - always tried to install in the root directory (/) - -Tue Jul 20 11:52:33 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-fix-paragraphs): This function now respects PRE and XMP - segments and won't fill paragraphs in them. - -Mon Jul 19 09:22:17 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-build-links-list): Fixed a problem where the text from - the last link would be used if there was a newline before the closing - /A in a link. Also fixed several places where a link listing would - inherit items from the last link if they weren't defined (METHOD, URN, - etc) - -Sat Jul 17 11:36:31 1993 William M. Perry (wmperry@indiana.edu) -* Started work on adding NeXT mouse support in w3-emacs.el -* Disabled the HTTP/1.0 support - was truncating pages for some reason. -* w3-mosaic.el (w3-grok-annotation-format): Won't bomb if one of the - PAN-###.html files doesn't exist. - -Fri Jul 16 07:32:54 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el (w3-do-personal-annotation): this will now correctly create - the LOG file in the personal annotation directory if it doesn't exist. -* w3-parse.el (w3-prepare-buffer): Wrapped all the parsing stuff in a - (let ((case-fold-search t)) ,,,) so that lowercase tags will be - recognized correctly. Thanks to rhb@hotsand.att.com for noticing it - still messed up on lowercase tags. - -Thu Jul 15 11:11:34 1993 William M. Perry (wmperry@indiana.edu) -* w3-docomp.el (compile-w3): Added w3-mime.el to the list of files to - compile. -* w3.el: Added lines to make w3-current-mime-* buffer local -* w3-parse.el (w3-prepare-buffer): Added variable w3-right-border to - control indentation on the right hand side of the buffer. (Thanks to - Nathan Torkington (Nathan.Torkington@vuw.ac.nz) for suggesting it. -* w3-misc.el (w3-basepath): This will no longer bomb if you are in a - scratch buffer (Thanks to Nathan Torkington - (Nathan.Torkington@vuw.ac.nz) for reporting it. -* Release Version .9b -* w3.el (w3-viewer-alist): The command to execute should now include a - '%s' wherever you want a filename to appear. -* Should now send all the right headers to a server, and act correctly. - (Won't bomb if server doesn't send make a MIME-ified document) -* w3-mime.el: Can now create a valid HTRQ, parse a document's response - headers, and figure out if a document is a MIME-ified response. -* w3-mime.el: First crack at making w3 mime compliant. - -Wed Jul 14 03:42:08 1993 William M. Perry (wmperry@indiana.edu) -* w3.el (w3-useful-documents): Added an 'interesting-docs' assoc list. - Similar to Xmosaics 'Documents' menu - just interesting interfaces that - are in the web. -* w3-parse.el (w3-prepare-buffer): Took the file viewing code out of this - function - should never be evaluated. -* w3.el (w3-viewer-assoc-list): No longer automatically append - auto-mode-alist to this - will mess up finding of hypertext files if you - have html-mode in your list. -* w3-url.el: several changes to this file to actually make the external - viewers actually work again. - -Tue Jul 13 12:36:34 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el (w3-telnet): Changed this to use terminal-emulator instead of - transparent-window, since it won't work in emacs19 or lucid. -* w3-url.el (w3-file): Will now correctly remember the name of the last - buffer when retrieving files via ftp. Thanks to Dong-Ping Deng - (deng@bunny.rhic.bnl.gov) for noticing it didn't. -* w3-mosaic.el (w3-parse-personal-annotations): no longer bombs if the - annotation directory doesn't exist. Thanks to Heiko Muenkel - (muenkel@tnt.uni-hannover.de) for noticing. -* w3-parse.el (w3-build-table): Building of definitions list is forgiving - if there is no DD. - -Mon Jul 12 07:08:38 1993 William M. Perry (wmperry@indiana.edu) -* w3.el: changed add-hook to use w3-member. Thanks to Larry Masinter - (masinter@parc.xerox.com) for suggesting it. -* w3-parse.el & w3.el: fixed the run-hooks calls so they will actually - work. Thanks to Larry Masinter (masinter@parc.xerox.com) for pointing - out my mistake. -* Makefile: fixed a few problems - thanks to eostrom@iicm.tu-graz.ac.at - for pointing them out. (Things like not compiling hyperbole, can now - configure what file to update the autloads and stuff in.) -* w3-parse.el (w3-balance-XXX): fixed stupid mistake where I didn't remove - calls to string-to-int after redefining another function. -* w3-misc.el (w3-count-occurences): added this function so "XX matches" - does not flash in the minibuffer when balancing PRE and XMP segments. - Directly from the emacs19 how-many function, but with no message at the - end. -* w3-url.el (w3-mailto): changed syntax of mailto support to be - mailto:any-address-compliant-with-rfc822. It just pops up a mail buffer - and sticks the rest of the url after mailto: in the To: line. mailto - also now honors the variable w3-mutable-windows. -* w3-parse.el (w3-balance-xmp): added this function to balance XMP - segments just like PRE segments. - -Sun Jul 11 08:08:44 1993 William M. Perry (wmperry@indiana.edu) -* w3-print.el (w3-convert-latex-to-html): added this function to convert - LaTeX documents to HTML. Not sure why - was just bored. :) -* w3-url.el (w3-mailto): added this function to support a new link type. - mailto://host/user will create a mail buffer and mail to user@host. The - syntax for this may change since it is not standard. -* w3-parse.el (w3-build-table): fixed problem for when there was no - corresponding DD for a DT in a definition list. A few documents at - CERN are like this. - -Sat Jul 10 08:55:35 1993 William M. Perry (wmperry@indiana.edu) -* w3.latex: did lots of work updating the documentation. -* w3-emacs19.el (w3-emacs19-setup-faces): made function w3-try-make-XXX so - that w3 will still load and run, even if you use a font like '6x13' that - it can't make bold or italic. -* w3-parse.el: PRE and ADDRESS tags now look a little better. -* w3-mosaic.el: changed the annotation functions to set the - w3-current-annotation _AFTER_ calling html-mode, which will nuke all - buffer-local variables. -* w3-mosaic.el (w3-add-personal-annotation): Now supports adding personal - annotations. -* w3-mosaic.el (w3-add-group-annotation): now inserts /PRE as the first - line so that you can use all the formatting characteristics of HTML. - -Fri Jul 9 07:31:20 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el (w3-delete-personal-annotation): delete the current - annotation from your personal directory. -* w3-mosaic.el (w3-fetch-personal-annotations): fixed dumb mistake in - formatting the url of each annotation. -* w3-parse.el (w3-prepare-buffer): Will now check for any personal - annotations and put them at the end of the buffer (after group - annotations, if any). -* w3-mosaic.el: added functions for reading the personal annotations from - w3-personal-annotation-directory. No support for addition or deletion - of personal annotations yet. -* w3.el (w3-mode.el): Delete group annotation option is only available in - lucid when user is in an annotation. -* w3-[lucid|emacs19].el: changed menus to include deleting and adding - group|personal annotations -* w3-mosaic.el: started working on adding personal annotation support. - -Thu Jul 8 15:32:45 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el (w3-add-group-annotation): changed this so that it will - load up html-mode and have C-c C-c send the annotation. -* w3-mosaic.el: Annotations are now fetched if w3-group-annotation-server - is defined. -* w3-mosaic.el: Annotations can now be deleted - no key binding yet. -* w3-mosaic.el: Annotations can now be added. No key binding yet - -Wed Jul 7 13:16:21 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el (w3-back-link): Fixed w3-back-link so that the cursor will - be at the beginning of the link. -* w3-emacs19.el: changed all the functions to use native emacs19 overlay - functions, instead of hacked up lucid-like syntax. (Menus are still - done in lucid-style though) - -Tue Jul 6 12:41:03 1993 William M. Perry (wmperry@indiana.edu) -* w3-mosaic.el: Started work on w3-add-annotation and w3-fetch-annotations - to implement the NCSA group annotation facilities. Don't work right now - - not sure why. Need good docs (which don't exist) for the server. :) -* w3.el (w3-view-url): Fixed problem where this function would put too - many '/' in the url. -* w3-emacs19.el: Made a few changes to forward and backward movement among - links. Still a few bugs, but can now find links in headers. - -Mon Jun 28 12:46:09 1993 William M. Perry (wmperry@indiana.edu) -* Added the variables w3-link-start-delimiter and - w3-link-end-delimiter so you don't have to edit the code to surround - links with something other than '[[' and ']]'. Thanks to Andrew - Violett (violett@indiana.edu) for suggesting this. - -Sun Jun 27 14:54:50 1993 William M. Perry (wmperry@indiana.edu) -* w3-parse.el (w3-balance-pre): added this function to insert missing - /PRE tags. Several documents on info.cern.ch leave these out and - cause the browser to crash (args out of range -5,1 or some such). -* w3.el (w3-quit): Fixed bug if running in emacs19 without X, would cause - terminal to lock up indefinitely. -* w3.el: w3-view-url now takes optional argument no-show. If you pass it - an argument from a lisp function, it will return the current url without - message'ing it in the minibuffer. -* w3-(lucid|emacs|emacs19|epoch).el: w3-view-this-url now acts the same as - w3-view url (doesn't flash the url in the minibuffer). -* w3-(lucid|emacs19).el: Added some items to the menu, and a separator - between the links lists and the normal commands. - -Sat Jun 26 11:47:52 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: slight modifications. Nothing really noticeable. -* w3-print.el (w3-print-this-url): fixed this so ftp files will print - correctly. Also had to change w3-file. - -Thu Jun 24 09:02:23 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el (w3-parse-buffer): Check to see if a url is already in the - history list before storing. (Also check for bogus ones like - file:historylist. -* w3-misc.el (w3-show-history-list): Added this function to show the - history list to the user in hypertext form. I just use w3-history list - and make a hypertext buffer of it on the fly. Thanks to Matthew Newhook - (matthew@jeeves.engr.mun.ca) for suggesting it. -* w3-url.el: no longer store the URL in the history list here. Do it in - w3-parse-buffer so I can store the TITLE of the document also. - -Tue Jun 22 10:18:54 1993 William M. Perry (wmperry@indiana.edu) -* w3.el (w3-document-source): Fixed stupid problem where I put http in - twice when building url of current document. Thanks to Denys Duchier - (dduchier@csi.uottawa.ca) for noticing/fixing it. - -Mon Jun 21 12:38:23 1993 William M. Perry (wmperry@indiana.edu) -* w3-url.el (w3-telnet): Will actually work now. Was bombing when the url - was not of the form username@hostname:port. Would try to extract the - username, even though it wouldn't exist. Thanks to Phil Molloy - (Molloyd@ICD.Teradyne.COM) for noticing it. -* w3-parse.el (w3-build-links-list): Fixed a problem where a newline right - after after the > in a url would cause the text of the link not to show - up. Thanks to Dirk Husemann (Dirk.Husemann@Informatik.Uni-Erlangen.De) - for the code to fix it (slightly modified). -* w3.el (w3-doc-variables): Moved a paren in w3-doc-variables so that - w3-xterm will be documented. Thanks to Denys Duchier - (dduchier@csi.uottawa.ca) for noticing. -* w3-misc.el (w3-uncompress): Changed this so it actually works. Was - passing a list instead of the cdr to the shell-command. Thanks to - Phil Molloy (Molloyd@ICD.Teradyne.COM) for noticing. - -Sun Jun 20 08:14:28 1993 William M. Perry (wmperry@indiana.edu) -* w3.el: Added function to store the current URL in the kill ring. Thanks - to Mark Eichin (eichin@cygnus.com) for the idea/code. -* w3.el: Changed w3-help so that it will work under emacs 19. -* w3-emacs19.el: only require lmenu & lucid when in X, otherwise emacs - compiled without X will die. Thanks to Erik Ostrom - (eostrom@fiicmds04.tu-graz.ac.at) for noticing it. -* w3.el: only call w3-build-menu if in emacs19 & in x . . . -* w3.el: Changed searching code so that it replaces all spaces with '+'. - Was causing some servers to time out if it didn't. Thanks to Jin S Choi - (jsc@monolith.mit.edu) for pointing this out. -* w3-parse.el: added a check in w3-fix-paragraphs and - w3-build-ordered-lists to see if emacs19 is running. If so, add an - extra newline, since v19 seems to fill paragraphs differently than the - other flavors. -* w3-emacs.el: added (defvar w3-default-style nil), so the code that hides - HREF's with no links won't barf. -* w3-emacs19.el: changed 1 line defuns to defsubst, since function calls - are expensive. -* w3-emacs19.el: Finding of #linknum should work now . . . no map-extents - in the lucid emulation package - will probably write one later. -* w3-emacs19.el: Wrapped all the font stuff in an (if (eq window-system 'x) - so it wouldn't barf if emacs19 was loaded while emacs was on a dumb - terminal. -* w3.el: added variable w3-running-FSF19, and have it load w3-emacs19.el - if set to t. (Determined by emacs-version > 19, and not running lucid) - -Sat Jun 19 16:09:28 1993 William M. Perry (wmperry@indiana.edu) -* w3-emacs19.el: Changed bindings on the mouse buttons to react to a - mouse-up event instead of the mouse-down event, because it would try to - paste into the buffer on the mouse-up. Bleah. :) -* w3-url.el: Modified the ftp: support so that it will parse out html - files, and will also be able to follow relative links within ftp'd html - docs. - -Sat Jun 19 10:01:45 1993 William M. Perry (wmperry@indiana.edu) -* Fix stupid bugs in Makefile from where I delete some things when - it was on my linux box -* Support for some ISO chars by Ulrich Pfeifer - (pfeifer@ls6.informatik.uni-dortmund.edu). - -Fri Jun 18 13:03:12 1993 William M. Perry (wmperry@indiana.edu) -* Release v.5b - -Thu Jun 17 14:58:32 1993 William M. Perry (wmperry@indiana.edu) -* Better emacs 19 support from jsc@monolith.MIT.EDU -* URLS that are just for reference (no HREF, but has a title) are no longer - highlighted, so people won't be tempted to click on them. Thanks to - Erik Ostrom (eostrom@fiicmds04.tu-graz.ac.at) for pointing this out. - -Fri Jun 11 12:14:47 1993 William M. Perry (wmperry@indiana.edu) -* Fixed problem with PRE handling - would fill paragraphs and replace - spaces. Stupid misplacement of a 't'. -* Added .gz extension for gzip to w3-uncompressor-alist -* Trial run of emacs 19 support for fonts, etc from Jin S Choi - (jsc@monolith.MIT.EDU). Not sure everything works yet. - -Mon Jun 7 12:42:48 1993 William M. Perry (wmperry@indiana.edu) -* Fixed printing from local files. -* Added variables w3-telnet-prog and w3-telnet-header-length, for using - things like telnet+term from linux. - -Thu Jun 3 13:34:48 1993 William M. Perry (wmperry@indiana.edu) -* Fixed problems with gopher, and unhexing of escaped characters. Thanks - to Larry Masinter (masinter@parc.xerox.com) for the patches. -* Beginning of emacs-19 support - not functional yet though. Feel free to - fix it. :) -* More stuff with w3-continuation, etc, etc. -* Added (require 'nntp) - -Fri May 28 14:06:27 1993 William M. Perry (wmperry@indiana.edu) -* Fixed w3-print. - -Mon May 17 12:55:45 1993 William M. Perry (wmperry@indiana.edu) -* Can now specify uncompressors in an assoc list -* Added better handling of stringing things along (ie: uncompress, - convert, then print, etc etc) - -Fri May 7 08:52:30 1993 William M. Perry (wmperry@indiana.edu) -* Release .31b -* Fixed major problem with w3-fetch. Would bomb with stringp = nil if - done interactively. - -Mon May 3 08:16:35 1993 William M. Perry (wmperry@indiana.edu) -* Can now print the url under point - no key binding yet. -* Added the ability to store a gopher link into the hotlist - thanks - to scott snyder (snyder@fnald0.fnal.gov) for patching gopher-mode to - support this. No key binding yet. -* Added the 'links' menu back into lucid emacs. - -Fri Apr 30 11:56:57 1993 William M. Perry (wmperry@indiana.edu) -* Fixed a problem with viewing local files with w3-viewer-alist - -Thu Apr 29 11:43:13 1993 William M. Perry (wmperry@indiana.edu) -* w3-fetch now defaults to the url of the current document if the - document you invoke it from is in w3-mode. -* Added ability to find links of just #link - doesn't need to reload - the whole document. -* Applied several patches fro Alastair Burt (burt@dfki.uni-kl.de) - * Better updating of menu bar in Lucid - * Updates the interal w3-hotlist when you delete a hotlist entry - * Problem with the w3-viewer-alist - it tried to play - Something.Thesaurus -* Fixed problems with w3-graphics-converter-alist, and lots of - problems with the w3-hypertext-extns. -* Fixed problem with finding files for dired-mode - would still try to - do the viewing, etc. - -Wed Apr 28 07:23:56 1993 William M. Perry (wmperry@indiana.edu) -* Fixed problem with dired-ing remote ftp files. Removed lots of - useless if file-directory-p [...], and just did a find-file - let - ange-ftp and dired take care of it - they know how better. -* Fixed problem where w3-epoch-frob-resources would not set the - defaults if no Xresources were specified - thanks to Luis Miguel - Silveira (lms@rle-vlsi.mit.edu) for noticing it. -* Changed the w3-delimit-links variable so that you can specify - 'linkname as its value, and have the old style "Link text - here[link#here]" style of showing links. Nil shows nothing, - non-nil, non-linkname shows [[ & ]] around link text. - -Tue Apr 27 15:37:18 1993 William M. Perry (wmperry@indiana.edu) -* Fixed problem in gopher handling - if no port was specified, it - would get completely confused. - -Mon Apr 26 17:06:33 1993 William M. Perry (wmperry@indiana.edu) -* v.2b -* Fixed problem with putting remote dirs into dired-mode with a bad - default-filename. Thanks to Larry Masinter - (masinter@parc.xerox.com) for noticing, and for the fix. -* Added newest nntp.el to the extras tar file -* Fixed problem where w3-current-last-buffer was not set correctly - when reading news. -* Added support for news: links - single articles as well as whole - groups are supported. - -Sun Apr 25 15:36:55 1993 William M. Perry (wmperry@indiana.edu) -* Fixed recursive make install bug - thanks to Larry Masinter - (masinter@parc.xerox.com) for noticing it. -* Fixed problem with no default gopher object type. Thanks to Larry - Masinter (masinter@parc.xerox.com) for noticing it. -* Fixed problem with no default gopher port. -* Fixed the auto-documenter so that it would insert "M-x funcname" - if no bindings were found in the keymap. Thanks to Larry Masinter - (masinter@parc.xerox.com) for noticing it. -* Fixed problem with w3-file not passing to a viewer correctly. - -Thu Apr 22 13:22:53 1993 William M. Perry (wmperry@indiana.edu) -* Fixed the handling of URL#link finding . . . depends on which - emacs you are using, due to the weirdness of zones, etc, in each. -* Split the files up again. Figure with >2000 lines, it should be - done. :) -* No longer need w3-links-list - store all relevant information in the - data segment of a zone. Changed every function to use this new - structure. - -Wed Apr 21 08:24:35 1993 William M. Perry (wmperry@indiana.edu) -* Added variables w3-use-html2latex, w3-html2latex-prog, and - w3-html2latex-args. If w3-use-html2latex is non-nil, then - w3-html2latex-prog is called in a subprocess with the flags defined - by w3-html2latex-args, with the html source as standard input. - Default is to do my (bad) regular expression matching to convert. - -Tue Apr 20 08:51:19 1993 William M. Perry (wmperry@indiana.edu) -* Can now specify regular expressions as the car of - w3-viewer-assoc-list -* fixed problem where epoch would not defvar the styles - just moved - them out of w3-epoch-frob-resources, and it works. Weird. -* Fixed several bugs in the w3-convert-html-to-latex function - now - handles addresses and & correctly. -* Fixed yet another dumb bug in the insertion of PLAINTEXT in - non-hypertext documents. -* Added w3-member, instead of builtin (or predefined) member, since - some definitions don't use equal for comparison like they are - supposed to. - -Mon Apr 19 07:48:56 1993 William M. Perry (wmperry@indiana.edu) -* v.1b -* Added LaTeXing of w3 documents, and automatic printing. Just an - edit of the sed script to be a lot of replace-regexps, then a shell - command to latex a temp file and print it out. -* Added w3-goto-last-buffer, which will take you to the last buffer - you visited before (kind of like gopher-mode). Changed w3-quit to - use this also. -* Fixed a bug in w3-reload-document that would make it bomb on local - file reloads. -* Better nesting of lists. - -Sun Apr 18 13:50:38 1993 William M. Perry (wmperry@indiana.edu) -* Added variable w3-mutable-windows - if t, w3 pops up buffers in - another window. -* Added a default-style for w3 buffers - -Wed Apr 14 10:18:01 1993 William M. Perry (wmperry@indiana.edu) -* Fixed several problems with the epcoh Xresources reading code -* Added global history, for compatability with xmosaic -* Added deletion of hotlist entries -* Changed w3-viewer-alist to automatically include the auto-mode-alist -* Viewers can now include lisp calls (ie: ("txt" . view-mode)) to put - in files. -* file:// links will now put directories in dired-mode. Thanks to - eostrom@nic.gac.edu for the fixes. -* Finally fixed relative-links - .. & . are removed correctly -* Fixed relative links for graphics also. - -Tue Apr 13 08:30:58 1993 William M. Perry (wmperry@indiana.edu) -* Added support for reading Xdefaults within Epoch. -* v.04b -* Fixed graphic support to work over http links (Epoch Only) -* Fixed graphic support so it will figure out if the conversion failed - or not - warning message if it did. - -Mon Apr 12 07:35:40 1993 William M. Perry (wmperry@indiana.edu) -* v.03b -* Fixed lemacs support so it doesn't nuke your xdefaults. Also fixed - the passing of face-objects, since they are screen-specific, and - therefore a Bad Thing. Thanks to Jamie Zawinski (jwz@lucid.com) -* Changed menu code so that it put the link # in there also. Helpful - for when the links are unnamed, or named 'here' or 'this'. Thanks - to Jamie Zawinski (jwz@lucid.com) for saying the menus were hosed. - -Sun Apr 11 16:30:44 1993 William M. Perry (wmperry@indiana.edu) -* Fixed graphics support for epoch - would only do 1 image per page. -* Fixed a few typos - thanks to eostrom@nic.gac.edu - -Fri Apr 9 00:18:47 1993 William M. Perry (wmperry@indiana.edu) -* Added graphics support for epoch (doesn't work over http, pretty - much hardwired for me right now - commented out in the release) -* v.02b -* Several bug fixes (link finding, name fixing, others) - thanks to - eostrom@nic.gac.edu for the fixes. -* Added eostrom@nic.gac.edu's zone-imitation functions for normal emacs. - Also wrote corresponding forward&back link code. I wrote the forward& - back code for epoch&lemacs. - -Thu Apr 8 13:23:27 1993 William M. Perry (wmperry@indiana.edu) -* Fixed being able to jump forward over non-links in []s. Thanks to - eostrom@nic.gac.edu -* Fixed telnet handling - thanks to eostrom@nic.gac.edu for noticing - it and for a preliminary fix. Refined his fix. Problem was that - telnet wasn't getting enough time to start before I sent it a - command. -* Fixed a few regular expressions - thanks to eostrom@nic.gac.edu -* Fixed bug in w3-add-document-hotlist which caused an error if the - hotlist file didn't already exist. Thanks to eostrom@nic.gac.edu - for noticing it. - -Wed Apr 7 00:08:53 1993 William M. Perry (wmperry@indiana.edu) -* Split the files into 4 different files for easier editing. -* Modified Makefile to work with the new file structure. -* Fixed a problem with the links code that cropped up with blank HREFS -* HREFs of the form .....#link will now go to 'link' within the target - document. -* v.01beta - fourth release -* Can now type #### RETURN to go the the ###th link in the current buffer. -* Fixed a bug in XMP handling -* Fixed bugs in the logical/physical styles in definition lists -* Improved indentation of all lists -* Wrapped (require 'ange-ftp) in a (not noninteractive) so it wouldn't - screw up the compiles. -* Fixed a few problems in the Makefile -* Revamped the way it looks for links in dumb emacs mode. (Actually, - all I did was add a .* to the beginning and a parenthesized part of - the regexp - real rough. :) -* Added support for physical and logical styles. Looks great in lucid, - not so hot in epoch (had to use colors, not actual styles). Suggestions - welcome. - -Tue Apr 6 21:14:14 1993 William M. Perry (wmperry@indiana.edu) -* Supports nested definition lists (only 1 deep, and only in ordered lists) -* Now supports nested lists (only 1 deep, and only inside ordered lists) - -Mon Apr 5 13:34:00 1993 William M. Perry (wmperry@indiana.edu) -* v.008beta - third release -* Fixed ADDRESS support -* Added auto-documentation features. -* Added ordered list support - does not support nested lists at all yet. -* Added automatic bug submission -* Added popup-menu for lucid emacs -* Added support for links nested in headers. -* v.007beta - second release -* Revamped local files - now use file:/ instead of nonstandard local:/ -* Added better handling of definition lists. (No support for Compact - ones now though) - -Fri Apr 2 10:28:08 1993 William M. Perry (wmperry@indiana.edu) -* Definition lists now keep their zones/extents so they are highlighted - correctly. -* Fixed bug in PRE handling - left out a (goto-char (point-min)) - -Wed Mar 31 08:51:04 1993 William M. Perry (wmperry@indiana.edu) -* Did work on resolving ./ & ../ links (only works for one level right - now. Will work on getting it recursive later. -* Changed data field in extents/zones to be (w3 . type) so I - wouldn't grab a wrong item. -* Fixed a bug in title handling. Left something out of an if - statement and it would try to delete a region that (probably) didn't - exist. -* Fixed bug in w3-follow-link (added a ':' to end of regexp). Would - cause it to screw up on a url like http.html. Thanks to Erik Ostrom - (eostrom@nic.gac.edu) -* Changed requires to autoloads where possible -* Wrapped require of transparent.el so it won't get loaded if in X -* Fixed bug in lemacs mouse links. -* Applied numerous patches from har@cs.cmu.edu & jwz@lucid.com to fix - compilation problems with lemacs & epoch. - -Tue Mar 30 15:05:01 1993 William M. Perry (wmperry@indiana.edu) -* Added mouse support for following links in epoch & lucid emacs - Store the link # in the data segment of the zone. If mouse is - clicked in a zone, extract the data, assoc it with w3-links-list and - call w3-follow-link with it. Hacky but works. :) -* Added (provide 'w3) for easier loading, etc. -* Fixed problems with epoch highlihting -* Fixed makefile problem (some files left out) - -Sun Mar 28 13:04:12 1993 William M. Perry (wmperry@indiana.edu) -* Added auto-viewing of ps/gif/jpg/etc files -* Added uncompression and gunzipping auto-recognition - -Sat Mar 27 12:32:54 1993 William M. Perry (wmperry@indiana.edu) -* v.004beta - first release -* Few changes to the parser -* Fixed PRE Handling so it parses out urls inside. -* Added handling of &#XXX to insert ascii value of XXX. - -Fri Mar 26 11:27:52 1993 William M. Perry (wmperry@indiana.edu) -* Completed document source command. -* Changed it so it won't barf if you try to fetch the same document twice. -* Added w3-reload-document to reload the current file. - -Wed Mar 24 16:37:22 1993 William M. Perry (wmperry@indiana.edu) -* v.003beta - put on ftp archive -* Added support for the xmosaic style of hotlist. Goto and add are - supported. -* Changed searching a little -* Fixed bug in XMP/PRE handling that reinserted everything in all caps. - Was very annoying. -* Added lemacs menu of hotlist items. - -Tue Mar 23 08:46:12 1993 William M. Perry (wmperry@indiana.edu) -* v.002beta - put on ftp archive -* Added menus to the lucid emacs code. Looks a little weird when - links are named 'here', but not bad. -* Added to the searching code -* Fixed bug in renumbering system (forgot to increment bogus-num) -* Completely rewrote the parser (yet again). Finally got the HTML - specs, so it now handles every item possible (hopefully). -* Added support for small things like DL COMPACT, PLAINTEXT, PRE. -* Added code to delete outdated information (HEADER, BODY, etc) -* Added w3-preview-this-buffer, which feeds the current buffer into - the w3-preprocessor and spits out a formatted buffer. I use this - mainly to see if I can break anything, but might be useful when - writing real html documents. -* Added code to delete useless (to us) HTML headers (NEXTID, etc) -* Added support for index searching. Mode line is changed to reflect - this. Need to use something more noticeable though. - -Mon Mar 22 07:43:10 1993 William M. Perry (wmperry@indiana.edu) -* Broke highlighting in definition lists. Not sure how to get around - this and still have the DLs formatted correctly. -* Little tweaks -* Cleaned up ^Ms that appeared sometimes -* Added a default port for http links (http://moose/info instead of - http://moose:80/info) - -Sun Mar 21 13:44:02 1993 William M. Perry (wmperry@indiana.edu) -* Forgot to include Menu and DL lists, added them. -* Added support for embedded plain text (XMP directive) -* Added 'cacheing' of old info - just made variables buffer-local, and - save them before kill-all-local-variables, then restore. Need to figure - out some way to kill old buffers (only keep last 5, etc) -* Fine tuned local file support -* Added ftp support - just a link to ange-ftp -* Fixed unNAMEd links yet again - should work better -* Added support for lucid emacs & epoch (highlight links, headers,etc) - Borrowed code from html-mode.el by marca@ncsa.uiuc.edu -* "Fixed" unNAME'd links. Big Kludge. Needs work. - -Sat Mar 20 14:10:12 1993 William M. Perry (wmperry@indiana.edu) -* v.001beta -* Complete rewrite of the parsing code. Still not pretty, but much - faster, better paragraph filling. -* Defined w3-mode -* Forward and backward searching for links - still needs lots of work - -Fri Mar 19 08:00:03 1993 William M. Perry (wmperry@indiana.edu) -* v.000alpha -* Support for gopher, telnet, http, and local file access -* First attempt
--- a/lisp/w3/Makefile Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 09:06:37 2007 +0200 @@ -1,3 +1,10 @@ +# 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 @@ -8,19 +15,6 @@ RM = rm -f CP = cp -# where the Info file should go -INFODIR = ../info - -# where the w3 lisp files should go -LISPDIR = $$HOME/lisp -URLDIR = ../url - -# Change this to be where your .emacs file is stored -DOTEMACS = $$HOME/.emacs - -# Where the Emacs-W3 configuration files should be installed -DOTDIR = $$HOME/.w3 - # Change this to be how to convert texinfo files into info files # examples: # $(EMACS) -batch -q -f batch-texinfo-format @@ -38,22 +32,33 @@ # 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-pgp.el url-vars.el url-wais.el urlauth.el mm.el md5.el \ + ssl.el base64.el url.el socks.el + +CUSTOMSOURCES = widget.el widget-edit.el +CUSTOMOBJECTS = $(CUSTOMSOURCES:.el=.elc) +URLOBJECTS = $(URLSOURCES:.el=.elc) + SOURCES = \ - w3.el w3-draw.el w3-e19.el w3-mule.el w3-parse.el w3-print.el \ + w3.el w3-display.el w3-e19.el w3-parse.el w3-print.el \ w3-vars.el w3-xemac.el w3-style.el w3-about.el w3-hot.el \ - w3-toolbar.el font.el w3-sysdp.el \ - w3-annotat.el w3-auto.el w3-forms.el images.el w3-imap.el \ - w3-emulate.el w3-menu.el w3-keyword.el w3-mouse.el widget.el \ - widget-edit.el w3-widget.el w3-speak.el w3-prefs.el w3-latex.el + w3-toolbar.el font.el w3-sysdp.el w3-annotat.el w3-auto.el \ + w3-forms.el images.el w3-imap.el w3-emulate.el w3-menu.el \ + w3-keyword.el w3-mouse.el w3-widget.el w3-speak.el w3-prefs.el \ + w3-latex.el dsssl.el css.el mule-sysdp.el $(CUSTOMSOURCES) \ + $(URLSOURCES) OBJECTS = \ - w3.elc w3-draw.elc w3-e19.elc w3-mule.elc w3-parse.elc \ - w3-print.elc w3-vars.elc w3-xemac.elc w3-style.elc \ - w3-about.elc w3-hot.elc \ + w3.elc w3-display.elc w3-e19.elc w3-parse.elc w3-print.elc \ + w3-vars.elc w3-xemac.elc w3-style.elc w3-about.elc w3-hot.elc \ w3-toolbar.elc font.elc w3-annotat.elc w3-auto.elc \ w3-forms.elc images.elc w3-imap.elc w3-emulate.elc w3-menu.elc \ - w3-keyword.elc w3-mouse.elc widget.elc widget-edit.elc \ - w3-widget.elc w3-speak.elc w3-prefs.elc w3-latex.elc + w3-keyword.elc w3-mouse.elc w3-widget.elc w3-speak.elc \ + w3-prefs.elc w3-latex.elc css.elc dsssl.elc mule-sysdp.elc \ + $(CUSTOMOBJECTS) $(URLOBJECTS) DISTFILES = Makefile ChangeLog $(SOURCES) w3.txi docomp.el \ clean-cache default.css @@ -61,31 +66,22 @@ .SUFFIXES: .elc .el .el,v .el.elc: - URLDIR=$(URLDIR) $(EMACS) $(BATCHFLAGS) $(DEPS) \ - -f batch-byte-compile $< + $(EMACS) $(BATCHFLAGS) $(DEPS) -f batch-byte-compile $< -w3: $(URLDIR) docomp.el $(OBJECTS) +w3: docomp.el $(OBJECTS) @echo Build of w3 complete... -$(URLDIR): - @echo "Please install the URL package in $(URLDIR) first." - @/bin/false - -all: w3.info w3 emacs +all: w3.info w3 install: all - @echo Installing in $(LISPDIR) - $(INSTALL) -d $(LISPDIR) - $(INSTALL) -m 644 $(SOURCES) $(OBJECTS) $(LISPDIR) - $(INSTALL) -d $(INFODIR) - $(INSTALL) -m 644 w3.info* $(INFODIR) - $(INSTALL) -d $(DOTDIR) - $(INSTALL) -m 644 default.css $(DOTDIR)/stylesheet - -emacs: - @echo Adding w3 setup to $(DOTEMACS) - URLDIR=$(URLDIR) $(EMACS) -batch -q -l docomp.el -f hack-dot-emacs \ - $(DOTEMACS) $(LISPDIR) $(URLDIR) + @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 w3.info* $(infodir) + $(INSTALL) -m 644 default.css $(confdir)/stylesheet + $(INSTALL) -m 644 html32.dsl $(confdir)/ clean: $(RM) $(OBJECTS) @@ -101,3 +97,6 @@ w3.cps w3.fns w3.kys w3.pgs w3.tps w3.vrs \ w3.log w3.toc w3.aux +w3-display.elc: w3-display.el css.el font.el w3-imap.el +css.elc: css.el font.el +w3.elc: css.el w3-vars.el
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/base64.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,193 @@ +;;; base64.el,v --- Base64 encoding functions +;; Author: wmperry +;; Created: 1996/04/22 15:08:08 +;; Version: 1.7 +;; Keywords: extensions + +;;; LCD Archive Entry: +;;; base64.el|William M. Perry|wmperry@cs.indiana.edu| +;;; Package for encoding/decoding base64 data (MIME)| +;;; 1996/04/22 15:08:08|1.7|Location Undetermined +;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 Free Software Foundation, Inc. +;;; Copyright (c) 1995, 1996 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, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Base 64 encoding functions +;;; This code was converted to lisp code by me from the C code in +;;; ftp://cs.utk.edu/pub/MIME/b64encode.c +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar base64-code-string + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + "Character set used for base64 decoding") + +(defvar base64-decode-vector + (let ((vec (make-vector 256 nil)) + (i 0) + (case-fold-search nil)) + (while (< i 256) + (aset vec i (string-match (regexp-quote (char-to-string i)) + base64-code-string)) + (setq i (1+ i))) + vec)) + +(defvar base64-max-line-length 64) + +;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63))) +;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63))) +;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63))) +;(defun b3 (x) (aref base64-code-string (logand x 63))) + +(defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63)))) +(defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63)))) +(defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63)))) +(defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63)))) + +(defun base64-encode (str) + "Do base64 encoding on string STR and return the encoded string. +This code was converted to lisp code by me from the C code in +ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns a string that is +broken into `base64-max-line-length' byte lines." + (or str (setq str (buffer-string))) + (let ((x (base64-encode-internal str)) + (y "")) + (while (> (length x) base64-max-line-length) + (setq y (concat y (substring x 0 base64-max-line-length) "\n") + x (substring x base64-max-line-length nil))) + (setq y (concat y x)) + y)) + +(defun base64-encode-internal (str) + "Do base64 encoding on string STR and return the encoded string. +This code was converted to lisp code by me from the C code in +ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns the entire string, +not broken up into `base64-max-line-length' byte lines." + (let ( + (word 0) ; The word to translate + w1 w2 w3 + ) + (cond + ((> (length str) 3) + (concat + (base64-encode-internal (substring str 0 3)) + (base64-encode-internal (substring str 3 nil)))) + ((= (length str) 3) + (setq w1 (aref str 0) + w2 (aref str 1) + w3 (aref str 2) + word (logior + (lsh (logand w1 255) 16) + (lsh (logand w2 255) 8) + (logand w3 255))) + (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word))) + ((= (length str) 2) + (setq w1 (aref str 0) + w2 (aref str 1) + word (logior + (lsh (logand w1 255) 16) + (lsh (logand w2 255) 8) + 0)) + (format "%c%c%c=" (b0 word) (b1 word) (b2 word))) + ((= (length str) 1) + (setq w1 (aref str 0) + word (logior + (lsh (logand w1 255) 16) + 0)) + (format "%c%c==" (b0 word) (b1 word))) + (t "")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Base64 decoding functions +;;; Most of the decoding code is courtesy Francesco Potorti` +;;; <F.Potorti@cnuce.cnr.it> +;;; this is much faster than my original code - thanks! +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun base64-decode-region (beg end) + (interactive "r") + (barf-if-buffer-read-only) + (let + ((exchange (= (point) beg)) + (endchars 0) + (list) (code)) + (goto-char beg) + (while (< (point) end) + (setq list (mapcar + (function + (lambda (c) + (cond + ((aref base64-decode-vector c)) + ((char-equal c ?=) + (setq endchars (1+ endchars)) + 0) + (nil + (error + "Character %c does not match Mime base64 coding" c))))) + (buffer-substring (point) (+ (point) 4)))) + (setq code (+ (nth 3 list) (lsh (nth 2 list) 6) + (lsh (nth 1 list) 12) (lsh (car list) 18))) + (delete-char 4) + (cond + ((zerop endchars) + (insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256))) + ((= endchars 1) + (insert (% (lsh code -16) 256) (% (lsh code -8) 256)) + (setq end (point))) + ((= endchars 2) + (insert (% (lsh code -16) 256)) + (setq end (point)))) + (if (char-equal (following-char) ?\n) + (progn (delete-char 1) + (setq end (- end 2))) + (setq end (1- end)))) + )) +; (if exchange +; (exchange-point-and-mark)))) + +(defun base64-decode (st &optional nd) + "Do base64 decoding on string STR and return the original string. +If given buffer positions, destructively decodes that area of the +current buffer." + (let ((replace-p nil) + (retval nil)) + (if (stringp st) + nil + (setq st (prog1 + (buffer-substring st (or nd (point-max))) + (delete-region st (or nd (point-max)))) + replace-p t)) + (setq retval + (save-excursion + (set-buffer (get-buffer-create " *b64decode*")) + (erase-buffer) + (insert st) + (goto-char (point-min)) + (while (re-search-forward "\r*\n" nil t) + (replace-match "")) + (goto-char (point-min)) + (base64-decode-region (point-min) (point-max)) + (buffer-string))) + (if replace-p (insert retval)) + retval)) + +(provide 'base64)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/css.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,786 @@ +;;; css.el -- Cascading Style Sheet parser +;; Author: wmperry +;; Created: 1996/12/26 16:49:58 +;; Version: 1.18 +;; Keywords: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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 + [font-family nil string-list] + [font-style nil string] + [font-variant nil symbol-list] + [font-weight nil weight] + [font-size nil length] + [font nil font] + [color nil color] + [background nil color] + [word-spacing nil length] ; CBI + [letter-spacing nil length] ; CBI + [text-decoration nil symbol-list] + [vertical-align nil symbol] ; CBI + [text-transform nil string] + [text-align t symbol] + [text-indent t length] ; NYI + [line-height t length] ; CBI + [margin nil margin] + [margin-left nil margin] + [margin-right nil margin] + [margin-top nil margin] + [margin-bottom nil margin] + [padding nil padding] + [padding-left nil padding] + [padding-right nil padding] + [padding-top nil padding] + [padding-bottom nil padding] + [border nil border] + [border-left nil border] + [border-right nil border] + [border-top nil border] + [border-bottom nil border] + [width nil length] ; NYPI + [height nil length] ; NYPI + [float nil symbol] + [clear nil symbol] + [display nil symbol] + [list-style t symbol] ;!! can't specify 'inside|outside' + [white-space t symbol] + + ;; These are for specifying speech properties + [voice-family t string] + [gain t integer] + [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.") + +(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.") + +(defvar css-ie-compatibility t + "Whether we want to do Internet Explorer 3.0 compatible parsing of +CSS stylesheets.") + +(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 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)) + (error "Malformed font shorthand: %s" font)) + (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 (setq retval (cons (cons 'font-weight weight) retval))) + (if size (setq retval (cons (cons 'font-size size) retval))) + (if height (setq retval (cons (cons 'line-height height) retval))) + (if family (setq retval (cons (cons 'font-family family) retval))) + retval)) + +(defun css-expand-length (spec) + (cond + ((not (stringp spec)) spec) + ((string-equal spec "auto") nil) + ((string-match "\([0-9]+\)%" spec) ; A percentage + nil) + ((string-match "\([0-9]+\)e[mn]" spec) ; Character based + (string-to-int (substring spec (match-beginning 1) (match-end 1)))) + (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)) + +(defun css-expand-color (color) + (cond + ((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)))) + ((string-match "url *(\\([^ )]+\\) *)" color) + ;; A picture in the background + (let ((pixmap (match-string 1 color)) + (attributes nil)) + (setq color (concat (substring color 0 (match-beginning 0)) + (substring color (match-end 0) nil)) + attributes (split-string color " ")) + ) + ) + (t + ;; Hmmm... pass it through unmangled and hope the underlying + ;; windowing system can handle it. + ) + ) + color + ) + +(defun css-expand-value (type value) + (case type + ((symbol integer) ; Read it in + (setq value (read (downcase value)))) + (symbol-list + (setq value (downcase value) + value (split-string value "[ ,]+") + value (mapcar 'intern value))) + (string-list + (setq value (split-string value " *, *"))) + (color ; A color, possibly with URLs + (setq value (css-expand-color value))) + (length ; Pixels, picas, ems, etc. + (setq value (css-expand-length value))) + (font ; Font shorthand + (setq value (css-split-font-shorthand value))) + ((margin padding) ; length|percentage|auto {1,4} + (setq value (split-string value "[ ,]+")) + (if (/= 1 (length value)) + ;; More than one value - a shortcut + (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-length (nth 0 value))) + right (cons right (css-expand-length (nth 1 value))) + bottom (cons bottom (css-expand-length (nth 2 value))) + left (cons left (css-expand-length (nth 3 value))) + value (list top right bottom left))) + (setq value (css-expand-length (car value))))) + (border + (cond + ((member (downcase value) '("none" "dotted" "dashed" "solid" + "double" "groove" "ridge" "inset" "outset")) + (setq value (intern (downcase value)))) + ((string-match "^[0-9]+" value) + (setq value (font-spatial-to-canonical value))) + (t nil))) + (weight ; normal|bold|bolder|lighter|[1-9]00 + (if (string-match "^[0-9]+" value) + (setq value (/ (read value) 100) + value (or (nth value css-weights) :bold)) + (setq value (intern (downcase (concat ":" 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 + ) + (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 + (if css-ie-compatibility + (skip-chars-forward "^;") + (skip-chars-forward "^,;")) + (skip-chars-backward " \t") + (point))))))) + (setq value (css-expand-value (get name 'css-type) value)) + (if (eq (get name 'css-type) 'font) + (setq results (append value results)) + (setq results (cons (cons name value) results))) + (skip-chars-forward ";, \n\t")) + results)))) + +(defun css-handle-import () + (let ((url nil) + (save-pos (point))) + (if (looking-at "'\"") + (condition-case () + (forward-sexp 1) + (error (skip-chars-forward "^ \t\r\n;"))) + (skip-chars-forward "^ \t\r\n;")) + (setq url (url-expand-file-name (buffer-substring save-pos (point)))) + (skip-chars-forward "\"; \t\r\n") + (setq save-pos (point)) + (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) + (goto-char save-pos)))) + +(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))) + +(defun css-active-device-types (&optional device) + (let ((types (list 'normal 'default (if css-running-xemacs 'xemacs 'emacs))) + (type (device-type device))) + (cond + ((featurep 'emacspeak) + (setq types (cons 'speech types))) + ((eq type 'tty) + (if (and (fboundp 'tty-color-list) + (/= 0 (length (tty-color-list)))) + (setq types (cons 'ansi-tty types)) + (setq types (cons 'tty types)))) + ((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)))) + 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 (fname &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) + (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 fname (url-insert-file-contents fname)) + (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, and we are doing IE compatibility + ((and (looking-at "//") css-ie-compatibility) + (end-of-line)) + ;; Pre-Processor directives + ((looking-at "[ \t\r]*@\\([^ \t\r\n]\\)") + (let ((directive nil)) + (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 (buffer-substring save-pos (point))) + (skip-chars-forward " \t\r") ; Past any trailing whitespace + (setq save-pos (point)) + (cond + ((string= directive "import") + (css-handle-import)) + (t + (message "Unknown directive in stylesheet: @%s" directive))))) + ;; Giving us some output device information + ((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)))) + (end-of-line) + (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)
--- a/lisp/w3/default.css Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/default.css Mon Aug 13 09:06:37 2007 +0200 @@ -17,6 +17,7 @@ ** There are a few special Emacs-W3 sections ** ** emacs - only include this chunk if you are using Emacs 19 +** speech - only include this chunk if you are using Emacspeak for audio ** xemacs - only include this chunk if you are using XEmacs ** normal - always include this chunk (useful for switching out of another ** device-type block @@ -39,12 +40,11 @@ */ :xemacs: - h1 { font-size : +10pt } + h1 { font-size : +12pt } h2 { font-size : +6pt } - h3 { font-size : +3pt } - h4 { } /* Do nothing, normal sized font, just bold */ - h5 { font-size : -3pt } - h6 { font-size : -6pt } + h3 { font-size : +4pt } + h5 { font-size : -2pt } + h6 { font-size : -4pt } /* ** Emacs-19 also doesn't handle how Emacs-W3 changes this type of font @@ -52,7 +52,7 @@ ** do monospaced fonts anyway, so its redundant. */ pre,xmp, - plaintext { font-family: monospace; display: block } + plaintext { font-family: monospace } key,code,tt { font-family: monospace } /* @@ -74,24 +74,30 @@ :normal: p { display: block } + pre,xmp { display: block; white-space: pre; } +blockquote{ display: block; margin-left: 5; margin-right: 5; } /* ** List formatting instructions */ - dl,ul,ol { - display: block; - margin-left: 5em - } + ul { display: block; } + ol { display: block; } + dl { display: block; } + dt { font-weight: bold; display: list-item } + dd { display: list-item; margin-left: 5; } + li { display: list-item; margin-left: 5; } + ul li { list-style: circle; } + ol li { list-style: decimal; } - li { display: list-item } - dt { font-weight: bold; display: block } - dd { insert-before: 3em; display: list-item } +/* 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 } @@ -106,13 +112,12 @@ i { font-style: italic } u { text-decoration: underline } blink { text-decoration: blink } - + center { display: line; text-align: center; } /* ** Various and sundry */ - br { display: list-item } - hr { display: list-item } - hr[SRC] { replace: {SRC} } + br { display: line } + hr { display: line; text-align: center; } /* @@ -125,12 +130,20 @@ 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 { align : right } -abstract { font-style : bold & italic ; align : indent } - quote { font-style : italic ; align : indent } + 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 @@ -145,7 +158,6 @@ */ :tty: - /* ** First, handle some stuff for generic TTYs to emulate our old ** behaviour with w3-delimit-links and a subset of w3-delimit-emphasis @@ -153,18 +165,18 @@ h1,h2,h3, h4,h5,h6 { - insert.before: *; - insert.after: * + insert-before: *; + insert-after: * } a:visited{ - insert.before: "{{"; - insert.after: "}}" + insert-before: "{{"; + insert-after: "}}" } a:link { - insert.before: "[["; - insert.after: "]]" + insert-before: "[["; + insert-after: "]]" } /* End Generic TTY */ @@ -200,25 +212,29 @@ :speech: h1,h2,h3, -h4,h5,h6 { voice-family: paul; stress: 8; } - h1 { pitch: 9; pitch-range: 9; } - h2 { pitch: 8; pitch-range: 8; } - h3 { pitch: 7; pitch-range: 7; } - h4 { pitch: 6; pitch-range: 6; } - h5,h6 { pitch: 5; pitch-range: 5; } - li { pitch: 6; richness: 6; } - dt { voice-family: harry; } - dd { pitch: 6; richness: 6; } -pre,xmp, -plaintext { pitch: 1; pitch-range: 1; stress: 1; richness: 9; } -key,code, - tt { pitch: 1; pitch-range: 1; stress: 1; richness: 9; } -strong,em { pitch: 6; stress: 8; pitch-range: 9; } - dfn { pitch: 7; pitch-range: 6; stress: 6; } - s,strike { richness: 9; } - b { pitch: 6; pitch-range: 9; stress: 8; } - i { pitch: 7; pitch-range: 6; stress: 6; } - u { richness: 0; } -a:link { voice-family: harry; } -a:visited { voice-family: betty; } -a:active { voice-family: ursula; } +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: 1; + pitch-range: 1; + stress: 1; + 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 }
--- a/lisp/w3/docomp.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/docomp.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,14 +1,17 @@ (setq load-path (append (list (expand-file-name "./") - (or (getenv "URLDIR") - (expand-file-name "../url"))) + (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 hack-dot-emacs () (interactive) (let* ((args command-line-args-left) (fname (expand-file-name (nth 0 args))) - (lispdir (nth 1 args)) - (urldir (nth 2 args))) + (lispdir (nth 1 args))) (setq command-line-args-left (cdr (cdr (cdr command-line-args-left)))) (set-buffer (get-buffer-create " *x*")) (erase-buffer) @@ -21,8 +24,6 @@ (insert "\n;;; Emacs-w3 configuration options\n") (insert "(setq load-path (cons (expand-file-name \"" lispdir "\") load-path))\n") - (insert "(setq load-path (cons (expand-file-name \"" - urldir "\") load-path))\n") (insert "(autoload 'w3-preview-this-buffer \"w3\" \"WWW Previewer\" t)\n") (insert "(autoload 'w3-follow-url-at-point \"w3\" \"Find document at pt\" t)\n") (insert "(autoload 'w3 \"w3\" \"WWW Browser\" t)\n") @@ -64,6 +65,8 @@ ;; For MULE (w3-declare-variables '*noconv* '*autoconv* '*euc-japan* '*internal* 'w3-mime-list-for-code-conversion 'lc-ltn1 + 'mule-version 'enable-multibyte-characters + 'charset-latin-iso8859-1 'file-coding-system-for-read 'file-coding-system) ;; For Mailcrypt @@ -84,12 +87,15 @@ ;; For emacspeak (w3-declare-variables 'dtk-voice-table 'dtk-punctuation-mode) -;; For a few intern things +;; For a few internal things (w3-declare-variables 'tag 'w3-working-buffer 'proxy-info 'args - 'w3-image-widgets-waiting + 'w3-image-widgets-waiting 'w3-form-info 'w3-last-parse-tree 'command-line-args-left 'standard-display-table 'w3-html-bookmarks - 'widget-keymap) + '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. @@ -102,5 +108,5 @@ (and w3-running-FSF19 (< emacs-minor-version 29) (require 'font)) -(load-library "w3-sysdp") +(require 'w3-sysdp) (provide 'ange-ftp)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/dsssl.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,499 @@ +;;; dsssl.el --- DSSSL parser +;; Author: wmperry +;; Created: 1996/12/18 21:10:58 +;; Version: 1.11 +;; Keywords: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; +;;; 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) + +(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))) + +;; We need to have this up at the top to avoid compilation warnings in +;; 'make' in dsssl-eval. Call me anal. +(defstruct flow-object + (name 'unknown :read-only t) ; Name of this flow object + (properties nil) + (children nil) + (parent nil) + ) + +(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 indentity 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 :name 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)
--- a/lisp/w3/font.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1996/08/11 16:40:36 -;; Version: 1.8 +;; Created: 1997/01/03 16:43:49 +;; Version: 1.22 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,15 +21,16 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-and-compile - (load-library "w3-sysdp") + (require 'w3-sysdp) (require 'cl)) (require 'disp-table) @@ -142,10 +144,54 @@ (defkeyword :registry "Keyword specifying the registry of a FONTOBJ.") (defkeyword :encoding "Keyword specifying the encoding of a FONTOBJ.") +(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." @@ -156,17 +202,18 @@ (, (intern (format "font-%s-mask" attr))))) t nil)) - (defun (, (intern (format "font-set-%s-p" attr))) (fontobj val) + (defun (, (intern (format "set-font-%s-p" attr))) (fontobj val) (, (format "Set whether FONTOBJ will be renderd in `%s' or not." attr)) - (if val - (set-font-style fontobj (| (font-style fontobj) - (, (intern - (format "font-%s-mask" attr))))) - (set-font-style fontobj (logxor (font-style fontobj) - (, (intern - (format "font-%s-mask" - 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)) @@ -205,6 +252,25 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defsubst set-font-style-by-keywords (fontobj styles) + (make-local-variable 'font-func) + (declare (special font-func)) + (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)))) + +(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 unique (list) (let ((retval) (cur)) @@ -228,8 +294,8 @@ w2)))) (defun font-spatial-to-canonical (spec &optional device) - "Convert SPEC (in inches, millimeters, points, or picas) into pixels" - ;; 1 in = 25.4 mm = 72 pt = 6 pa + "Convert SPEC (in inches, millimeters, points, or picas) into points" + ;; 1 in = 6 pa = 25.4 mm = 72 pt (if (numberp spec) spec (let ((num nil) @@ -260,28 +326,19 @@ (setq num (string-to-number spec)) (cond ((member type '("pixel" "px" "pix")) - (setq retval num - num nil)) + (setq retval (* num (/ pix-width mm-width) (/ 25.4 72.0)))) ((member type '("point" "pt")) - (setq retval (+ (* (/ pix-width mm-width) - (/ 25.4 72.0) - num)))) + (setq retval num)) ((member type '("pica" "pa")) - (setq retval (* (/ pix-width mm-width) - (/ 25.4 6.0) - num))) + (setq retval (* num 12.0))) ((member type '("inch" "in")) - (setq retval (* (/ pix-width mm-width) - (/ 25.4 1.0) - num))) + (setq retval (* num 72.0))) ((string= type "mm") - (setq retval (* (/ pix-width mm-width) - num))) + (setq retval (* num (/ 72.0 25.4)))) ((string= type "cm") - (setq retval (* (/ pix-width mm-width) - 10 - num))) - (t (setq retval num)) + (setq retval (* num 10 (/ 72.0 25.4)))) + (t + (setq retval num)) ) retval))) @@ -291,57 +348,21 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun make-font (&rest args) (vector :family - (if (stringp (nth 1 (memq :family args))) - (list (nth 1 (memq :family args))) - (nth 1 (memq :family args))) + (if (stringp (plist-get args :family)) + (list (plist-get args :family)) + (plist-get args :family)) :weight - (nth 1 (memq :weight args)) + (plist-get args :weight) :style - (if (numberp (nth 1 (memq :style args))) - (nth 1 (memq :style args)) + (if (numberp (plist-get args :style)) + (plist-get args :style) 0) :size - (nth 1 (memq :size args)) + (plist-get args :size) :registry - (nth 1 (memq :registry args)) + (plist-get args :registry) :encoding - (nth 1 (memq :encoding args)))) - -(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)) + (plist-get args :encoding))) (defun font-create-name (fontobj &optional device) (let* ((type (device-type device)) @@ -400,7 +421,7 @@ ;;; 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)) @@ -463,28 +484,28 @@ ) (if (not (string-match x-font-regexp-foundry-and-family fontname)) nil - (setq family (list (match-string 1 fontname)))) + (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 (format "%dpt" (/ (string-to-int ptsize) 10)))) + (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 adstyle)))) + (setq family (append family (list (downcase adstyle))))) (setq retval (make-font :family family :weight weight :size size)) - (font-set-bold-p retval (eq :bold weight)) + (set-font-bold-p retval (eq :bold weight)) (cond ((null slant) nil) ((member slant '("i" "I")) - (font-set-italic-p retval t)) + (set-font-italic-p retval t)) ((member slant '("o" "O")) - (font-set-oblique-p retval t))) + (set-font-oblique-p retval t))) retval))) (defun x-font-families-for-device (&optional device no-resetp) @@ -513,8 +534,11 @@ (font-truename (make-font-specifier (face-font-name 'default device))) - (cdr-safe (assq 'font (frame-parameters 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)))) + (defun font-default-object-for-device (&optional device) (let ((font (font-default-font-for-device device))) (or (cdr-safe @@ -543,7 +567,8 @@ (font-registry fontobj) (font-encoding fontobj))) (not (font-bold-p fontobj)) - (not (font-italic-p fontobj))) + (not (font-italic-p fontobj)) + (not (font-oblique-p fontobj))) (face-font 'default) (or device (setq device (selected-device))) (let ((family (or (font-family fontobj) @@ -584,16 +609,22 @@ (if (= ?- (aref cur-family (1- x))) (aset cur-family (1- x) ? )) (setq x (1- x)))) - (setq font-name (format "-*-%s-%s-%s-*-*-%s-*-*-*-*-*-%s-%s" - cur-family weight - (if (font-italic-p fontobj) - "i" - "r") - (if size (int-to-string size) "*") - registry - encoding - ) - done (try-font-name font-name device)))) + ;; 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))))) @@ -604,16 +635,17 @@ ;; 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))) - (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 (unique (nconc scaled normal)) 'string-lessp))))) + (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 (unique (nconc scaled normal)) 'string-lessp)))))) (defun ns-font-create-name (fontobj &optional device) (let ((family (or (font-family fontobj) @@ -626,7 +658,7 @@ ;; Create a font, wow! (if (stringp family) (setq family (list family))) - (if (symbolp style) + (if (or (symbolp style) (numberp style)) (setq style (list style))) (setq weight (font-higher-weight weight (car-safe (memq :bold style)))) (if (stringp size) @@ -655,6 +687,33 @@ (if done font-name)))) +;;; Cache building code +(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. @@ -922,14 +981,14 @@ The variable x-library-search-path is use to locate the rgb.txt file." (let ((case-fold-search t)) (cond - ((font-rgb-color-p color) - (list (* 65535 (font-rgb-color-red color)) - (* 65535 (font-rgb-color-green color)) - (* 65535 (font-rgb-color-blue color)))) - ((and (vectorp color) (= 3 (length color)) (floatp (aref color 0))) + ((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))) @@ -1001,13 +1060,13 @@ is returned." (cond ((eq (device-type device) 'x) - (apply 'format "#%04x%04x%04x" (font-color-rgb-components color))) + (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) ((eq (device-type device) 'tty) (apply 'font-tty-find-closest-color (font-color-rgb-components color))) ((eq (device-type device) 'ns) (let ((vals (mapcar (function (lambda (x) (>> x 8))) (font-color-rgb-components color)))) - (apply 'format "RGB%02x%02x%02ff" vals))) + (apply 'format "RGB%02x%02x%02xff" vals))) (t "black"))) (defun font-set-face-background (&optional face color &rest args)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/html32.dsl Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,888 @@ +<!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))))
--- a/lisp/w3/images.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/images.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; images.el --- Automatic image converters ;; Author: wmperry -;; Created: 1996/06/30 18:00:34 -;; Version: 1.2 +;; Created: 1996/11/14 22:39:11 +;; Version: 1.5 ;; Keywords: images ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1995 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,15 +21,16 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-and-compile - (load-library "w3-sysdp")) + (require 'w3-sysdp)) (defvar image-temp-stack nil "Do no touch - internal storage.") (defvar image-converters nil "Storage for the image converters.")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/md5.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,408 @@ +;;; 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 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) + (or shell-file-name "/bin/sh") + t buffer nil + "-c" 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 (kill-buffer buffer) nil)))) + +(provide 'md5) + +;;; md5.el ends here ----------------------------------------------------------
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/mm.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,1259 @@ +;;; 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 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)) + +(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" . ( + ("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"))) + ("x-www-pem-reply" . + (("viewer" . (w3-decode-pgp/pem "pem")) + ("test" . (fboundp 'w3-decode-pgp/pem)) + ("type" . "application/x-www-pem-reply") + )) + ("x-www-pgp-reply" . + (("viewer" . (w3-decode-pgp/pem "pgp")) + ("test" . (fboundp 'w3-decode-pgp/pem)) + ("type" . "application/x-www-pgp-reply"))) + )) + ("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) + ("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 "/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 (concat "/etc/mailcap:/usr/etc/mailcap:" + "/usr/local/etc/mailcap:" + (expand-file-name "~/.mailcap"))))) + (let ((fnames (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))) + 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 "/bin/sh" nil nil nil "-c" 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") + (".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 (concat (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 (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 (= (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 (or shell-file-name + (getenv "ESHELL") (getenv "SHELL") "/bin/sh") + nil (if usef nil buff) nil "-c" 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 + (mm-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)) + (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)))))))))))) + +;; 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/mule-sysdp.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,160 @@ +;;; mule-sysdp.el --- consolidate MULE-version dependencies in one file. + +;; Copyright (C) 1996 William Perry + +;; Author: William Perry <wmperry@aventail.com> +;; 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) + (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.4 'no-conversion) + (2.3 *noconv*) + (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 (detect-coding-region (point-min) (point-max))) + (xemacs (detect-coding-region (point-min) (point-max))) + (otherwise nil))) + +(defun mule-code-convert-region (st nd code) + (case mule-sysdep-version + (2.3 + (setq 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 (eq code 'coding-system-automatic) + nil + (decode-coding-region st nd code) + (set-buffer-file-coding-system code))) + (xemacs + (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 + ((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 xemacs) + (encode-coding-string str mule-retrieval-coding-system)) + (otherwise + str))) + +(defun mule-decode-string (str) + (and str + (case mule-sysdep-version + ((2.4 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 + (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)) + (xemacs char) + (otherwise char)))) + +(case mule-sysdep-version + ((2.3 2.4 xemacs) nil) + (otherwise (fset 'string-width 'length))) + +(and + (boundp 'MULE) + (not (featurep 'mule)) + (provide 'mule)) + +(provide 'mule-sysdp)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/socks.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,384 @@ +;;; socks.el --- A Socks v5 Client for Emacs +;; Author: wmperry +;; Created: 1996/12/14 06:59:31 +;; Version: 1.2 +;; Keywords: comm, firewalls + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 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)) + (message "Successfully authenticated using: %s" auth-desc) + (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 (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 +;; To enable username/password authentication, uncomment the following +;; lines: +;; +;; (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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/ssl.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,58 @@ +;;; ssl.el,v --- ssl functions for emacsen without them builtin +;; Author: wmperry +;; Created: 1996/05/28 01:20:06 +;; Version: 1.2 +;; Keywords: comm + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar ssl-program-name "ssl %s %s" + "*The program to run in a subprocess to open an SSL connection. +This is run through `format' with two strings, the hostname and port # +to connect to.") + +(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." + (let ((proc (start-process name buffer + "/bin/sh" + "-c" + (format ssl-program-name host + (if (stringp service) + service + (int-to-string service)))))) + (process-kill-without-query proc) + proc)) + +(provide 'ssl)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/todo Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,110 @@ +BUGS: +---- +- <br> in <dd> hosed - margins in general tend to be too big sometimes. +- too much space after an ordered list item - can't fix without + completely screwing up the spacing algorithm. *sigh* +- tags in <title> elements crap out. Check out + http://www.uni-mainz.de/~steffens/html-public/usrguide_3.html#0 for a + sample. +- Interaction with Emacspeak is inexcusably weak + - Need option to turn off table rendering and print it out as a + table that is viewable with emacspeak-table-ui.el + - Reimplement <label> support for form items + - Better/more information stored in each hypertext link + - Better/more information stored in each form entry area +- Need at least bare-bones frames support where you can at least + convert a frameset into a list of destinations and display those for + the user. +- <link> handling should keep track of the 'title' attribute of the link +- sometimes images delete a large chunk of the buffer they are in. Check out + http://cs-www.uchicago.edu/ - seems to be the <img alt=" "> stuff. Ack. +- should use 'editable-field' widget type for 'text' and 'multiline' widgets. +- ebola warnings when using gopher in XEmacs 20.0 +- Resetting a form resets the internal structures, but not the buffer + representation. This one will be ugly. +- cannot save a page as postscript +- cannot dump an XEmacs w/W3 - attempt to modify read-only object. + Apparently a problem somewhere in w3-parse, as if it is reloaded + after dumping, the problem goes away. +- client side imagemaps have to be in the same buffer (actually in the + smae buffer, _BEFORE_ the usemap directive on an image) - fix to be + able to use imagemaps in different files, any position, etc, etc. +- filename handling bug in OS/2 - the c:\ stuff confuses it. +- some way of specifying in a stylesheet whether certain text is + inaudible. use the 'inaudible text property for this. +- w3-fetch should take its prefix arg in the standard way and it + should be documented in the doc string +- Should make cache directory private by default. +- When fetching a compressed file with "C-u RET", W3 seems to uncompress + before saving on disk, but suggests a save file name with the ".gz" + extension. It should either not uncompress in this case, or remove the + ".gz" extension from the suggested save file name. (My personal + preference is that it should not uncompress. Emacs has no trouble + looking at compressed files and they take up less disk space.) +- w3-complete-link ensures that the input matches one of the links, + except for case. If there is a link named "XX", you can enter "xx". + You will then get the error "Wrong type argument: stringp, nil". +- Sometimes widget keybindings get thrown in the minibuffer map. Try M-: C-M-i +- We do not like a separate minibuffer frame at all under Emacs + +FEATURES: +- font.elc is still not cross-emacsen. Damn keyword lossage. +- Widget library merging + - Using {TAB} to move to the next hyperlink moves to the first + character of the line if the hyperlink button is centered. In + such cases, a lot of whitespace can precede the first character of + the link and although the button can be activated from this + whitespace, visually it would make much more sense to move to the + first non-whitespace character within the field. + - Add support for using real images for checkboxes, etc. in widget library + - Clean up the image widget, and make it play nice with emacspeak + - Write a tabcontrol widget and use it for preferences panel + - Write a font selection widget + - Write a voice selection widget + - Write a password entry widget + - Write a mailcap entry widget +- Custom library merging + - Add custom support for W3, URL, MM +- Proxy support + - The URL proxy checking is now able to use a function instead of + using an alist. Perhaps have some basic javascript->elisp converter + so that people can use netscape-style auto-proxy configuration. + - Provide functions comparable to those provided to netscape + javascript proxy auto configuration. See + http://home.netscape.com/eng/mozilla/2.0/relnotes/demo/proxy-live.html +- LaTeX backend + - Stylesheet support + - Table support +- Display code + - Support recommended rendering of <dir> as multi-column + - Support multi-column somehow + - Support <dl compact> + - implement <spacer> from netscape 3.0b5 + - reimplement w3-show-headers + - Handle math environment using the calc library + - Better integration with the paresr + - Better user feedback + - Better incremental display (page-by-page drawing?) +- People want to see size and last-modified of remote ftp directories. + Only if ange-ftp or efs start returning valid data for file-attributes. + Either that, or some integration work needs to happen with dired. Perhaps + a w3-dired-minor-mode that rebinds return, button1-3, etc. hmmmm.... +- Write a new major mode for handling CSS style sheets +- Support the <object> tag +- Deal with frames right +- Add back in the 'host' method for url-gateway-method - perhaps steal + code from GNUS + +MAINTENANCE CRAP +- Create a FAQ +- Revamp the entire documentation + - More info on stylesheets + - Update chapter organization + - Remove old variables + - Add new ones + - General cleanup +- Change w3-download script to point to new XEmacs ftp site +- Revamp the entire web site. +- Do fun things with the new name 'GNET' + - GNETs Not Excessively Tacky + - GNET N'est pas Excessivement Tare'
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-cookie.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,348 @@ +;;; url-cookie.el --- Netscape Cookie support +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.5 +;; Keywords: comm, data, processes, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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) + +(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)) + +(defvar url-cookie-storage nil "Where cookies are stored.") +(defvar url-cookie-secure-storage nil "Where secure cookies are stored.") +(defvar url-cookie-file nil "*Where cookies are stored on disk.") + +(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))) + +(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)))))) + +(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)) + +(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.") + +(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))) + +(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-current-server)) + (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-current-file))) + (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) "]"))) + (cond + ((and (listp url-privacy-level) (memq 'cookies url-privacy-level)) + ;; user never wants cookies + nil) + ((and url-cookie-confirmation + (not (funcall url-confirmation-func + (format "Allow %s to set a cookie? " + url-current-server)))) + ;; user wants to be asked, and declined. + nil) + ((url-cookie-host-can-set-p url-current-server domain) + ;; Cookie is accepted by the user, and passes our security checks + (while rest + (url-cookie-store (car (car rest)) (cdr (car rest)) + expires domain path secure) + (setq rest (cdr rest)))) + (t + (url-warn 'url (format + (concat "%s tried to set a cookie for domain %s\n" + "Permission denied - cookie rejected.\n" + "Set-Cookie: %s") + url-current-server domain str)))))) + +(provide 'url-cookie)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-file.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,288 @@ +;;; url-file.el --- File retrieval code +;; Author: wmperry +;; Created: 1996/12/30 14:25:26 +;; Version: 1.7 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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) nil) + ((file-exists-p (concat fname ".Z")) + (setq fname (concat fname ".Z"))) + ((file-exists-p (concat fname ".gz")) + (setq fname (concat fname ".gz"))) + ((file-exists-p (concat fname ".z")) + (setq fname (concat fname ".z"))) + (t + (error "File not found %s" fname)))) + (if (or (not compressed) url-inhibit-uncompression) + (apply 'insert-file-contents fname args) + (let* ((extn (url-file-extension fname)) + (code (cdr-safe (assoc extn url-uncompressor-alist))) + (decoder (cdr-safe (assoc code mm-content-transfer-encodings)))) + (cond + ((null decoder) + (apply 'insert-file-contents fname args)) + ((stringp decoder) + (apply 'insert-file-contents fname args) + (message "Decoding...") + (call-process-region (point-min) (point-max) decoder t t nil) + (message "Decoding... done.")) + ((listp decoder) + (apply 'call-process-region (point-min) (point-max) + (car decoder) t t t (cdr decoder))) + ((and (symbolp decoder) (fboundp decoder)) + (apply 'insert-file-contents fname args) + (message "Decoding...") + (funcall decoder (point-min) (point-max)) + (message "Decoding... done.")) + (t + (error "Malformed entry for %s in `mm-content-transfer-encodings'" + code)))))) + (set-buffer-modified-p nil)) + +(defun url-format-directory (dir) + ;; Format the files in DIR into hypertext + (let ((files (directory-files dir nil)) file + div attr mod-time size typ title) + (if (and url-directory-index-file + (file-exists-p (expand-file-name url-directory-index-file dir)) + (file-readable-p (expand-file-name url-directory-index-file dir))) + (save-excursion + (set-buffer url-working-buffer) + (erase-buffer) + (insert-file-contents-literally + (expand-file-name url-directory-index-file dir))) + (save-excursion + (if (string-match "/\\([^/]+\\)/$" dir) + (setq title (concat ".../" (url-match dir 1) "/")) + (setq title "/")) + (setq div (1- (length files))) + (set-buffer url-working-buffer) + (erase-buffer) + (insert "<html>\n" + " <head>\n" + " <title>" title "</title>\n" + " </head>\n" + " <body>\n" + " <div>\n" + " <h1 align=center> Index of " title "</h1>\n" + " <pre>\n" + " Name Last modified Size\n</pre>" + "<hr>\n <pre>\n") + (while files + (url-lazy-message "Building directory list... (%d%%)" + (/ (* 100 (- div (length files))) div)) + (setq file (expand-file-name (car files) dir) + attr (file-attributes file) + file (car files) + mod-time (nth 5 attr) + size (nth 7 attr) + typ (or (mm-extension-to-mime (url-file-extension file)) "")) + (setq file (url-hexify-string file)) + (if (equal '(0 0) mod-time) ; Set to null if unknown or + (setq mod-time "Unknown ") + (setq mod-time (current-time-string mod-time))) + (if (or (equal size 0) (equal size -1) (null size)) + (setq size " -") + (setq size + (cond + ((< size 1024) (concat " " "1K")) + ((< size 1048576) (concat " " + (int-to-string + (max 1 (/ size 1024))) "K")) + (t + (let* ((megs (max 1 (/ size 1048576))) + (kilo (/ (- size (* megs 1048576)) 1024))) + (concat " " (int-to-string megs) + (if (> kilo 0) + (concat "." (int-to-string kilo)) + "") "M")))))) + (cond + ((or (equal "." (car files)) + (equal "/.." (car files))) + nil) + ((equal ".." (car files)) + (if (not (= ?/ (aref file (1- (length file))))) + (setq file (concat file "/")))) + ((stringp (nth 0 attr)) ; Symbolic link handling + (insert "[LNK] <a href=\"./" file "\">" (car files) "</a>" + (make-string (max 0 (- 25 (length (car files)))) ? ) + mod-time size "\n")) + ((nth 0 attr) ; Directory handling + (insert "[DIR] <a href=\"./" file "/\">" (car files) "</a>" + (make-string (max 0 (- 25 (length (car files)))) ? ) + mod-time size "\n")) + ((string-match "image" typ) + (insert "[IMG] <a href=\"./" file "\">" (car files) "</a>" + (make-string (max 0 (- 25 (length (car files)))) ? ) + mod-time size "\n")) + ((string-match "application" typ) + (insert "[APP] <a href=\"./" file "\">" (car files) "</a>" + (make-string (max 0 (- 25 (length (car files)))) ? ) + mod-time size "\n")) + ((string-match "text" typ) + (insert "[TXT] <a href=\"./" file "\">" (car files) "</a>" + (make-string (max 0 (- 25 (length (car files)))) ? ) + mod-time size "\n")) + (t + (insert "[UNK] <a href=\"./" file "\">" (car files) "</a>" + (make-string (max 0 (- 25 (length (car files)))) ? ) + mod-time size "\n"))) + (setq files (cdr files))) + (insert " </pre>\n" + " </div>\n" + " </body>\n" + "</html>\n" + "<!-- Automatically generated by URL v" url-version + " -->\n"))))) + +(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 (url) + ;; Find a file + (let* ((urlobj (url-generic-parse-url url)) + (user (url-user 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))) + + (if (and file (url-host-is-local-p site) + (memq system-type '(ms-windows ms-dos windows-nt os2))) + (let ((x (1- (length file))) + (y 0)) + (while (<= y x) + (if (= (aref file y) ?\\ ) + (aset file y ?/)) + (setq y (1+ y))))) + + (url-clear-tmp-buffer) + (cond + ((file-directory-p filename) + (if url-use-hypertext-dired + (progn + (if (string-match "/$" filename) + nil + (setq filename (concat filename "/"))) + (if (string-match "/$" file) + nil + (setq file (concat file "/"))) + (url-set-filename urlobj file) + (url-format-directory filename)) + (progn + (if (get-buffer url-working-buffer) + (kill-buffer url-working-buffer)) + (find-file filename)))) + ((and (boundp 'w3-dump-to-disk) (symbol-value 'w3-dump-to-disk)) + (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 + (error "File not found %s" filename))) + (cond + ((url-host-is-local-p site) + (copy-file + filename + (read-file-name "Save to: " nil (url-basepath filename t)) t)) + ((featurep 'ange-ftp) + (ange-ftp-copy-file-internal + filename + (expand-file-name + (read-file-name "Save to: " nil (url-basepath filename t))) t + nil t nil t)) + ((or (featurep 'efs) (featurep 'efs-auto)) + (let ((new (expand-file-name + (read-file-name "Save to: " nil + (url-basepath filename t))))) + (efs-copy-file-internal filename (efs-ftp-path filename) + new (efs-ftp-path new) + t nil 0 nil 0 nil))) + (t (copy-file + filename + (read-file-name "Save to: " nil (url-basepath filename t)) t))) + (if (get-buffer url-working-buffer) + (kill-buffer url-working-buffer))) + (t + (let ((viewer (mm-mime-info + (mm-extension-to-mime (url-file-extension file)))) + (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)))))))) + (setq url-current-type (if site "ftp" "file") + url-current-object urlobj + url-find-this-link dest + url-current-user user + url-current-server site + url-current-mime-type (mm-extension-to-mime + (url-file-extension file)) + url-current-file file))) + +(fset 'url-ftp 'url-file) + +(provide 'url-file)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-gopher.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,479 @@ +;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.3 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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 ?&) "&") + ((= x ?<) "<"); + ((= x ?>) ">"); + (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-current-file) + (string= "1/" url-current-file) + (string= "1" url-current-file)) + (concat "Gopher root at " url-current-server)) + ((string-match (format "^[%s]+/" url-gopher-types) + url-current-file) + (substring url-current-file 2 nil)) + (t url-current-file)) + "</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) + (setq url-current-file selector + url-current-port port + url-current-server host + url-current-type "gopher") + (if (> (length selector) 0) + (setq selector (substring selector 1 nil))) + (if (stringp proc) + (message "%s" proc) + (save-excursion + (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)) + (url-replace-regexp "\n*Connection closed.*\n*" "") + (url-replace-regexp "\n*Process .*gopher.*\n*" "") + (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> <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) + url-current-file file + url-current-port port + url-current-server host + url-current-type "gopher"))) + +(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 + (string-to-char (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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-http.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,643 @@ +;;; url-http.el --- HTTP Uniform Resource Locator retrieval code +;; Author: wmperry +;; Created: 1996/12/18 00:38:45 +;; Version: 1.7 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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)))) + (host (if (boundp 'proxy-info) + (url-host (url-generic-parse-url proxy-info)) + url-current-server)) + (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 url-current-server + fname + (string-match "https" + url-current-type)) + (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-extract-from-cache (url-create-cached-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 + ((or (equal "pem" type) (equal "pgp" type)) + (if (string-match "entity=\"\\([^\"]+\\)\"" y) + (url-fetch-with-pgp url-current-file + (url-match y 1) (intern type)) + (error "Could not find entity in %s!" type))) + ((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)) + (url-basic-auth-storage url-proxy-basic-authentication) + (type (downcase (if (string-match "[ \t]" y) + (substring y 0 (match-beginning 0)) + y)))) + (cond + ((or (equal "pem" type) (equal "pgp" type)) + (if (string-match "entity=\"\\([^\"]+\\)\"" y) + (url-fetch-with-pgp url-current-file + (url-match y 1) (intern type)) + (error "Could not find entity in %s!" type))) + ((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) + (setq url-current-type (if (boundp 'url-this-is-ssl) + "https" "http")) + (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 proxy-info + (let ((x (url-generic-parse-url url))) + (setq url-current-server (url-host urlobj) + url-current-port (url-port urlobj) + url-current-file (url-filename urlobj) + url-find-this-link (url-target urlobj) + request (url-create-mime-request file ref-url))) + (setq url-current-server server + url-current-port port + url-current-file file + url-find-this-link dest + request (url-create-mime-request file ref-url))) + (if (or (not (member port url-bad-port-list)) + (funcall url-confirmation-func + (concat + "Warning! Trying to connect to port " + port + " - continue? "))) + (progn + (url-lazy-message "Contacting %s:%s" server port) + (let ((process + (url-open-stream "WWW" url-working-buffer server + (string-to-int port)))) + (if (stringp process) + (progn + (set-buffer url-working-buffer) + (erase-buffer) + (setq url-current-mime-type "text/html" + url-current-mime-viewer + (mm-mime-info "text/html" nil 5)) + (insert "<title>ERROR</title>\n" + "<h1>ERROR - Could not establish connection</h1>" + "<p>" + "The browser could not establish a connection " + (format "to %s:%s.<P>" server port) + "The server is either down, or the URL" + (format "(%s) is malformed.<p>" (url-view-url t))) + (message "%s" process)) + (progn + (url-process-put process 'url (or proxy-info url)) + (process-kill-without-query process) + (process-send-string process request) + (url-lazy-message "Request sent, waiting for response...") + (if url-show-http2-transfer + (progn + (make-local-variable 'after-change-functions) + (setq url-current-content-length nil) + (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-shttp (url) + ;; Retrieve a URL via Secure-HTTP + (error "Secure-HTTP not implemented yet.")) + +(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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-irc.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,71 @@ +;;; url-irc.el --- IRC URL interface +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.4 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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) + +(defvar 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") + +(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))) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-mail.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,194 @@ +;;; url-mail.el --- Mail Uniform Resource Locator retrieval code +;; Author: wmperry +;; Created: 1996/10/21 21:27:36 +;; Version: 1.4 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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") + (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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-misc.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,313 @@ +;;; url-misc.el --- Misc Uniform Resource Locator retrieval code +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.3 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993 - 1996 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, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'url-vars) +(require 'url-parse) +(autoload 'Info-goto-node "info" "" t) + +(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 (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 (stringp proc) + (message "%s" proc) + (process-kill-without-query proc) + (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-rlogin (url) + ;; Open up an rlogin connection + (if (get-buffer url-working-buffer) + (kill-buffer url-working-buffer)) + (or (string-match "rlogin:/*\\(.*@\\)*\\([^/]*\\)/*" url) + (error "Malformed RLOGIN URL.")) + (let* ((server (substring url (match-beginning 2) (match-end 2))) + (name (if (match-beginning 1) + (substring url (match-beginning 1) (1- (match-end 1))) + nil)) + (title (format "%s%s" (if name (concat name "@") "") server)) + (thebuf (string-match ":" server)) + (port (if thebuf + (prog1 + (substring server (1+ thebuf) nil) + (setq server (substring server 0 thebuf))) "23"))) + (cond + ((not (eq (device-type) 'tty)) + (apply 'start-process + "htmlsub" + nil + (url-string-to-tokens + (format url-xterm-command title + (if (and url-gateway-local-host-regexp + (string-match url-gateway-local-host-regexp + server)) + url-local-rlogin-prog + url-remote-rlogin-prog) server + (concat "-l " name)) ? ))) + (url-use-transparent + (require 'transparent) + (sit-for 1) + (transparent-window (get-buffer-create + (format "%s%s:%s" (if name (concat name "@") "") + server port)) + (if (and url-gateway-local-host-regexp + (string-match url-gateway-local-host-regexp + server)) + url-local-rlogin-prog + url-remote-rlogin-prog) + (list server "-l" name) nil + "Press any key to return to emacs")) + (t + (terminal-emulator + (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "") + server port)) + (if (and url-gateway-local-host-regexp + (string-match url-gateway-local-host-regexp + server)) + url-local-rlogin-prog + url-remote-rlogin-prog) + (list server "-l" name)))))) + +(defun url-telnet (url) + ;; Open up a telnet connection + (if (get-buffer url-working-buffer) + (kill-buffer url-working-buffer)) + (or (string-match "telnet:/*\\(.*@\\)*\\([^/]*\\)/*" url) + (error "Malformed telnet URL: %s" url)) + (let* ((server (substring url (match-beginning 2) (match-end 2))) + (name (if (match-beginning 1) + (substring url (match-beginning 1) (1- (match-end 1))) + nil)) + (title (format "%s%s" (if name (concat name "@") "") server)) + (thebuf (string-match ":" server)) + (port (if thebuf + (prog1 + (substring server (1+ thebuf) nil) + (setq server (substring server 0 thebuf))) "23"))) + (cond + ((not (eq (device-type) 'tty)) + (apply 'start-process + "htmlsub" + nil + (url-string-to-tokens + (format url-xterm-command title + (if (and url-gateway-local-host-regexp + (string-match url-gateway-local-host-regexp + server)) + url-local-telnet-prog + url-remote-telnet-prog) server port) ? )) + (if name (message "Please log in as %s" name))) + (url-use-transparent + (require 'transparent) + (if name (message "Please log in as %s" name)) + (sit-for 1) + (transparent-window (get-buffer-create + (format "%s%s:%s" (if name (concat name "@") "") + server port)) + (if (and url-gateway-local-host-regexp + (string-match url-gateway-local-host-regexp + server)) + url-local-telnet-prog + url-remote-telnet-prog) + (list server port) nil + "Press any key to return to emacs")) + (t + (terminal-emulator + (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "") + server port)) + (if (and url-gateway-local-host-regexp + (string-match url-gateway-local-host-regexp + server)) + url-local-telnet-prog + url-remote-telnet-prog) + (list server port)) + (if name (message "Please log in as %s" name)))))) + +(defun url-tn3270 (url) + ;; Open up a tn3270 connection + (if (get-buffer url-working-buffer) + (kill-buffer url-working-buffer)) + (string-match "tn3270:/*\\(.*@\\)*\\([^/]*\\)/*" url) + (let* ((server (substring url (match-beginning 2) (match-end 2))) + (name (if (match-beginning 1) + (substring url (match-beginning 1) (1- (match-end 1))) + nil)) + (thebuf (string-match ":" server)) + (title (format "%s%s" (if name (concat name "@") "") server)) + (port (if thebuf + (prog1 + (substring server (1+ thebuf) nil) + (setq server (substring server 0 thebuf))) "23"))) + (cond + ((not (eq (device-type) 'tty)) + (start-process "htmlsub" nil url-xterm-command + "-title" title + "-ut" "-e" url-tn3270-emulator server port) + (if name (message "Please log in as %s" name))) + (url-use-transparent + (require 'transparent) + (if name (message "Please log in as %s" name)) + (sit-for 1) + (transparent-window (get-buffer-create + (format "%s%s:%s" (if name (concat name "@") "") + server port)) + url-tn3270-emulator + (list server port) nil + "Press any key to return to emacs")) + (t + (terminal-emulator + (get-buffer-create (format "%s%s:%s" (if name (concat name "@") "") + server port)) + url-tn3270-emulator + (list server port)) + (if name (message "Please log in as %s" name)))))) + +(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)) + (proxyobj (url-generic-parse-url url-using-proxy))) + (url-http url-using-proxy url) + (setq url-current-type (url-type urlobj) + url-current-user (url-user urlobj) + url-current-port (or (url-port urlobj) + (cdr-safe (assoc url-current-type + url-default-ports))) + url-current-server (url-host urlobj) + url-current-file (url-filename urlobj)))) + +(defun url-x-exec (url) + ;; Handle local execution of scripts. + (set-buffer (get-buffer-create url-working-buffer)) + (erase-buffer) + (string-match "x-exec:/+\\([^/]+\\)\\(/.*\\)" url) + (let ((process-environment process-environment) + (executable (url-match url 1)) + (path-info (url-match url 2)) + (query-string nil) + (safe-paths url-local-exec-path) + (found nil) + (y nil) + ) + (setq url-current-server executable + url-current-file path-info) + (if (string-match "\\(.*\\)\\?\\(.*\\)" path-info) + (setq query-string (url-match path-info 2) + path-info (url-match path-info 1))) + (while (and safe-paths (not found)) + (setq y (expand-file-name executable (car safe-paths)) + found (and (file-exists-p y) (file-executable-p y) y) + safe-paths (cdr safe-paths))) + (if (not found) + (url-retrieve (concat "www://error/nofile/" executable)) + (setq process-environment + (append + (list + "SERVER_SOFTWARE=x-exec/1.0" + (concat "SERVER_NAME=" (system-name)) + "GATEWAY_INTERFACE=CGI/1.1" + "SERVER_PROTOCOL=HTTP/1.0" + "SERVER_PORT=" + (concat "REQUEST_METHOD=" url-request-method) + (concat "HTTP_ACCEPT=" + (mapconcat + (function + (lambda (x) + (cond + ((= x ?\n) (setq y t) "") + ((= x ?:) (setq y nil) ",") + (t (char-to-string x))))) url-mime-accept-string + "")) + (concat "PATH_INFO=" (url-unhex-string path-info)) + (concat "PATH_TRANSLATED=" (url-unhex-string path-info)) + (concat "SCRIPT_NAME=" executable) + (concat "QUERY_STRING=" (url-unhex-string query-string)) + (concat "REMOTE_HOST=" (system-name))) + (if (assoc "content-type" url-request-extra-headers) + (concat "CONTENT_TYPE=" (cdr + (assoc "content-type" + url-request-extra-headers)))) + (if url-request-data + (concat "CONTENT_LENGTH=" (length url-request-data))) + process-environment)) + (and url-request-data (insert url-request-data)) + (setq y (call-process-region (point-min) (point-max) found t t)) + (goto-char (point-min)) + (delete-region (point) (progn (skip-chars-forward " \t\n") (point))) + (cond + ((url-mime-response-p) nil) ; Its already got an HTTP/1.0 header + ((null y) ; Weird exit status, whassup? + (insert "HTTP/1.0 404 Not Found\n" + "Server: " url-package-name "/x-exec\n")) + ((= 0 y) ; The shell command was successful + (insert "HTTP/1.0 200 Document follows\n" + "Server: " url-package-name "/x-exec\n")) + (t ; Non-zero exit status is bad bad bad + (insert "HTTP/1.0 404 Not Found\n" + "Server: " url-package-name "/x-exec\n")))))) + +(provide 'url-misc)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-news.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,292 @@ +;;; url-news.el --- News Uniform Resource Locator retrieval code +;; Author: wmperry +;; Created: 1996/11/05 05:26:07 +;; Version: 1.5 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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-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")) + (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)))) + (setq url-current-file "" + url-current-type "") + (if (or (not (string-match "text/" typ)) + (string-match "text/html" typ)) + nil ; Let natural content-type take over + (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))) + (setq url-current-type "news" + url-current-server host + url-current-user (url-user urlobj) + url-current-port port + url-current-file article))) + +(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))) + (setq url-current-type "news" + url-current-server host + url-current-user (url-user urlobj) + url-current-port port + url-current-file article))) + +(provide 'url-news)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-nfs.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,73 @@ +;;; url-nfs.el --- NFS URL interface +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.2 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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)))) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-parse.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,193 @@ +;;; url-parse.el --- Uniform Resource Locator parser +;; Author: wmperry +;; Created: 1996/12/26 23:25:55 +;; Version: 1.3 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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 [protocol username password hostname portnumber file reference]" + (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 "^/") + (downcase-region save-pos (point)) + (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 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-pgp.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,175 @@ +;;; url-pgp.el --- PGP encapsulation of HTTP +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.2 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; UUencoding +;;; ---------- +;;; These functions are needed for the (RI)PEM encoding. PGP can +;;; handle binary data, but (RI)PEM requires that it be uuencoded +;;; first, or it will barf severely. How rude. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun url-uuencode-buffer (&optional buff) + "UUencode buffer BUFF, with a default of the current buffer." + (setq buff (or buff (current-buffer))) + (save-excursion + (set-buffer buff) + (url-lazy-message "UUencoding...") + (call-process-region (point-min) (point-max) + url-uuencode-program t t nil "url-temp-file") + (url-lazy-message "UUencoding... done."))) + +(defun url-uudecode-buffer (&optional buff) + "UUdecode buffer BUFF, with a default of the current buffer." + (setq buff (or buff (current-buffer))) + (let ((newname (url-generate-unique-filename))) + (save-excursion + (set-buffer buff) + (goto-char (point-min)) + (re-search-forward "^begin [0-9][0-9][0-9] \\(.*\\)$" nil t) + (replace-match (concat "begin 600 " newname)) + (url-lazy-message "UUdecoding...") + (call-process-region (point-min) (point-max) url-uudecode-program) + (url-lazy-message "UUdecoding...") + (erase-buffer) + (insert-file-contents-literally newname) + (url-lazy-message "UUdecoding... done.") + (condition-case () + (delete-file newname) + (error nil))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Decoding PGP/PEM responses +;;; -------------------------- +;;; A PGP/PEM encrypted/signed response contains all the real headers, +;;; so this is just a quick decrypt-then-reparse hack. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun url-decode-pgp/pem (arg) + "Decode a pgp/pem response from an HTTP/1.0 server. +This expects the decoded message to contain all the necessary HTTP/1.0 headers +to correctly act on the decoded message (new content-type, etc)." + (mc-decrypt-message) + (url-parse-mime-headers)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; PGP/PEM Encryption +;;; ------------------ +;;; This implements the highly secure PGP/PEM encrypted requests, as +;;; specified by NCSA and CERN. +;;; +;;; The complete online spec of this scheme was done by Tony Sanders +;;; <sanders@bsdi.com>, and can be seen at +;;; http://www.bsdi.com/HTTP:TNG/ripem-http.txt +;;; +;;; This section of code makes use of the EXCELLENT mailcrypt.el +;;; package by Jin S Choi (jsc@mit.edu) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun url-public-key-exists (entity scheme) + "Return t iff a key for ENTITY exists using public key system SCHEME. +ENTITY is the username/hostname combination we are checking for. +SCHEME is a symbol representing what public key encryption program to use. + Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are + recognized." + (let (retval) + (save-excursion + (cond + ((eq 'pgp scheme) ; PGP encryption + (set-buffer (get-buffer-create " *keytmp*")) + (erase-buffer) + (call-process mc-pgp-path nil t nil "+batchmode" "-kxaf" entity) + (goto-char (point-min)) + (setq retval (search-forward mc-pgp-key-begin-line nil t))) + ((eq 'pem scheme) ; PEM encryption + (set-buffer (find-file-noselect mc-ripem-pubkeyfile)) + (goto-char (point-min)) + (setq retval (search-forward entity nil t))) + (t + (url-warn 'security + (format + "Bad value for SCHEME in url-public-key-exists %s" + scheme)))) + (kill-buffer (current-buffer))) + retval)) + +(defun url-get-server-keys (entity &optional scheme) + "Make sure the key for ENTITY exists using SCHEME. +ENTITY is the username/hostname combination to get the info for. + This should be a string you could pass to 'finger'. +SCHEME is a symbol representing what public key encryption program to use. + Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are + recognized." + (or scheme (setq scheme mc-default-scheme)) + (save-excursion + (cond + ((url-public-key-exists entity scheme) nil) + (t + (string-match "\\([^@]+\\)@\\(.*\\)" entity) + (let ((url-working-buffer " *url-get-keys*")) + (url-retrieve (format "gopher://%s:79/0%s/w" (url-match entity 1) + (url-match entity 2))) + (mc-snarf-keys) + (kill-buffer url-working-buffer)))))) + +(defun url-fetch-with-pgp (url recipient type) + "Retrieve a document with public-key authentication. + URL is the url to request from the server. +RECIPIENT is the server's entity name (usually webmaster@host) + TYPE is a symbol representing what public key encryption program to use. + Currently only 'pgp (Pretty Good Privacy) and 'pem (RIPEM) are + recognized." + (or noninteractive (require 'mailcrypt)) + (let ((request (url-create-mime-request url "PGP-Redirect")) + (url-request-data nil) + (url-request-extra-headers nil)) + (save-excursion + (url-get-server-keys recipient type) + (set-buffer (get-buffer-create " *url-encryption*")) + (erase-buffer) + (insert "\n\n" mail-header-separator "\n" request) + (mc-encrypt-message recipient type) + (goto-char (point-min)) + (if (re-search-forward (concat "\n" mail-header-separator "\n") nil t) + (delete-region (point-min) (point))) + (setq url-request-data (buffer-string) + url-request-extra-headers + (list (cons "Authorized" (format "%s entity=\"%s\"" + (cond + ((eq type 'pgp) "PGP") + ((eq type 'pem) "PEM")) + url-pgp/pem-entity)) + (cons "Content-type" (format "application/x-www-%s-reply" + (cond + ((eq type 'pgp) "pgp") + ((eq type 'pem) "pem"))))))) + (kill-buffer " *url-encryption*") + (url-retrieve (url-expand-file-name "/") t))) + +(provide 'url-pgp)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,558 @@ +;;; url-vars.el --- Variables for Uniform Resource Locator tool +;; Author: wmperry +;; Created: 1996/12/30 14:25:24 +;; Version: 1.19 +;; Keywords: comm, data, processes, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst url-version (let ((x "Exp")) + (if (string-match "State: \\([^ \t\n]+\\)" x) + (substring x (match-beginning 1) (match-end 1)) + x)) + "Version # of URL package.") + +(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-file + url-current-isindex + url-current-mime-encoding + url-current-mime-headers + url-current-mime-type + url-current-mime-viewer + url-current-object + url-current-port + url-current-referer + url-current-server + url-current-type + url-current-user + )) + +(defvar url-default-retrieval-proc 'url-default-callback + "*The default action to take when an asynchronous retrieval completes.") + +(defvar 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.") + +(defvar url-emacs-minor-version + (if (boundp 'emacs-minor-version) + (symbol-value '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)) + "What minor version of emacs we are using.") + +(defvar url-inhibit-mime-parsing nil + "Whether to parse out (and delete) the MIME headers from a message.") + +(defvar url-automatic-caching nil + "*If non-nil, all documents will be automatically cached to the local +disk.") + +(defvar 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.") + +(defvar url-check-md5s nil + "*Whether to check md5s of retrieved documents or not.") + +(defvar url-expected-md5 nil "What md5 we expect to see.") + +(defvar url-broken-resolution nil + "*Whether to use [ange|efs]-ftp-nslookup-host.") + +(defvar url-bug-address "wmperry@cs.indiana.edu" "Where to send bug reports.") + +(defvar url-cookie-confirmation nil + "*If non-nil, confirmation by the user is required before accepting any +HTTP cookies.") + +(defvar url-personal-mail-address nil + "*Your full email address. This is what is sent to HTTP/1.0 servers as +the FROM field. If not set when url-do-setup is run, it defaults to +the value of url-pgp/pem-entity.") + +(defvar 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 +automatically creating the directory listing.") + +(defvar url-pgp/pem-entity nil + "*The users PGP/PEM id - usually their email address.") + +(defvar url-privacy-level 'none + "*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. +") + +(defvar url-uudecode-program "uudecode" "*The UUdecode executable.") + +(defvar url-uuencode-program "uuencode" "*The UUencode executable.") + +(defvar url-history-list nil "List of urls visited this session.") + +(defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.") + +(defvar 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.") + +(defvar 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.") + +(defvar url-xterm-command "xterm -title %s -ut -e %s %s %s" + "*Command used to start an xterm window.") + +(defvar url-tn3270-emulator "tn3270" + "The client to run in a subprocess to connect to a tn3270 machine.") + +(defvar url-use-transparent nil + "*Whether to use the transparent package by Brian Tompsett instead of +the builtin telnet functions. Using transparent allows you to have full +vt100 emulation in the telnet and tn3270 links.") + +(defvar 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.") + +(defvar url-local-exec-path nil + "*A list of possible locations for x-exec scripts.") + +(defvar url-proxy-services nil + "*An assoc list of access types and servers that gateway them. +Looks like ((\"http\" . \"url://for/proxy/server/\") ....) This is set up +from the ACCESS_proxy environment variables in url-do-setup.") + +(defvar 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.") + +(defvar 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.") + +(defvar url-global-history-timer nil) + +(defvar 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.") + +(defvar 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.") + +(defvar 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" . "ℑ") + ("I" . "ℑ") + ("s" . "&audio;")) + "*An assoc list of gopher types and the graphic entity references to +show when possible.") + +(defvar url-standalone-mode nil "*Rely solely on the cache?") +(defvar url-multiple-p t + "*If non-nil, multiple queries are possible through ` *URL-<i>*' buffers") +(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-annotation nil "URL of document we are annotating...") +(defvar url-current-referer nil "Referer of this page.") +(defvar url-current-content-length nil "Current content length.") +(defvar url-current-file nil "Filename of current document.") +(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-nntp-server nil "What nntp server currently opened.") +(defvar url-current-passwd-count 0 "How many times password has failed.") +(defvar url-current-port nil "Port # of the current document.") +(defvar url-current-server nil "Server of the current document.") +(defvar url-current-user nil "Username for ftp login.") +(defvar url-current-type nil "We currently in http or file mode?") +(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.") + +(defvar 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.") + +(defvar 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.") + +(defvar 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.") +(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.") + +(defvar url-mime-language-string "*" + "String to send to the server in the Accept-language: field in +HTTP/1.0 requests.") + +(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.") + +(defvar url-max-password-attempts 5 + "*Maximum number of times a password will be prompted for when a +protected document is denied by the server.") + +(defvar url-wais-to-mime + '( + ("WSRC" . "application/x-wais-source") ; A database description + ("TEXT" . "text/plain") ; plain text + ) + "An assoc list of wais doctypes and their corresponding MIME +content-types.") + +(defvar url-waisq-prog "waisq" + "*Name of the waisq executable on this system. This should be the +waisq program from think.com's wais8-b5.1 distribution.") + +(defvar url-wais-gateway-server "www.ncsa.uiuc.edu" + "*The machine name where the WAIS gateway lives.") + +(defvar url-wais-gateway-port "8001" + "*The port # of the WAIS gateway.") + +(defvar url-temporary-directory "/tmp" "*Where temporary files go.") + +(defvar 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.") + +(defvar url-using-proxy nil + "Either nil or the fully qualified proxy URL in use, e.g. +http://www.domain.com/") + +(defvar 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.") + +(defvar 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.") + +(defvar 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.") + +(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.") + +(defvar url-configuration-directory nil + "*Where the URL configuration files can be found.") + +(defvar 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.") + +(defvar url-connection-retries 5 + "*# of times to try for a connection before bailing. +If for some reason url-open-stream cannot make a connection to a host +right away, it will sit for 1 second, then try again, up to this many +tries.") + +(defvar url-find-this-link nil "Link to go to within a document.") + +(defvar url-show-http2-transfer t + "*Whether to show the total # of bytes, size of file, and percentage +transferred when retrieving a document over HTTP/1.0 and it returns a +valid content-length header. This can mess up some people behind +gateways.") + +(defvar 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: +'program :: Run a program in a subprocess to connect + (examples are itelnet, an expect script, etc) +'native :: Use the native open-network-stream in emacs +'tcp :: Use the excellent tcp.el package from gnus. + This simply does a (require 'tcp), then sets + url-gateway-method to be 'native.") + +(defvar url-gateway-shell-is-telnet nil + "*Whether the login shell of the remote host is telnet.") + +(defvar url-gateway-program-interactive nil + "*Whether url needs to hand-hold the login program on the remote machine.") + +(defvar url-gateway-handholding-login-regexp "ogin:" + "*Regexp for when to send the username to the remote process.") + +(defvar url-gateway-handholding-password-regexp "ord:" + "*Regexp for when to send the password to the remote process.") + +(defvar url-gateway-host-prompt-pattern "^[^#$%>;]*[#$%>;] *" + "*Regexp used to detect when the login is finished on the remote host.") + +(defvar url-gateway-telnet-ready-regexp "Escape character is .*" + "*A regular expression that signifies url-gateway-telnet-program is +ready to accept input.") + +(defvar url-local-rlogin-prog "rlogin" + "*Program for local telnet connections.") + +(defvar url-remote-rlogin-prog "rlogin" + "*Program for remote telnet connections.") + +(defvar url-local-telnet-prog "telnet" + "*Program for local telnet connections.") + +(defvar url-remote-telnet-prog "telnet" + "*Program for remote telnet connections.") + +(defvar url-running-xemacs (string-match "XEmacs" emacs-version) + "*In XEmacs?.") + +(defvar url-gateway-telnet-program "itelnet" + "*Program to run in a subprocess when using gateway-method 'program.") + +(defvar url-gateway-local-host-regexp nil + "*If a host being connected to matches this regexp then the +connection is done natively, otherwise the process is started on +`url-gateway-host' instead.") + +(defvar url-use-hypertext-dired t + "*How to format directory listings. + +If value is non-nil, use directory-files to list them out and +transform them into a hypertext document, then pass it through the +parse like any other document. + +If value nil, just pass the directory off to dired using find-file.") + +(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-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) + +;;; Make OS/2 happy - yeeks +(defvar tcp-binary-process-input-services nil + "*Make OS/2 happy with our CRLF pairs...") + +(provide 'url-vars)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url-wais.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,251 @@ +;;; url-wais.el --- WAIS Uniform Resource Locator retrieval code +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.3 +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; WAIS support +;;; ------------ +;;; Here are even more gross hacks that I call native WAIS support. +;;; This code requires a working waisq program that is fully +;;; compatible with waisq from think.com +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun url-create-wais-source (server port dbase) + ;; Create a temporary wais source description file. Returns the + ;; file name the description is in. + (let ((x (url-generate-unique-filename)) + (y (get-buffer-create " *waisq-tmp*"))) + (save-excursion + (set-buffer y) + (erase-buffer) + (insert + (format + (concat "(:source\n:version 3\n" + ":ip-name \"%s\"\n:tcp-port %s\n" + ":database-name \"%s\"\n)") + server (if (equal port "") "210" port) dbase)) + (write-region (point-min) (point-max) x nil nil) + (kill-buffer y)) + x)) + +(defun url-wais-stringtoany (str) + ;; Return a wais subelement that specifies STR in any database + (concat "(:any :size " (length str) " :bytes #( " + (mapconcat 'identity str " ") + " ) )")) + +;(defun url-retrieve-wais-docid (server port dbase local-id) +; (call-process "waisretrieve" nil url-working-buffer nil +; (format "%s:%s@%s:%s" (url-unhex-string local-id) +; dbase server port))) + +;(url-retrieve-wais-docid "quake.think.com" "210" "directory-of-servers" +; "0 2608 /proj/wais/wais-sources/vpiej-l.src") +(defun url-retrieve-wais-docid (server port dbase local-id) + ;; Retrieve a wais document. + ;; SERVER is the server the database is on (:ip-name in source description) + ;; PORT is the port number to contact (:tcp-port in the source description) + ;; DBASE is the database name (:database-name in the source description) + ;; LOCAL-ID is the document (:original-local-id in the question description) + (let* ((dbf (url-create-wais-source server port dbase)) + (qstr (format + (concat "(:question :version 2\n" + " :result-documents\n" + " ( (:document-id\n" + " :document\n" + " (:document\n" + " :headline \"\"\n" + " :doc-id\n" + " (:doc-id :original-database %s\n" + " :original-local-id %s )\n" + " :number-of-bytes -1\n" + " :type \"\"\n" + " :source\n" + " (:source-id :filename \"%s\") ) ) ) )") + (url-wais-stringtoany dbase) + (url-wais-stringtoany (url-unhex-string local-id)) + dbf)) + (qf (url-generate-unique-filename))) + (set-buffer (get-buffer-create url-working-buffer)) + (insert qstr) + (write-region (point-min) (point-max) qf nil nil) + (erase-buffer) + (call-process url-waisq-prog nil url-working-buffer nil "-f" qf "-v" "1") + (save-excursion + (set-buffer url-working-buffer) + (setq url-current-file (url-unhex-string local-id))) + (condition-case () + (delete-file dbf) + (error nil)) + (condition-case () + (delete-file qf) + (error nil)))) + +;(url-perform-wais-query "quake.think.com" "210" "directory-of-servers" "SGML") +(defun url-perform-wais-query (server port dbase search) + ;; Perform a wais query. + ;; SERVER is the server the database is on (:ip-name in source description) + ;; PORT is the port number to contact (:tcp-port in the source description) + ;; DBASE is the database name (:database-name in the source description) + ;; SEARCH is the search term (:seed-words in the question description)" + (let ((dbfname (url-create-wais-source server port dbase)) + (qfname (url-generate-unique-filename)) + (results 'url-none-gotten)) + (save-excursion + (url-clear-tmp-buffer) + (insert + (format + (concat "(:question\n" + " :version 2\n" + " :seed-words \"%s\"\n" + " :sourcepath \"" url-temporary-directory "\"\n" + " :sources\n" + " ( (:source-id\n" + " :filename \"%s\"\n" + " )\n" + " )\n" + " :maximum-results 100)\n") + search dbfname)) + (write-region (point-min) (point-max) qfname nil nil) + (erase-buffer) + (call-process url-waisq-prog nil url-working-buffer nil "-g" "-f" qfname) + (set-buffer url-working-buffer) + (erase-buffer) + (setq url-current-server server + url-current-port port + url-current-file dbase) + (insert-file-contents-literally qfname) + (goto-char (point-min)) + (if (re-search-forward "(:question" nil t) + (delete-region (point-min) (match-beginning 0))) + (url-replace-regexp "Process.*finished.*" "") + (subst-char-in-region (point-min) (point-max) 35 32) + (goto-char (point-min)) + (message "Done reading info - parsing results...") + (if (re-search-forward ":result-documents[^(]+" nil t) + (progn + (goto-char (match-end 0)) + (while (eq results 'url-none-gotten) + (condition-case () + (setq results (read (current-buffer))) + (error (progn + (setq results 'url-none-gotten) + (goto-char (match-end 0)))))) + (erase-buffer) + (insert "<title>Results of WAIS search</title>\n" + "<h1>Searched " dbase " for " search "</h1>\n" + "<hr>\n" + "Found <b>" (int-to-string (length results)) + "</b> matches.\n" + "<ol>\n<li>" + (mapconcat 'url-parse-wais-doc-id results "\n<li>") + "\n</ol>\n<hr>\n")) + (message "No results")) + (setq url-current-mime-type "text/html") + (condition-case () + (delete-file qfname) + (error nil)) + (condition-case () + (delete-file dbfname) + (error nil))))) + +(defun url-wais-anytostring (x) + ;; Convert a (:any ....) wais construct back into a string. + (mapconcat 'char-to-string (car (cdr (memq ':bytes x))) "")) + +(defun url-parse-wais-doc-id (x) + ;; Return a list item that points at the doc-id specified by X + (let* ((document (car (cdr (memq ':document x)))) + (doc-id (car (cdr (memq ':doc-id document)))) + (score (car (cdr (memq ':score x)))) + (title (car (cdr (memq ':headline document)))) + (type (car (cdr (memq ':type document)))) + (size (car (cdr (memq ':number-of-bytes document)))) + (server (car (cdr (memq ':original-server doc-id)))) + (dbase (car (cdr (memq ':original-database doc-id)))) + (localid (car (cdr (memq ':original-local-id doc-id)))) + (dist-server (car (cdr (memq ':distributor-server doc-id)))) + (dist-dbase (car (cdr (memq ':distributor-database doc-id)))) + (dist-id (car (cdr (memq ':distributor-local-id doc-id)))) + (copyright (or (car (cdr (memq ':copyright-disposition doc-id))) 0))) + (format "<a href=\"wais://%s:%s/%s/%s/%d/1=%s;2=%s;3=%s;4=%s;5=%s;6=%s;7=%d;\">%s (Score = %s)</a>" + url-current-server url-current-port url-current-file + type size + (url-hexify-string (url-wais-anytostring server)) + (url-hexify-string (url-wais-anytostring dbase)) + (url-hexify-string (url-wais-anytostring localid)) + (url-hexify-string (url-wais-anytostring dist-server)) + (url-hexify-string (url-wais-anytostring dist-dbase)) + (url-hexify-string (url-wais-anytostring dist-id)) + copyright title score))) + +(defun url-grok-wais-href (url) + "Return a list of server, port, database, search-term, doc-id" + (if (string-match "wais:/+\\([^/:]+\\):*\\([^/]*\\)/+\\(.*\\)" url) + (let ((host (url-match url 1)) + (port (url-match url 2)) + (data (url-match url 3))) + (list host port data)) + (make-list 3 nil))) + +(defun url-wais (url) + ;; Retrieve a document via WAIS + (if (and url-wais-gateway-server url-wais-gateway-port) + (url-retrieve + (format "http://%s:%s/%s" + url-wais-gateway-server + url-wais-gateway-port + (substring url (match-end 0) nil))) + (let ((href (url-grok-wais-href url))) + (url-clear-tmp-buffer) + (setq url-current-type "wais" + url-current-server (nth 0 href) + url-current-port (nth 1 href) + url-current-file (nth 2 href)) + (cond + ((string-match "2=\\(.*\\);3=\\([^ ;]+\\)" (nth 2 href)); full link + (url-retrieve-wais-docid (nth 0 href) (nth 1 href) + (url-match (nth 2 href) 1) + (url-match (nth 2 href) 2))) + ((string-match "\\([^\\?]+\\)\\?\\(.*\\)" (nth 2 href)) ; stored query + (url-perform-wais-query (nth 0 href) (nth 1 href) + (url-match (nth 2 href) 1) + (url-match (nth 2 href) 2))) + (t + (insert "<title>WAIS search</title>\n" + "<h1>WAIS search of " (nth 2 href) "</h1>" + "<hr>\n" + (format "<form action=\"%s\" enctype=\"application/x-w3-wais\">\n" url) + "Enter search term: <input name=\"internal-wais\">\n" + "</form>\n" + "<hr>\n")))))) + +(provide 'url-wais) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/url.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,2496 @@ +;;; url.el --- Uniform Resource Locator retrieval tool +;; Author: wmperry +;; Created: 1996/12/19 21:53:03 +;; Version: 1.40 +;; Keywords: comm, data, processes, hypermedia + +;;; LCD Archive Entry: +;;; url|William M. Perry|wmperry@cs.indiana.edu| +;;; Major mode for manipulating URLs| +;;; 1996/12/19 21:53:03|1.40|Location Undetermined +;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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 'urlauth) +(require 'url-cookie) +(require 'mm) +(require 'md5) +(require 'base64) +(require 'mule-sysdp) +(or (featurep 'efs) + (featurep 'efs-auto) + (condition-case () + (require 'ange-ftp) + (error nil))) + +(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-info "url-misc") +(autoload 'url-shttp "url-http") +(autoload 'url-https "url-http") +(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-x-exec "url-misc") +(autoload 'url-news "url-news") +(autoload 'url-nntp "url-news") +(autoload 'url-decode-pgp/pem "url-pgp") +(autoload 'url-wais "url-wais") + +(autoload 'url-save-newsrc "url-news") +(autoload 'url-news-generate-reply-form "url-news") +(autoload 'url-parse-newsrc "url-news") +(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") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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 + ((and (string-match "XEmacs\\|Lucid" emacs-version) + (< url-emacs-minor-version 11)) ; Don't load in lemacs 19.10 + nil) + (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-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]... %d of %d bytes (%d%%)" + url-current-mime-type + current-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... %d of %d bytes (%d%%)" + current-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]... %d bytes" + url-current-mime-type current-length)) + ((/= 1 current-length) + (url-lazy-message "Reading... %d bytes." 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: + & ==> & + < ==> < + > ==> > + \" ==> "" + (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)) + '((?\" . """) + (?& . "&") + (?< . "<") + (?> . ">"))))) + (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-current-file)) + 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 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) + (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)) + (if (condition-case () + (string-match "\\(.*\\)#" url) + (error nil)) + (setq url (url-match url 1))) + (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-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))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Gateway Support +;;; --------------- +;;; Fairly good/complete gateway support +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun url-kill-process (proc) + "Kill the process PROC - knows about all the various gateway types, +and acts accordingly." + (cond + ((eq url-gateway-method 'native) (delete-process proc)) + ((eq url-gateway-method 'program) (kill-process proc)) + (t (error "Unknown url-gateway-method %s" url-gateway-method)))) + +(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" + (cond + ((memq url-gateway-method '(native ssl program)) (process-status proc)) + (t (error "Unkown url-gateway-method %s" url-gateway-method)))) + +(defun url-open-stream (name buffer host service) + "Open a stream to a host" + (let ((tmp-gateway-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)) + (tcp-binary-process-output-services (if (stringp service) + (list service) + (list service + (int-to-string service))))) + (and (eq url-gateway-method 'tcp) + (require 'tcp) + (setq url-gateway-method 'native + tmp-gateway-method 'native)) + (cond + ((eq tmp-gateway-method 'ssl) + (open-ssl-stream name buffer host service)) + ((eq tmp-gateway-method 'native) + (if url-broken-resolution + (setq host + (cond + ((featurep 'ange-ftp) (ange-ftp-nslookup-host host)) + ((featurep 'efs) (efs-nslookup-host host)) + ((featurep 'efs-auto) (efs-nslookup-host host)) + (t host)))) + (let ((max-retries url-connection-retries) + (cur-retries 0) + (retry t) + (errobj nil) + (conn nil)) + (while (and (not conn) retry) + (condition-case errobj + (setq conn (open-network-stream name buffer host service)) + (error + (url-save-error errobj) + (save-window-excursion + (save-excursion + (switch-to-buffer-other-window " *url-error*") + (shrink-window-if-larger-than-buffer) + (goto-char (point-min)) + (if (and (re-search-forward "in use" nil t) + (< cur-retries max-retries)) + (progn + (setq retry t + cur-retries (1+ cur-retries)) + (sleep-for 0.5)) + (setq cur-retries 0 + retry (funcall url-confirmation-func + (concat "Connection to " host + " failed, retry? ")))) + (kill-buffer (current-buffer))))))) + (if (not conn) + (error "Unable to connect to %s:%s" host service) + (mule-inhibit-code-conversion conn) + conn))) + ((eq tmp-gateway-method 'program) + (let ((proc (start-process name buffer url-gateway-telnet-program host + (int-to-string service))) + (tmp nil)) + (save-excursion + (set-buffer buffer) + (setq tmp (point)) + (while (not (progn + (goto-char (point-min)) + (re-search-forward + url-gateway-telnet-ready-regexp nil t))) + (url-accept-process-output proc)) + (delete-region tmp (point)) + (goto-char (point-min)) + (if (re-search-forward "connect:" nil t) + (progn + (condition-case () + (delete-process proc) + (error nil)) + (url-replace-regexp ".*connect:.*" "") + nil) + proc)))) + (t (error "Unknown url-gateway-method %s" url-gateway-method))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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) + ((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") + ((and (eq system-type 'vax-vms) (device-type)) + "VMS; X11") + ((eq system-type 'vax-vms) "VMS; TTY") + ((eq (device-type) 'x) "X11") + ((eq (device-type) 'ns) "NeXTStep") + ((eq (device-type) 'pm) "OS/2") + ((eq (device-type) 'win32) "Windows; 32bit") + ((eq (device-type) 'tty) "(Unix?); TTY") + (t "UnkownPlatform"))) + + ;; Set up the entity definition for PGP and PEM authentication + (setq url-pgp/pem-entity (or url-pgp/pem-entity + user-mail-address + (format "%s@%s" (user-real-login-name) + (system-name)))) + + (setq url-personal-mail-address (or url-personal-mail-address + url-pgp/pem-entity + user-mail-address)) + + (if (or (memq url-privacy-level '(paranoid high)) + (and (listp url-privacy-level) + (memq 'email url-privacy-level))) + (setq url-personal-mail-address nil)) + + (if (or (eq url-privacy-level 'paranoid) + (and (listp url-privacy-level) + (memq 'os url-privacy-level))) + (setq url-os-type nil) + (let ((vers (emacs-version))) + (if (string-match "(\\([^, )]+\\))$" vers) + (setq url-os-type (url-match vers 1)) + (setq url-os-type (symbol-name system-type)))))) + +(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))) + (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 'rlogin) + (url-register-protocol 'shttp nil nil "80") + (url-register-protocol 'telnet) + (url-register-protocol 'tn3270) + (url-register-protocol 'wais) + (url-register-protocol 'x-exec) + (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 "~/.w3cookies"))) + + (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 "~/.mosaic-global-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 url-use-transparent with decent defaults + (if (not (eq (device-type) 'tty)) + (setq url-use-transparent nil)) + (and url-use-transparent (require 'transparent)) + + ;; 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 + ((boundp '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 + "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))) + +(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-prepare-cache-for-file (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." + + ;; COMMENT: We don't delete directories because that requires + ;; recursively deleting the directories's contents, which might + ;; eliminate a substantial portion of the cache. + + (cond + ((url-cache-file-writable-p file) + t) + ((file-directory-p file) + nil) + (t + (catch 'upcff-tag + (let ((dir (file-name-directory file)) + dir-parent dir-last-component) + (if (string-equal dir file) + ;; *** Should I have a warning here? + ;; FILE must match a pattern like /foo/bar/, indicating it is a + ;; name only suitable for a directory. So presume we won't be + ;; able to overwrite FILE and return nil. + (throw 'upcff-tag nil)) + + ;; Make sure the containing directory exists, or throw a failure + ;; if we can't create it. + (if (file-directory-p dir) + nil + (or (fboundp 'make-directory) + (throw 'upcff-tag nil)) + (make-directory dir t) + ;; make-directory silently fails if there is an obstacle, so + ;; we must verify its results. + (if (file-directory-p dir) + nil + ;; Look at prefixes of the path to find the obstacle that is + ;; stopping us from making the directory. Unfortunately, there + ;; is no portable function in Emacs to find the parent directory + ;; of a *directory*. So this code may not work on VMS. + (while (progn + (if (eq ?/ (aref dir (1- (length dir)))) + (setq dir (substring dir 0 -1)) + ;; Maybe we're on VMS where the syntax is different. + (throw 'upcff-tag nil)) + (setq dir-parent (file-name-directory dir)) + (not (file-directory-p dir-parent))) + (setq dir dir-parent)) + ;; We have found the longest path prefix that exists as a + ;; directory. Deal with any obstacles in this directory. + (if (file-exists-p dir) + (condition-case nil + (delete-file dir) + (error (throw 'upcff-tag nil)))) + (if (file-exists-p dir) + (throw 'upcff-tag nil)) + ;; Try making the directory again. + (setq dir (file-name-directory file)) + (make-directory dir t) + (or (file-directory-p dir) + (throw 'upcff-tag nil)))) + + ;; The containing directory exists. Let's see if there is + ;; something in the way in this directory. + (if (url-cache-file-writable-p file) + (throw 'upcff-tag t) + (condition-case nil + (delete-file file) + (error (throw 'upcff-tag nil)))) + + ;; The return value, if we get this far. + (url-cache-file-writable-p file)))))) + +(defun url-store-in-cache (&optional buff) + "Store buffer BUFF in the cache" + (if (or (not (get-buffer buff)) + (member url-current-type '("www" "about" "https" "shttp" + "news" "mailto")) + (and (member url-current-type '("file" "ftp" nil)) + (not url-current-server)) + ) + nil + (save-excursion + (and buff (set-buffer buff)) + (let* ((fname (url-create-cached-filename (url-view-url t))) + (fname-hdr (concat (if (memq system-type '(ms-windows ms-dos os2)) + (url-file-extension fname t) + fname) ".hdr")) + (info (mapcar (function (lambda (var) + (cons (symbol-name var) + (symbol-value var)))) + '( url-current-content-length + url-current-file + url-current-isindex + url-current-mime-encoding + url-current-mime-headers + url-current-mime-type + url-current-port + url-current-server + url-current-type + url-current-user + )))) + (cond ((and (url-prepare-cache-for-file fname) + (url-prepare-cache-for-file 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))) + ((numberp x) (int-to-string x)) + (t "'???")) "\n"))) + info) + (insert ")\n") + (write-region (point-min) (point-max) fname-hdr nil 5))))))) + + +(defun url-is-cached (url) + "Return non-nil if the URL is cached." + (let* ((fname (url-create-cached-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-create-cached-filename-using-md5 (url) + (if url + (expand-file-name (md5 url) + (concat url-temporary-directory "/" + (user-real-login-name))))) + +(defun url-create-cached-filename (url) + "Return a filename in the local cache for URL" + (if url + (let* ((url url) + (urlobj (if (vectorp url) + url + (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 + (mm-string-to-tokens + (or hostname "localhost") ?.)))))) + (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 "")))) + + (if (and fname (memq system-type '(ms-windows ms-dos windows-nt)) + (string-match "\\([A-Za-z]\\):[/\\]" fname)) + (setq fname (concat (url-match fname 1) "/" + (substring fname (match-end 0))))) + + (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)))) + + ;; Honor hideous 8.3 filename limitations on dos and windows + ;; we don't have to worry about this in Windows NT/95 (or OS/2?) + (if (and fname (memq system-type '(ms-windows ms-dos))) + (let ((base (url-file-extension fname t)) + (ext (url-file-extension fname nil))) + (setq fname (concat (substring base 0 (min 8 (length base))) + (substring ext 0 (min 4 (length ext))))) + (setq host-components + (mapcar + (function + (lambda (x) + (if (> (length x) 8) + (concat + (substring x 0 8) "." + (substring x 8 (min (length x) 11))) + x))) + host-components)))) + + (and fname + (expand-file-name fname + (expand-file-name + (mapconcat 'identity host-components "/") + url-temporary-directory)))))) + +(defun url-extract-from-cache (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-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 ((filename-chars "%.?@a-zA-Z0-9---()_/:~=&") 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 (string-match (concat "[" filename-chars "]") + (char-to-string (following-char))) + (progn + (skip-chars-backward filename-chars) + (setq start (point)) + (skip-chars-forward filename-chars)) + (setq start (point))) + (setq url (if (fboundp 'buffer-substring-no-properties) + (buffer-substring-no-properties start (point)) + (buffer-substring start (point))))) + (if (string-match "^URL:" url) + (setq url (substring url 4 nil))) + (if (string-match "\\.$" url) + (setq url (substring url 0 -1))) + (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 (= x ?\n) "" (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-clean-text () + "Clean up a buffer, removing any excess garbage from a gateway mechanism, +and decoding any MIME content-transfer-encoding used." + (set-buffer url-working-buffer) + (goto-char (point-min)) + (url-replace-regexp "Connection closed by.*" "") + (goto-char (point-min)) + (url-replace-regexp "Process WWW.*" "")) + +(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* ((extn (url-file-extension url-current-file)) + (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))) + (code-3 (and (not code-1) (not code-2) + (cdr-safe (assoc extn url-uncompressor-alist)))) + (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)) + (cond + ((null decoder) nil) + ((stringp decoder) + (message "Decoding...") + (call-process-region (point-min) (point-max) decoder t t nil) + (message "Decoding... done.")) + ((listp decoder) + (apply 'call-process-region (point-min) (point-max) + (car decoder) t t nil (cdr decoder))) + ((and (symbolp decoder) (fboundp decoder)) + (message "Decoding...") + (funcall decoder (point-min) (point-max)) + (message "Decoding... done.")) + (t + (error "Bad entry for %s in `mm-content-transfer-encodings'" + code))))) + (list code-1 code-2 code-3)))) + (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) + (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)))))) + ((fboundp 'w3-sentinel) + (set-variable 'w3-working-buffer buf) + (w3-sentinel)) + (t + (message "Retrieval for %s complete." buf)))) + +(defun url-sentinel (proc string) + (let* ((buf (process-buffer 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) + (url-clean-text) + (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 (mm-extension-to-mime + (url-file-extension + url-current-file))))))) + (if (member status '(401 301 302 303 204)) + nil + (funcall url-default-retrieval-proc (buffer-name url-working-buffer)))))) + +(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) + (let ((url "")) + (cond + ((equal url-current-type "gopher") + (setq url (format "%s://%s%s/%s" + url-current-type url-current-server + (if (or (null url-current-port) + (string= "70" url-current-port)) "" + (concat ":" url-current-port)) + url-current-file))) + ((equal url-current-type "news") + (setq url (concat "news:" + (if (not (equal url-current-server + url-news-server)) + (concat "//" url-current-server + (if (or (null url-current-port) + (string= "119" url-current-port)) + "" + (concat ":" url-current-port)) "/")) + url-current-file))) + ((equal url-current-type "about") + (setq url (concat "about:" url-current-file))) + ((member url-current-type '("http" "shttp" "https")) + (setq url (format "%s://%s%s/%s" url-current-type url-current-server + (if (or (null url-current-port) + (string= "80" url-current-port)) + "" + (concat ":" url-current-port)) + (if (and url-current-file + (= ?/ (string-to-char url-current-file))) + (substring url-current-file 1 nil) + url-current-file)))) + ((equal url-current-type "ftp") + (setq url (format "%s://%s%s/%s" url-current-type + (if (and url-current-user + (not (string= "anonymous" url-current-user))) + (concat url-current-user "@") "") + url-current-server + (if (and url-current-file + (= ?/ (string-to-char url-current-file))) + (substring url-current-file 1 nil) + url-current-file)))) + ((and (member url-current-type '("file" nil)) url-current-file) + (setq url (format "file:%s" url-current-file))) + ((equal url-current-type "www") + (setq url (format "www:/%s/%s" url-current-server url-current-file))) + (t + (setq url nil))) + (if (not no-show) (message "%s" url) url))) + +(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) + (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))) + +(defvar url-external-retrieval-program "www" + "*Name of the external executable to run to retrieve URLs.") + +(defvar url-external-retrieval-args '("-source") + "*A list of arguments to pass to `url-external-retrieval-program' to +retrieve a URL by its HTML source.") + +(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) + (if (and type urlobj) + (setq url-current-server (url-host urlobj) + url-current-type (url-type urlobj) + url-current-port (url-port urlobj) + url-current-file (url-filename urlobj))) + (if (member url-current-file '("/" "")) + (setq url-current-mime-type "text/html")))))) + +(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)) + "]"))))) + +;;;###autoload +(defun url-cache-expired (url mod) + "Return t iff a cached file has expired." + (if (not (string-match url-nonrelative-link url)) + t + (let* ((urlobj (url-generic-parse-url url)) + (type (url-type urlobj))) + (cond + (url-standalone-mode + (not (file-exists-p (url-create-cached-filename urlobj)))) + ((string= type "http") + (if (not url-standalone-mode) t + (not (file-exists-p (url-create-cached-filename urlobj))))) + ((not (fboundp 'current-time)) + 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))))) + +(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 + (setq proxy (pop 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))) + (if (get-buffer url-working-buffer) + (save-excursion + (set-buffer url-working-buffer) + (erase-buffer) + (setq url-current-can-be-cached (not no-cache)) + (set-buffer-modified-p nil))) + (let* ((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) + (tmp url-current-file)) + (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-extract-from-cache + (car-safe + (cdr-safe (assoc (or type "auto") + url-registered-protocols)))) + url (if cached (url-create-cached-filename url) url)) + (save-excursion + (set-buffer (get-buffer-create url-working-buffer)) + (setq url-current-can-be-cached (not no-cache))) + ; (if url-be-asynchronous + ; (url-download-minor-mode t)) + (if (and handler (fboundp handler)) + (funcall handler url) + (set-buffer (get-buffer-create url-working-buffer)) + (setq url-current-file tmp) + (erase-buffer) + (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, please " + "<a href=\"mailto://" url-bug-address "\">send me mail.</a>" + "<p><address>William Perry</address><br>" + "<address>" url-bug-address "</address>") + (setq url-current-file "error.html")) + (if (and + (not url-be-asynchronous) + (get-buffer url-working-buffer)) + (progn + (set-buffer url-working-buffer) + + (url-clean-text))) + (cond + ((equal type "wais") nil) + ((and url-be-asynchronous (not cached) (member type '("http" "proxy"))) + nil) + (url-be-asynchronous + (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"))) + (not url-current-mime-type)) + (if (url-buffer-is-hypertext) + (setq url-current-mime-type "text/html") + (setq url-current-mime-type (mm-extension-to-mime + (url-file-extension + url-current-file))))) + (if (and url-automatic-caching url-current-can-be-cached + (not url-be-asynchronous)) + (save-excursion + (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:" 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) + (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))) + (if (and expected-md5 url-check-md5s) + (let ((cur-md5 (md5 (current-buffer)))) + (if (not (string= cur-md5 expected-md5)) + (and (not (funcall url-confirmation-func + "MD5s do not match, use anyway? ")) + (error "MD5 error."))))) + 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/urlauth.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,303 @@ +;;; urlauth.el --- Uniform Resource Locator authorization modules +;; Author: wmperry +;; Created: 1996/10/09 19:00:59 +;; Version: 1.2 +;; Keywords: comm, data, processes, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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 (or (url-host href) url-current-server)) + (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 (or (url-host href) url-current-server)) + (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.") + +(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))))) + +(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)
--- a/lisp/w3/w3-about.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-about.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-about.el --- About pages for emacs-w3 ;; Author: wmperry -;; Created: 1996/06/30 18:02:26 -;; Version: 1.3 +;; Created: 1996/12/16 16:44:46 +;; Version: 1.6 ;; Keywords: hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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) @@ -78,11 +80,11 @@ ((string= "style" node) (insert " --- This is the stylesheet for the about pages for Emacs-w3 -- +/* This is the stylesheet for the about pages for Emacs-w3 */ -address,h1,h2,h3,h4,h5,h6 { align:\"center\" } -wired { color:yellow } -wired { background:red } +address,h1,h2,h3,h4,h5,h6 { text-align: center } +wired { color: yellow } +wired { background: red } ")) ((string= "license" node) (kill-buffer (current-buffer))
--- a/lisp/w3/w3-annotat.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-annotat.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-annotat.el --- Annotation functions for Emacs-W3 ;; Author: wmperry -;; Created: 1996/06/30 18:02:56 -;; Version: 1.3 +;; Created: 1996/10/09 19:00:59 +;; Version: 1.5 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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/lisp/w3/w3-auto.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-auto.el Mon Aug 13 09:06:37 2007 +0200 @@ -32,18 +32,17 @@ ;; Stylesheet stuff (autoload 'w3-handle-style "w3-style") -(autoload 'w3-style-parse-css "w3-style") -(autoload 'w3-generate-stylesheet-faces "w3-style") +(autoload 'w3-display-stylesheet "w3-style") ;; 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 'widget-at "w3-forms") (autoload 'w3-next-widget "w3-forms") ;; Widget stuff @@ -53,6 +52,7 @@ (autoload 'widget-put "widget-edit") (autoload 'widget-forward "widget-edit") (autoload 'widget-backward "widget-edit") +(autoload 'widget-at "widget-edit") ;; Preferences (autoload 'w3-preferences-edit "w3-prefs")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:06:37 2007 +0200 @@ -0,0 +1,1866 @@ +;;; w3-display.el --- display engine v99999 +;; Author: wmperry +;; Created: 1997/01/02 20:20:45 +;; Version: 1.90 +;; Keywords: faces, help, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 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 'css) +(require 'font) +(require 'w3-widget) +(require 'w3-imap) + +(defmacro w3-d-s-var-def (var) + (` (make-variable-buffer-local (defvar (, var) nil)))) + +(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-stack) +(w3-d-s-var-def w3-display-whitespace-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) +(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-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-pixmap) +(w3-d-s-var-def w3-display-css-properties) + +(eval-when-compile + (defmacro w3-get-attribute (attr) + (` (cdr-safe (assq (, attr) args)))) + + (defmacro w3-get-face-info (info) + (let ((var (intern (format "w3-face-%s" info)))) + (` (push (w3-get-style-info (quote (, info)) 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) + (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 pixmap) + (w3-get-face-info color) + (w3-get-face-info background) + (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 text-decoration) + ;;(w3-pop-face-info pixmap) + (w3-pop-face-info color) + (w3-pop-face-info background)))) + + ) + +(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)) + +(defun w3-pause () + (cond + (w3-running-FSF19 (sit-for 0)) + (w3-running-xemacs + (sit-for 0)) + ;; (if (and (not (sit-for 0)) (input-pending-p)) + ;; (condition-case () + ;; (dispatch-event (next-command-event)) + ;; (error nil))) + (t (sit-for 0)))) + +(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. +If TEMPORARY is non-nil, this face will cease to exist if not in use." + (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))) + (setq w3-face-descr (list w3-face-font-spec + (car w3-face-color) + (car w3-face-background)) + 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) + 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 w3-face-font-spec + (set-face-font w3-face-face w3-face-font-spec)) + (if (car w3-face-color) + (set-face-foreground w3-face-face (car w3-face-color))) + (if (car w3-face-background) + (set-face-background w3-face-face (car w3-face-background))) + ;;(set-face-background-pixmap w3-face-face w3-face-pixmap) + (setq w3-face-cache (cons + (cons w3-face-descr w3-face-face) + w3-face-cache))) + 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) + +(defvar w3-bullets + '((disc . ?*) + (circle . ?o) + (square . ?#) + ) + "*An assoc list of unordered list types mapping to characters to use +as the bullet character.") + + +(defsubst w3-display-line-break (n) + (if (or + (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told + (= w3-last-fill-pos (point)) + (> w3-last-fill-pos (point-max))) + (if (/= (preceding-char) ?\n) (setq n (1+ n))) ; at least put one line in + (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)) + (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 (w3-make-face nil "Stub face... don't ask." t)) + +(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 (preceding-char) '(? ?\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 'duplicable t)) + (if (car w3-active-voices) + (add-text-properties w3-scratch-start-point (point) + (list 'personality (car w3-active-voices)))) + ) + +(defun w3-widget-echo (widget &rest ignore) + (let ((href (widget-get widget 'href)) + (name (widget-get widget 'name)) + (text (buffer-substring (widget-get widget :from) + (widget-get widget :to))) + (title (widget-get widget 'title)) + (msg nil)) + (if href + (setq href (url-truncate-url-for-viewing href))) + (if name + (setq name (concat "anchor:" name))) + (case w3-echo-link + (url (or href title text name)) + (text (or text title href name)) + (title (or title text href name)) + (otherwise nil)))) + +(defun w3-follow-hyperlink (widget &rest ignore) + (let* ((target (widget-get widget '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))))) + +(defun w3-balloon-help-callback (object &optional event) + (let* ((widget (widget-at (extent-start-position object))) + (href (and widget (widget-get widget 'href)))) + (if href + (url-truncate-url-for-viewing href) + nil))) + + +;; Various macros +(eval-when-compile + (defmacro w3-expand-url (url) + (` + (url-expand-file-name (, url) + (cdr-safe + (assoc + (cdr-safe + (assq 'base args)) w3-base-alist))))) + + (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 () + (` + (case (car break-style) + (list-item + (let ((list-style (w3-get-style-info 'list-style node)) + (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))))) + ) + ) + ) + + (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 '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 + (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-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-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-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) + (w3-handle-style args)) + (otherwise + ) + ) + ) + ) + + +;; Image handling +(defun w3-maybe-start-image-download (widget) + (let* ((src (widget-get widget 'src)) + (cached-glyph (w3-image-cached-p src))) + (if (and cached-glyph (widget-glyphp cached-glyph)) + (setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting)) + (cond + ((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! + (w3-warn 'images (format "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 widget) + url-be-asynchronous t + url-current-callback-func 'w3-finalize-image-download) + (url-retrieve src)) + (setq-default url-be-asynchronous old-asynch))))))) + +(defun w3-finalize-image-download (widget) + (let ((glyph nil) + (url (widget-get widget 'src)) + (node nil) + (buffer (widget-get widget 'buffer))) + (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) + (w3-warn 'image (format "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)) + + (if (and (buffer-name buffer) ; Dest. buffer exists + (widget-glyphp glyph)) ; got a valid glyph + (save-excursion + (set-buffer buffer) + (if (eq major-mode 'w3-mode) + (widget-value-set widget glyph) + (setq w3-image-widgets-waiting + (cons widget w3-image-widgets-waiting))))))) + +(defmacro w3-node-visible-p () + (` (not (eq (car break-style) 'none)))) + +(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)) + (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))) + (widget nil) + (align (or (w3-get-attribute 'align) + (w3-get-style-info 'vertical-align node)))) + (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 + )) + (widget-put widget 'buffer (current-buffer)) + (w3-maybe-start-image-download widget) + (goto-char (point-max))))) + +;; The table handling + +(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") + +(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) + (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 + (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) + (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)))) + +(defvar w3-table-ascii-border-chars + [? ? ? ?/ ? ?- ?\\ ?- ? ?\\ ?| ?| ?/ ?- ?| ?-] + "Vector of ascii characters to use to draw table borders. +w3-table-unhack-border-chars uses this to restore w3-table-border-chars.") + +(defvar w3-table-border-chars w3-table-ascii-border-chars + "Vector of characters to use to draw table borders. +If you set this you should set w3-table-ascii-border-chars to the same value +so that w3-table-unhack-borders can restore the value if necessary. + +A reasonable value is [? ? ? ?/ ? ?- ?\\\\ ?^ ? ?\\\\ ?| ?< ?/ ?- ?> ?-] +Though i recommend replacing the ^ with - and the < and > with |") + +(defsubst w3-table-lookup-char (l u r b) + (aref w3-table-border-chars (logior (if l 1 0) + (if u 2 0) + (if r 4 0) + (if b 8 0)))) + +(defun w3-table-hack-borders nil + "Try to find the best set of characters to draw table borders with. +I definitely recommend trying this on X. +On a console, this can trigger some Emacs display bugs. + +I haven't tried this on XEmacs or any window-system other than X." + (interactive) + (case (device-type) + (x + (let ((id (or (and (find-face 'w3-table-hack-x-face) + (face-id 'w3-table-hack-x-face)) + (progn + (make-face 'w3-table-hack-x-face) + (set-face-font 'w3-table-hack-x-face + (make-font :family "terminal")) + (face-id 'w3-table-hack-x-face))))) + (if (not (face-differs-from-default-p 'w3-table-hack-x-face)) + nil + (aset standard-display-table 1 (vector (+ (* 256 id) ?l))) + (aset standard-display-table 2 (vector (+ (* 256 id) ?q))) + (aset standard-display-table 3 (vector (+ (* 256 id) ?k))) + (aset standard-display-table 4 (vector (+ (* 256 id) ?t))) + (aset standard-display-table 5 (vector (+ (* 256 id) ?n))) + (aset standard-display-table 6 (vector (+ (* 256 id) ?u))) + (aset standard-display-table 7 (vector (+ (* 256 id) ?m))) + (aset standard-display-table 8 (vector (+ (* 256 id) ?x))) + (aset standard-display-table 11 (vector (+ (* 256 id) ?j))) + (aset standard-display-table 14 (vector (+ (* 256 id) ?v))) + (aset standard-display-table 15 (vector (+ (* 256 id) ?w))) + (setq w3-table-border-chars [? ? ? 11 ? 2 7 14 ? 3 8 6 1 15 4 5]) + (setq w3-horizontal-rule-char 2)))) + (tty + (standard-display-g1 1 108) ; ulcorner + (standard-display-g1 2 113) ; hline + (standard-display-g1 3 107) ; urcorner + (standard-display-g1 4 116) ; leftt + (standard-display-g1 5 110) ; intersection + (standard-display-g1 6 117) ; rightt + (standard-display-g1 7 109) ; llcorner + (standard-display-g1 8 120) ; vline + (standard-display-g1 11 106) ; lrcorner + (standard-display-g1 14 118) ; upt + (standard-display-g1 15 119) ; downt + (setq w3-table-border-chars [? ? ? 11 ? 2 7 14 ? 3 8 6 1 15 4 5]) + (setq w3-horizontal-rule-char 2)) + (otherwise + (error "Unknown window-system, can't do any better than ascii borders"))) + ) + +(defun w3-table-unhack-borders nil + (interactive) + (w3-table-excise-hack (buffer-list)) + (standard-display-default 1 15) + (setq w3-table-border-chars w3-table-ascii-border-chars) + (setq w3-horizontal-rule-char ?-)) + +(defun w3-table-excise-hack (buffs) + "Replace hacked characters with ascii characters in buffers BUFFS. +Should be run before restoring w3-table-border-chars to ascii characters." + (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)) + (if (< (aref w3-table-border-chars i) 16) + (aset tr + (aref w3-table-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))) + +(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) + (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) + (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 + inhibit-read-only t + 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))))) + (while cols + (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)))) + (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))))) + )) + + ;; 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 (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)) + + (insert (w3-table-lookup-char lflag tflag rflag bflag)) + (setq lflag t) + (cond ((= (aref prev-rowspans i) 0) + (insert-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)) + (setq lflag nil) + (setq i (+ i (max (aref table-colspans i) + (aref prev-colspans i) 1)))))) + (insert (w3-table-lookup-char lflag (/= row 1) nil t) "\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-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))) + (insert (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)) + (insert (w3-table-lookup-char lflag tflag t nil)) + (setq lflag t) + (insert-char (w3-table-lookup-char t nil t nil) + (aref column-dimensions i)) + (setq i (1+ i))) + (insert (w3-table-lookup-char t t nil nil) "\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-node (node &optional nofaces) + (let ( + (content-stack (list (list node))) + (right-margin-stack (list fill-column)) + (left-margin-stack (list 0)) + node + insert-before + insert-after + tag + args + content + hyperlink-info + break-style + cur + id + class + ) + (while content-stack + (setq content (pop content-stack)) + (pop w3-active-faces) + (pop w3-active-voices) + (case (car (pop w3-display-open-element-stack)) + ;; 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 + 'mouse-face 'highlight + 'duplicable t + 'help-echo 'w3-balloon-help-callback + 'balloon-help 'w3-balloon-help-callback)) + (fillin-text-property (car hyperlink-info) (point) + 'button 'button (cadr hyperlink-info)) + (widget-put (cadr hyperlink-info) :to (set-marker + (make-marker) (point)))) + (setq hyperlink-info nil)) + (form + (pop w3-display-form-stack)) + ((ol ul dl dir menu) + (pop w3-display-list-stack)) + (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 + (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 "")) + (setq sheet (format "%s.%s { %s }\n" tag unique-id + (w3-get-attribute 'style))) + (setf (nth 1 node) (cons (cons 'id unique-id) args)) + (w3-handle-style (list (cons 'data sheet) + (cons 'notation "css"))))) + (setq w3-display-css-properties (css-get + (nth 0 node) (nth 1 node) + w3-current-stylesheet + w3-display-open-element-stack)) + (if nofaces + nil + (push (w3-face-for-element node) w3-active-faces) + (push (w3-voice-for-element node) w3-active-voices)) + (push (w3-get-style-info 'display node) break-style) + (push (w3-get-style-info 'insert-after node) insert-after) + (setq insert-before (w3-get-style-info 'insert-before node)) + (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)) + (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)) + (setq st (point) + hyperlink-info (list + st + (append + (list 'link :args nil + :value "" :tag "" + :action 'w3-follow-hyperlink + :from + (set-marker (make-marker) st) + :help-echo 'w3-widget-echo + ) + (alist-to-plist args)))) + (w3-handle-content node) + ) + ) + ((ol ul dl dir menu) + (push 0 w3-display-list-stack) + (w3-handle-content node)) + (img ; inlined image + (w3-handle-image) + (w3-handle-empty-tag)) + (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%")) + (rule nil) + (width nil)) + (setq perc (/ (min (string-to-int perc) 100) 100.0) + width (* fill-column perc) + rule (make-string (max (truncate width) 0) + w3-horizontal-rule-char) + node (list 'hr nil (list rule))) + (w3-handle-content node))) + (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) + ) + (table ; Yeeee-hah! + (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))) + ) + (*document + (let ((info (mapcar (lambda (x) (cons x (symbol-value x))) + w3-persistent-variables))) + (set-buffer (generate-new-buffer "Untitled")) + (setq w3-current-form-number 0 + w3-display-open-element-stack nil + w3-last-fill-pos (point-min) + fill-column (min (- (or w3-strict-width (window-width)) + w3-right-margin) + (or w3-maximum-line-length + (window-width)))) + (switch-to-buffer (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) + (setq w3-current-stylesheet (css-copy-stylesheet + w3-user-stylesheet) + w3-last-fill-pos (point) + fill-column (min (- (or w3-strict-width (window-width)) + w3-right-margin) + (or w3-maximum-line-length + (window-width))) + fill-prefix "") + (set (make-local-variable 'inhibit-read-only) t)) + (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 (string-match "^[ \t]*$" potential-title) + nil + (rename-buffer (generate-new-buffer-name + (w3-fix-spaces potential-title))))) + (w3-handle-empty-tag)) + (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))) + (push (cons + (cons 'form-number + w3-current-form-number) + args) w3-display-form-stack) + (w3-handle-content node))) + (input + (if (not (assq 'form w3-display-open-element-stack)) + (message "Input field outside of a <form>") + (let* ( + (type (intern (downcase (or (w3-get-attribute 'type) + "text")))) + (name (w3-get-attribute 'name)) + (value (or (w3-get-attribute 'value) "")) + (size (if (w3-get-attribute 'size) + (string-to-int (w3-get-attribute 'size)))) + (maxlength (cdr (assoc 'maxlength args))) + (default value) + (action (car w3-display-form-stack)) + (options) + (id (w3-get-attribute 'id)) + (checked (assq 'checked args))) + (if (and (string-match "^[ \t\n\r]+$" value) + (not (eq type 'hidden))) + (setq value "")) + (if maxlength (setq maxlength (string-to-int maxlength))) + (if (and name (string-match "[\r\n]" name)) + (setq name (mapconcat (function + (lambda (x) + (if (memq x '(?\r ?\n)) + "" + (char-to-string x)))) + name ""))) + (if (memq type '(checkbox radio)) (setq default checked)) + (if (and (eq type 'checkbox) (string= value "")) + (setq value "on")) + (w3-form-add-element type name + value size maxlength default action + options w3-current-form-number id checked + (car w3-active-faces)) + ) + ) + (w3-handle-empty-tag) + ) + (select + (if (not (assq 'form w3-display-open-element-stack)) + (message "Input field outside of a <form>") + (let* ( + (name (w3-get-attribute 'name)) + (size (string-to-int (or (w3-get-attribute 'size) + "20"))) + (maxlength (cdr (assq 'maxlength args))) + (value nil) + (tmp nil) + (action (car w3-display-form-stack)) + (options) + (id (w3-get-attribute 'id)) + (checked (assq 'checked args))) + (if maxlength (setq maxlength (string-to-int maxlength))) + (if (and name (string-match "[\r\n]" name)) + (setq name (mapconcat (function + (lambda (x) + (if (memq x '(?\r ?\n)) + "" + (char-to-string x)))) + name ""))) + (setq options + (mapcar + (function + (lambda (n) + (setq tmp (w3-normalize-spaces + (apply 'concat (nth 2 n))) + tmp (cons tmp + (or + (cdr-safe (assq 'value (nth 1 n))) + tmp))) + (if (assq 'selected (nth 1 n)) + (setq value (car tmp))) + tmp)) + (nth 2 node))) + (if (not value) + (setq value (caar options))) + (w3-form-add-element 'option name + value size maxlength value action + options w3-current-form-number id nil + (car 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 + (if (not (assq 'form w3-display-open-element-stack)) + (message "Input field outside of a <form>") + (let* ( + (name (w3-get-attribute 'name)) + (size (string-to-int (or (w3-get-attribute 'size) + "20"))) + (maxlength (cdr (assq 'maxlength args))) + (value (w3-normalize-spaces + (apply 'concat (nth 2 node)))) + (default value) + (tmp nil) + (action (car w3-display-form-stack)) + (options) + (id (w3-get-attribute 'id)) + (checked (assq 'checked args))) + (if maxlength (setq maxlength (string-to-int maxlength))) + (if (and name (string-match "[\r\n]" name)) + (setq name (mapconcat (function + (lambda (x) + (if (memq x '(?\r ?\n)) + "" + (char-to-string x)))) + name ""))) + (w3-form-add-element 'multiline name + value size maxlength value action + options w3-current-form-number id nil + (car w3-active-faces)) + ) + ) + (w3-handle-empty-tag) + ) + (style + (w3-handle-style (cons (cons 'data (apply 'concat (nth 2 node))) + (nth 1 node))) + (w3-handle-empty-tag)) + (otherwise + ;; Generic formatting + (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) + (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-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) + (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting) + (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))) + (widget-value-set widget glyph)))) + (w3-mode) + ;;(w3-handle-annotations) + ;;(w3-handle-headers) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (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))))) + ) + +(provide 'w3-display)
--- a/lisp/w3/w3-draw.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2191 +0,0 @@ -;;; w3-draw.el --- Emacs-W3 drawing functions for new display engine -;; Author: wmperry -;; Created: 1996/08/25 17:12:32 -;; Version: 1.17 -;; Keywords: faces, help, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 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 function will take a stream of HTML from w3-parse-buffer -;;; and draw it out -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'w3-vars) -(require 'w3-imap) -(require 'w3-widget) -(require 'widget) -(require 'cl) - -(if (featurep 'mule) (fset 'string-width 'length)) - -(defmacro w3-get-state (tag) - (or (symbolp tag) - (error "Bad argument: %s" tag)) - (let ((index (length (memq tag w3-state-locator-variable)))) - (` (aref w3-state-vector (, index))))) -(put 'w3-get-state 'edebug-form-spec '(symbolp)) - -(defmacro w3-put-state (tag val) - (or (symbolp tag) - (error "Bad argument: %s" tag)) - (let ((index (length (memq tag w3-state-locator-variable)))) - (` (aset w3-state-vector (, index) (, val))))) -(put 'w3-put-state 'edebug-form-spec '(symbolp form)) - -(defsubst w3-push-alignment (align) - (if align - (w3-put-state :align (cons (cons tag align) (w3-get-state :align))))) - -(defsubst w3-pop-alignment () - (let ((flubber (memq (assq tag (w3-get-state :align)) - (w3-get-state :align)))) - (cond - ((null flubber) nil) - ((cdr flubber) - (w3-put-state :align (cdr flubber))) - (t (w3-put-state :align nil))))) - -(defsubst w3-current-alignment () - (cdr-safe (car-safe (w3-get-state :align)))) - -(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)) - -(defsubst w3-set-fill-prefix-length (len) - (setq fill-prefix (if (< len (- (or w3-strict-width (window-width)) 4)) - (if (< len 80) - (aref w3-fill-prefixes-vector len) - (make-string len ? )) - (url-warn - 'html - "Runaway indentation! Too deep for window width!") - fill-prefix))) - -(defsubst w3-get-default-style-info (info) - (and w3-current-stylesheet - (or - ;; Check for tag/id|name first! - (cdr-safe (assq info - (cdr-safe - (assoc (or (cdr-safe (assq 'id args)) - (cdr-safe (assq 'name args))) - (cdr-safe - (assq tag w3-current-stylesheet)))))) - - ;; Check for tag/class next - (cdr-safe (assq info - (cdr-safe - (assoc (cdr-safe (assq 'class args)) - (cdr-safe - (assq tag w3-current-stylesheet)))))) - - ;; Then for global stuff with 'class' - (cdr-safe (assq info - (cdr-safe - (assoc (cdr-safe (assq 'class args)) - (cdr-safe - (assq 'doc w3-current-stylesheet)))))) - - ;; Fall back on the default styles for just this tag. - (cdr-safe (assq info - (cdr-safe - (assq 'internal - (cdr-safe - (assq tag w3-current-stylesheet))))))))) - -(defsubst 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))) - -(defun w3-pause () - (cond - (w3-running-FSF19 (sit-for 0)) - (w3-running-xemacs - (if (and (not (sit-for 0)) (input-pending-p)) - (condition-case () - (dispatch-event (next-command-event)) - (error nil)))) - (t (sit-for 0)))) - -(defvar w3-end-tags - '((/ul . ul) - (/lit . lit) - (/li . li) - (/h1 . h1) - (/h2 . h2) - (/h3 . h3) - (/h4 . h4) - (/h5 . h5) - (/h6 . h6) - (/font0 . font0) - (/font1 . font1) - (/font2 . font2) - (/font3 . font3) - (/font4 . font4) - (/font5 . font5) - (/font6 . font6) - (/font7 . font7) - (/ol . ol) - (/dl . dl) - (/menu . menu) - (/dir . dir) - (/a . a))) - -(defvar w3-face-cache nil - "Cache for w3-face-for-element") - -(defsubst w3-voice-for-element () - (let ((temporary-voice (w3-get-default-style-info 'voice-spec))) - (and temporary-voice (cons tag temporary-voice)))) - -(defsubst w3-face-for-element () - (let* ((font-spec (w3-get-default-style-info 'font-spec)) - (foreground (w3-get-default-style-info 'color)) - (background (w3-get-default-style-info 'background)) - ;;(pixmap (w3-get-default-style-info 'pixmap)) - (descr (list font-spec foreground background)) - (face (cdr-safe (assoc descr w3-face-cache)))) - (if (or face (not (or foreground background font-spec))) - nil ; Do nothing, we got it already - (setq face (intern (format "%s" descr))) - (cond - ((not (fboundp 'make-face)) nil) ; Do nothing - ((and (fboundp 'face-property) ; XEmacs 19.14 - (not (get 'face-property 'sysdep-defined-this))) - (setq face (make-face face - "An Emacs-W3 face... don't edit by hand." t))) - (t (make-face face))) - - (and font-spec (set-face-font face font-spec)) - (and foreground (set-face-foreground face foreground)) - (and background (set-face-background face background)) - ;(set-face-background-pixmap face pixmap) - (setq w3-face-cache (cons (cons descr face) w3-face-cache))) - (cons tag face))) - -(defun w3-handle-single-tag (tag &optional args) - (save-excursion - (and w3-draw-buffer (set-buffer w3-draw-buffer)) - (let ((opos (point)) - (id (and (listp args) - (or (cdr-safe (assq 'name args)) - (cdr-safe (assq 'id args)))))) - - ;; This allows _ANY_ tag, whether it is known or not, to be - ;; the target of a # reference in a URL - (if id - (progn - (setq w3-id-positions (cons - (cons (intern id) - (set-marker (make-marker) - (point-max))) - w3-id-positions)))) - - (if (and (listp args) (cdr-safe (assq 'style args))) - (let ((unique-id (or id (url-create-unique-id))) - (sheet "")) - (setq sheet (format "%s.%s { %s }\n" tag unique-id - (cdr-safe (assq 'style args))) - args (cons (cons 'id unique-id) args)) - - (w3-handle-style (list (cons 'data sheet) - (cons 'notation "css"))))) - (goto-char (point-max)) - (if (and (w3-get-state :next-break) - (not (memq tag - '(p h1 h2 h3 h4 h5 h6 ol ul dl menu dir pre)))) - (w3-handle-p)) - (w3-put-state :next-break nil) - (setq w3-current-formatter (get tag 'w3-formatter)) - (cond - ((eq 'w3-handle-text w3-current-formatter) - (w3-handle-text args)) - (t - (let ((data-before nil) - (data-after nil)) - (if (and (not (eq tag 'text)) w3-current-stylesheet) - (progn - (setq data-before (w3-get-default-style-info - 'insert.before)) - (let ((tag (cdr-safe (assq tag w3-end-tags)))) - (setq data-after (and tag - (w3-get-default-style-info - 'insert.after)))))) - (if data-before (w3-handle-text data-before)) - (setq w3-current-formatter (get tag 'w3-formatter)) - (cond - ((eq w3-current-formatter 'ack) nil) - ((null w3-current-formatter) (w3-handle-unknown-tag tag args)) - (t (funcall w3-current-formatter args))) - (if data-after (w3-handle-text data-after))))) - (if (not (eq tag 'text)) - (setq w3-last-tag tag)) - (goto-char opos)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Set up basic fonts/stuff -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun w3-init-state () - ;; Reset the state of an HTML drawing buffer - (setq w3-state-vector (copy-sequence w3-state-vector)) - (setq w3-current-stylesheet (copy-tree w3-user-stylesheet)) - (let* ((tag 'html) - (args nil) - (face (cdr (w3-face-for-element)))) - (if (not face) - (setq tag 'body - face (cdr (w3-face-for-element)))) - (and face - (if (not (fboundp 'valid-specifier-locale-p)) - nil - (w3-my-safe-copy-face face 'default (current-buffer))))) - (setq w3-form-labels nil) - (make-local-variable 'w3-image-widgets-waiting) - (make-local-variable 'w3-active-voices) - (make-local-variable 'inhibit-read-only) - (setq w3-image-widgets-waiting nil - inhibit-read-only t) - (if (not (get 'w3-state 'init)) (w3-draw-setup)) - (fillarray w3-state-vector 0) - (w3-put-state :bogus nil) ; Make all fake ones return nil - (w3-put-state :text-mangler nil) ; Any text mangling routine - (w3-put-state :next-break nil) ; Next item needs a paragraph break - (w3-put-state :background nil) ; Netscapism - gag - (w3-put-state :table nil) ; Table args - (w3-put-state :figdata nil) ; Data for <fig> tag - (w3-put-state :figalt nil) ; Alt data for <fig> tag - (w3-put-state :pre-start nil) ; Where current <pre> seg starts - (w3-put-state :zone nil) ; Zone of current href? - (w3-put-state :center nil) ; netscape tag - (w3-put-state :select nil) ; Data for current select field - (w3-put-state :options nil) ; Options in current select field - (w3-put-state :nofill nil) ; non-nil if in pre or xmp - (w3-put-state :nowrap nil) ; non-nil if in <p nowrap> - (w3-put-state :href nil) ; Current link destination - (w3-put-state :name nil) ; Current link ID tag - (w3-put-state :image nil) ; Current image destination - (w3-put-state :form nil) ; Current form information - (w3-put-state :optarg nil) ; Option arguments - (w3-put-state :w3-graphic nil) ; Image stuff for non-xemacs - (w3-put-state :lists '()) ; Types of list currently in. - (w3-put-state :align nil) ; Current alignment of paragraphs - (w3-put-state :title nil) ; Whether we can have a title or not - (w3-put-state :seen-this-url nil) ; whether we have seen this url or not - (w3-put-state :needspace 'never) ; Spacing info - (setq w3-active-faces nil) ; Face attributes to use - (setq w3-active-voices nil) ; voice attributes to use - ) - -(defun w3-draw-setup () - (put 'w3-state 'init t) - (w3-init-state)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Mapping HTML tags to functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(put 'lit 'w3-formatter 'w3-handle-pre) -(put '/lit 'w3-formatter 'w3-handle-/pre) -(put 'li 'w3-formatter 'w3-handle-list-item) -(put 'ul 'w3-formatter 'w3-handle-list-opening) -(put 'ol 'w3-formatter 'w3-handle-list-opening) -(put 'dl 'w3-formatter 'w3-handle-list-opening) -(put '/dl 'w3-formatter 'w3-handle-list-ending) -(put '/ul 'w3-formatter 'w3-handle-list-ending) -(put '/ol 'w3-formatter 'w3-handle-list-ending) -(put 'menu 'w3-formatter 'w3-handle-list-opening) -(put '/menu 'w3-formatter 'w3-handle-list-ending) -(put 'dir 'w3-formatter 'w3-handle-list-opening) -(put '/dir 'w3-formatter 'w3-handle-list-ending) -(put 'dt 'w3-formatter 'w3-handle-table-term) -(put 'dd 'w3-formatter 'w3-handle-table-definition) -(put 'a 'w3-formatter 'w3-handle-hyperlink) -(put '/a 'w3-formatter 'w3-handle-hyperlink-end) -(put 'h1 'w3-formatter 'w3-handle-header) -(put 'h2 'w3-formatter 'w3-handle-header) -(put 'h3 'w3-formatter 'w3-handle-header) -(put 'h4 'w3-formatter 'w3-handle-header) -(put 'h5 'w3-formatter 'w3-handle-header) -(put 'h6 'w3-formatter 'w3-handle-header) -(put '/h1 'w3-formatter 'w3-handle-header-end) -(put '/h2 'w3-formatter 'w3-handle-header-end) -(put '/h3 'w3-formatter 'w3-handle-header-end) -(put '/h4 'w3-formatter 'w3-handle-header-end) -(put '/h5 'w3-formatter 'w3-handle-header-end) -(put '/h6 'w3-formatter 'w3-handle-header-end) -(put 'img 'w3-formatter 'w3-handle-image) -(put 'kill_sgml 'w3-formatter 'w3-handle-kill-sgml) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The main drawing routines -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-unknown-tag (tag args) - ;; A generic formatter for an unkown HTML tag. This will only be - ;; called if a formatter was not found in TAGs property list. - ;; If a function named `w3-handle-TAG' is defined, then it will be - ;; stored in TAGs property list, so it will be found next time - ;; the tag is run across. - - (let ((handler (intern-soft (concat "w3-handle-" (symbol-name tag)))) - (end-tag-p (= (string-to-char (symbol-name tag)) ?/))) - - ;; This stores the info in w3-end-tags for future use by the display - ;; engine. - (if end-tag-p - (setq w3-end-tags (cons (cons tag - (intern (substring (symbol-name tag) - 1))) - w3-end-tags))) - - ;; For proper use of stylesheets, if no tag is found, then we should - ;; at least call w3-handle-emphasis - (cond - ((and handler (fboundp handler)) - (put tag 'w3-formatter handler) - (funcall handler args)) - (end-tag-p - (put tag 'w3-formatter 'w3-handle-emphasis-end) - (w3-handle-emphasis-end args)) - (t - (put tag 'w3-formatter 'w3-handle-emphasis) - (w3-handle-emphasis args))))) - -(defun w3-handle-text (&optional args) - ;; This is the main workhorse of the display engine. - ;; It will figure out how a chunk of text should be displayed and - ;; put all the necessary extents/overlays/regions around it." - (or args (error "Impossible")) - (if (string= args "") - (w3-put-state :needspace nil) - (let ((st (point)) - (mangler (w3-get-state :text-mangler)) - (sym nil)) - (insert args) - ;;(goto-char st) - (cond ((w3-get-state :nofill) - (goto-char st) - (if (not (search-forward "\n" nil t)) - (subst-char-in-region st (point-max) ?\r ?\n) - (subst-char-in-region st (point-max) ?\r ? )) - (goto-char (point-max))) - (t - (goto-char st) - (while (re-search-forward - " [ \t\n\r]+\\|[\t\n\r][ \t\n\r]*" - nil 'move) - (replace-match " ")) - (goto-char st) - (if (and (= ? (following-char)) - (or (bolp) - (eq 'never (w3-get-state :needspace)))) - (delete-char 1)) - (goto-char (point-max)))) - (and mangler w3-delimit-emphasis - (fboundp mangler) (funcall mangler st (point))) - (let ((faces nil) - (todo w3-active-faces) - (voices w3-active-voices) - (val nil) - (cur nil)) - (while todo - (setq cur (car todo) - todo (cdr todo)) - (cond - ((symbolp cur) - nil) - ((listp (cdr-safe cur)) - (let ((x (cdr cur))) - (while x - (if (not (memq (car x) faces)) - (setq faces (cons (car x) faces))) - (setq x (cdr x))))) - ((and (consp cur) (not (memq (cdr cur) faces))) - (setq faces (cons (cdr cur) faces))) - (t nil))) - (add-text-properties st (point) (list 'face faces)) - (if (car voices) - (add-text-properties st (point) (list 'personality (cdar voices)))) - ) - (if (not (memq (char-after (1- (point))) '(? ?.))) - (w3-put-state :needspace t)) - ))) - -(defun w3-handle-plaintext (&optional args) - (let ((x (w3-get-state :nofill))) - (w3-put-state :nofill t) - (and args (cdr-safe (assq 'data args)) - (w3-handle-text (cdr-safe (assq 'data args)))) - (setq w3-last-fill-pos (point)))) - -(defun w3-handle-/plaintext (&optional args) - (w3-put-state :nofill nil)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Paragraph breaks, and other things that can cause linebreaks and -;;; alignment changes. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-header (&optional args) - ;; Handle the creation of a header (of any level). Causes a full - ;; paragraph break. - (w3-handle-emphasis args) - (let ((name (or (cdr-safe (assq 'name args)) - (cdr-safe (assq 'id args)))) - (align (cdr-safe (assq 'align args))) - (mangler (nth 2 (cdr-safe (assq tag w3-header-chars-assoc))))) - (w3-handle-p) - (if align - (setq align (intern (downcase align))) - (setq align (w3-get-default-style-info 'align))) - (let ((tag 'p)) - (w3-pop-alignment)) - (w3-push-alignment align) - (w3-put-state :text-mangler mangler) - (if name (w3-put-state :name name)))) - -(defun w3-handle-header-end (&optional args) - ;; Handle the closing of a header (of any level). Causes a full - ;; paragraph break. - (w3-handle-emphasis-end) - (let ((mangler (w3-get-state :text-mangler))) - (and mangler (funcall mangler nil nil t))) - (w3-put-state :text-mangler nil) - (goto-char (point-max)) - (w3-handle-p) - (let* ((info (car-safe (w3-get-state :lists))) - (type (and info (car-safe info)))) - (if (and type fill-prefix) - (insert fill-prefix (cond - ((memq type '(ol dl)) " ") - (t " "))))) - (let ((tag (cdr-safe (assoc tag w3-end-tags)))) - (w3-pop-alignment))) - -(defun w3-handle-pre (&optional args) - ;; Marks the start of a preformatted section of text. No paragraph - ;; filling should be done from this point until a matching /pre has - ;; been encountered. - (w3-handle-p) - (w3-put-state :nofill t) - (w3-put-state :needspace t) - (w3-put-state :pre-start (set-marker (make-marker) (point))) - ) - -(defun w3-handle-xmp (&optional args) - ;; Marks the start of a preformatted section of text. No paragraph - ;; filling should be done from this point until a matching /pre has - ;; been encountered. - (w3-handle-p) - (w3-put-state :nofill t) - (w3-put-state :needspace t) - (w3-put-state :pre-start (set-marker (make-marker) (point))) - (if (and args (cdr-safe (assq 'data args))) - (progn - (w3-handle-text (cdr-safe (assq 'data args))) - (w3-handle-/xmp)))) - -(defun w3-handle-/pre (&optional args) - (if (not (w3-get-state :nofill)) - (w3-handle-p) - (w3-put-state :nofill nil) - (let* ((info (car-safe (w3-get-state :lists))) - (type (and info (car-safe info))) - (st (w3-get-state :pre-start))) - (if (not (bolp)) (insert "\n")) - (if (and type fill-prefix st) - (progn - (save-excursion - (goto-char st) - (while (re-search-forward "^" nil t) - (insert fill-prefix (cond - ((memq type '(ol dl)) " ") - (t " "))))) - (setq w3-last-fill-pos (point)) - (insert fill-prefix (cond - ((memq type '(ol dl)) " ") - (t " ")))) - (setq w3-last-fill-pos (point)))) - (let ((tag 'p)) - (w3-handle-p)) - (setq w3-active-faces nil) - (w3-put-state :pre-start nil))) - -(fset 'w3-handle-/xmp 'w3-handle-/pre) - -(defun w3-handle-blockquote (&optional args) - ;; Start a section of quoted text. This is done by causing the text - ;; to be indented from the right and left margins. Nested - ;; blockquotes will cause further indentation. - (let ((align (or (w3-get-default-style-info 'align) 'indent))) - (w3-handle-p) - (w3-push-alignment align)) - (w3-put-state :fillcol fill-column) - (setq fill-column (max (- (or fill-column - (1- (or w3-strict-width (window-width)))) 8) - 10))) - -(defun w3-handle-/blockquote (&optional args) - (w3-handle-paragraph) - (let ((tag (cdr-safe (assoc tag w3-end-tags)))) - (w3-pop-alignment)) - (setq fill-column (or (w3-get-state :fillcol) (1- (or w3-strict-width - (window-width))))) - (w3-put-state :fillcol nil)) - -(defun w3-handle-align (&optional args) - ;; Cause a single line break (like <BR>) and replace the current - ;; alignment. - (let ((align (intern (or (cdr-safe (assq 'role args)) - (cdr-safe (assq 'align args)) - (cdr-safe (assq 'style args)))))) - (w3-handle-paragraph) - (w3-push-alignment align))) - -(defun w3-handle-/align (&optional args) - (w3-handle-paragraph) - (w3-pop-alignment)) - -(defun w3-handle-hr (&optional args) - ;; Cause a line break and insert a horizontal rule across the page. - (w3-handle-paragraph) - (let* ((perc (or (cdr-safe (assq 'width args)) - (w3-get-default-style-info 'width) - "100%")) - (old-align (w3-current-alignment)) - (talign (or (cdr-safe (assq 'textalign args)) - (cdr-safe (assq 'text-align args)) - (w3-get-default-style-info 'textalign) - (w3-get-default-style-info 'text-align) - (and old-align (symbol-name old-align)) - "center")) - (text (cdr-safe (assq 'label args))) - (align (or (cdr-safe (assq 'align args)) - (w3-get-default-style-info 'align) - old-align - 'center)) - (rule nil) - (width nil)) - (if (stringp talign) - (setq talign (intern (downcase talign)))) - (if (stringp align) - (setq align (intern (downcase align)))) - (w3-push-alignment align) - - (setq perc (min (string-to-int perc) 100) - width (/ (* (- (or w3-strict-width - (window-width)) - w3-right-border) perc) 100)) - (if text - (cond - ((>= (length text) width) - (setq rule (concat "-" text "-"))) - ((eq talign 'right) - (setq rule (concat (make-string (- width 1 (length text)) - w3-horizontal-rule-char) - text "-"))) - ((eq talign 'center) - (let ((half (make-string (/ (- width (length text)) 2) - w3-horizontal-rule-char))) - (setq rule (concat half text half)))) - ((eq talign 'left) - (setq rule (concat "-" text (make-string (- width 1 - (length text)) - w3-horizontal-rule-char))))) - (setq rule (make-string width w3-horizontal-rule-char))) - (w3-handle-text rule) - (condition-case () - (w3-handle-paragraph) - (error nil)) - (w3-pop-alignment) - (setq w3-last-fill-pos (point)) - (let* ((info (car-safe (w3-get-state :lists))) - (type (and info (car-safe info))) - (cur (w3-current-alignment))) - (cond - ;;((eq cur 'indent) - ;;(insert (make-string w3-indent-level ? ))) - ((and type fill-prefix (eq w3-last-tag 'dt)) - (insert fill-prefix)) - ((and type fill-prefix) - (insert fill-prefix (if (eq type 'ol) " " " "))) - (t nil))))) - -(defun w3-handle-/p (&optional args) - ;; Marks the end of a paragraph. Only causes a paragraph break if - ;; it is not followed by another paragraph or similar markup - ;; (headers, list openings, etc) that will already cause a new - ;; paragraph to be started. - (w3-handle-emphasis-end) - (let ((tag (cdr-safe (assoc tag w3-end-tags)))) - (w3-handle-p) - (w3-pop-alignment))) - -(defun w3-handle-p (&optional args) - (if (or (not (memq w3-last-tag '(li tr td th dt dd))) - (memq tag '(ol ul dl menu dir))) - (let ((name (or (cdr-safe (assq 'name args)) - (cdr-safe (assq 'id args)))) - (align (cdr-safe (assoc 'align args)))) - (w3-handle-emphasis-end) - (w3-handle-emphasis args) - (w3-handle-paragraph) - (w3-put-state :nowrap (assq 'nowrap args)) - (setq align (if align - (intern (downcase align)) - (w3-get-default-style-info 'align))) - (and (eq tag 'p) (progn - (w3-pop-alignment) - (w3-push-alignment align))) - (if (not (bobp)) - (progn - (insert (cond - ((and (eolp) (bolp)) "\n") - ((eolp) "\n\n") - (t "\n"))) - (setq w3-last-fill-pos (point)) - (cond - ((null fill-prefix)) - ((string= fill-prefix "")) - ((eq (car (car (w3-get-state :lists))) 'ol) - (insert fill-prefix " ")) - (t (insert fill-prefix " "))))) - (if name (w3-put-state :name name))))) - -(defun w3-handle-br (&optional args) - ;; Cause a single line break. - ;; The alignment will only effect the chunk of text (generally to - ;; the last <br> or <p> tag) immediately before the <br>. After - ;; that, the alignment will revert to the containers alignment. - (w3-handle-paragraph) - (let* ((info (car-safe (w3-get-state :lists))) - (type (and info (car-safe info))) - (cur (w3-current-alignment))) - (cond - ;;((eq cur 'indent) - ;;(insert (make-string w3-indent-level ? ))) - ((and type fill-prefix (eq w3-last-tag 'dt)) - (insert fill-prefix)) - ((and type fill-prefix) - (insert fill-prefix (if (eq type 'ol) " " " "))) - (t nil)))) - -(defun w3-handle-paragraph (&optional args) - (if (not (bobp)) - (let ((align (w3-current-alignment)) - (fill-prefix fill-prefix)) - (cond - ((eq align 'indent) - (w3-set-fill-prefix-length - (+ (length fill-prefix);; works even if fill-prefix is nil - w3-indent-level))) - ((null fill-prefix) - (setq fill-prefix "")) - ((string= fill-prefix "")) - ((eq (car (car (w3-get-state :lists))) 'ol) - (w3-set-fill-prefix-length (+ 4 (length fill-prefix)))) - (t - (w3-set-fill-prefix-length (+ 2 (length fill-prefix))))) - (if (eq align 'indent) - (progn - (goto-char w3-last-fill-pos) - (insert fill-prefix) - (goto-char (point-max)))) - (if (and (> (current-column) fill-column) - (not (w3-get-state :nowrap)) - (not (w3-get-state :nofill))) - (fill-region-as-paragraph w3-last-fill-pos (point) - (eq align 'justify))) - (if (not w3-last-fill-pos) - (setq w3-last-fill-pos (point-min))) - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (delete-region (point) (point-max)) - (if (< w3-last-fill-pos (point)) - (cond - ((or (eq align 'center) (w3-get-state :center)) - (center-region w3-last-fill-pos (point))) - ((eq align 'right) - (let ((x (point))) - (catch 'fill-exit - (save-excursion - (goto-char w3-last-fill-pos) - (while (re-search-forward "$" x t) - (if (/= (current-column) fill-column) - (let ((buff (- fill-column (current-column)))) - (beginning-of-line) - (setq x (+ x buff)) - (if (> buff 0) - (insert (make-string buff ? ))) - (end-of-line)) - (end-of-line)) - (if (eobp) (throw 'fill-exit t)) - (condition-case () - (forward-char 1) - (error (throw 'fill-exit t)))))))))) - (insert "\n") - (setq w3-last-fill-pos (point)) - (w3-put-state :needspace 'never)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; List handling code -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-list-ending (&optional args) - ;; Handles all the list terminators (/ol /ul /dl). - ;; This just fills the last paragrpah, then reduces the depth in - ;; `w3-state' and truncates `fill-prefix'" - (w3-handle-paragraph) - (w3-put-state :depth (max 0 (1- (w3-get-state :depth)))) - (w3-put-state :next-break t) - (w3-set-fill-prefix-length (* (w3-get-state :depth) w3-indent-level)) - (w3-put-state :lists (cdr (w3-get-state :lists))) - (if (/= 0 (length fill-prefix)) - (insert fill-prefix " "))) - -(defun w3-handle-list-opening (&optional args) - ;; Handles all the list openers (ol ul dl). - ;; This just fills the last paragraph, then increases the depth in - ;; `w3-state' and adds to `fill-prefix' - (w3-handle-p) - (let ((style (and (not (assq 'style args)) - (w3-get-default-style-info 'style)))) - (if style - (setq args (cons (cons 'style style) args)))) - ;; Default VALUE attribute for OL is 1. - (if (eq tag 'ol) - (or (assq 'value args) - (setq args (cons (cons 'value 1) args)))) - (w3-put-state :depth (1+ (w3-get-state :depth))) - (w3-set-fill-prefix-length (* (w3-get-state :depth) w3-indent-level)) - (insert "\n\n" fill-prefix " ") - (w3-put-state :lists (cons (cons tag (copy-alist args)) - (w3-get-state :lists)))) - -(defun w3-handle-table-definition (&optional args) - (w3-handle-paragraph) - (insert fill-prefix " ")) - -(defun w3-handle-table-term (&optional args) - (w3-handle-paragraph) - (insert "\n" fill-prefix)) - -(defun w3-handle-list-item (&optional args) - (w3-handle-paragraph) - (let* ((info (car (w3-get-state :lists))) - (type (car info)) - (endr (or (nth (1- (or (w3-get-state :depth) 1)) - (cdr (or (assoc type w3-list-chars-assoc) - (car w3-list-chars-assoc)))) - "*"))) - (setq info (cdr info)) - (cond - ((assq 'plain info) - ;; We still need to indent from the left margin for lists without - ;; bullets. This is especially important with nested lists. - ;; Question: Do we want this to be equivalent to replacing the - ;; bullet by a space (" ") or by indenting so that the text starts - ;; where the bullet would have been? I've chosen the latter after - ;; looking at both kinds of output. - (insert fill-prefix)) - ((eq type 'ol) - (let ((next (or (assq 'seqnum info) (assq 'value info))) - (type (cdr-safe (assq 'style info))) - (uppr (assq 'upper info)) - (tokn nil)) - (if (stringp (cdr next)) (setcdr next (string-to-int (cdr next)))) - (cond - ((or (assq 'roman info) - (member type '("i" "I"))) - (setq tokn (concat - (w3-pad-string (w3-decimal-to-roman (cdr next)) 3 ? - 'left) - endr))) - ((or (assq 'arabic info) - (member type '("a" "A"))) - (setq tokn (concat (w3-pad-string - (w3-decimal-to-alpha (cdr next)) 3 ? 'left) - endr))) - (t - (setq tokn (concat (w3-pad-string (int-to-string (cdr next)) - 2 ? 'left) - endr)))) - (if (assq 'uppercase info) - (setq tokn (upcase tokn))) - (insert fill-prefix tokn " ") - (setcdr next (1+ (cdr next))) - (w3-put-state :needspace 'never))) - (t - (insert fill-prefix endr " "))))) - -(defun w3-pad-string (str len pad side) - ;; Pads a string STR to a certain length LEN, using fill character - ;; PAD by concatenating PAD to SIDE of the string. - (let ((strlen (length str))) - (cond - ((>= strlen len) str) - ((eq side 'right) (concat str (make-string (- len strlen) pad))) - ((eq side 'left) (concat (make-string (- len strlen) pad) str))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Routines to handle character-level formatting -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-q (&optional args) - (w3-handle-emphasis) - (w3-handle-text (or (w3-get-default-style-info 'startquote) "\""))) - -(defun w3-handle-/q (&optional args) - (let ((tag (cdr-safe (assoc tag w3-end-tags)))) - (w3-handle-text (or (w3-get-default-style-info 'endquote) "\""))) - (w3-handle-emphasis-end)) - -(defun w3-handle-emphasis (&optional args) - ;; Generic handler for character-based emphasis. Increments the state - ;; of TAG (which must be bound by the calling procedure). This - ;; checks all the various stylesheet mechanisms that may cause an - ;; alignment shift as well. - (let ((align (or (w3-get-default-style-info 'align) - (and (eq tag 'address) w3-right-justify-address 'right)))) - (if (and align (not (memq tag '(h1 h2 h3 h4 h5 h6)))) - (progn - (w3-handle-paragraph) - (w3-push-alignment align)))) - (let* ((spec (and w3-delimit-emphasis (assoc tag w3-style-tags-assoc))) - (class (cdr-safe (assq 'class args))) - (face (w3-face-for-element)) - (voice (w3-voice-for-element)) - (beg (and spec (car (cdr spec))))) - (if spec - (insert beg)) - (if voice - (setq w3-active-voices (cons voice w3-active-voices))) - (if face - (setq w3-active-faces (cons face w3-active-faces))))) - -(defun w3-handle-emphasis-end (&optional args) - ;; Generic handler for ending character-based emphasis. Decrements - ;; the state of TAG (which must be bound by the calling procedure). - ;; Stylesheet mechanisms may cause arbitrary alignment changes. - (let* ((tag (cdr-safe (assq tag w3-end-tags))) - (spec (and w3-delimit-emphasis (assq tag w3-style-tags-assoc))) - (end (and spec (cdr (cdr spec))))) - (if (assq tag w3-active-voices) - (setq w3-active-voices (cdr (memq (assq tag w3-active-voices) - w3-active-voices))) - (setq w3-active-voices (delq tag w3-active-voices))) - (if (assq tag w3-active-faces) - (setq w3-active-faces (cdr (memq (assq tag w3-active-faces) - w3-active-faces))) - (setq w3-active-faces (delq tag w3-active-faces))) - (if spec (insert end)) - (if (eq tag 'address) - (progn - (w3-handle-paragraph) - (w3-pop-alignment))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; HTML 3.0 compliance -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-math (&optional args) - (w3-handle-br) - (w3-handle-text "[START MATH - Not Implemented (Yet)]") - (w3-handle-br)) - -(defun w3-handle-/math (&optional args) - (w3-handle-br) - (w3-handle-text "[END MATH]") - (w3-handle-br)) - -(defun w3-handle-tr (&optional args) - (w3-handle-br)) - -(defun w3-handle-/tr (&optional args) - (w3-handle-br)) - -(defun w3-handle-td (&optional args) - (w3-handle-text " | ")) - -(defun w3-handle-/td (&optional args) - (w3-handle-text " | ")) - -(defun w3-handle-th (&optional args) - (w3-handle-text " | ")) - -(defun w3-handle-/th (&optional args) - (w3-handle-text " | ")) - -(defun w3-handle-table (&optional args) - (w3-handle-br)) - -(defun w3-handle-/table (&optional args) - (w3-handle-br)) - -(defun w3-handle-div (&optional args) - (let ((align (cdr-safe (assq 'align args)))) - (w3-handle-emphasis args) - (w3-handle-paragraph) - (setq align (and align (intern (downcase align)))) - (w3-push-alignment align))) - -(defun w3-handle-/div (&optional args) - (w3-handle-emphasis-end) - (let ((tag (cdr-safe (assq tag w3-end-tags)))) - (w3-handle-paragraph) - (w3-pop-alignment))) - -(defun w3-handle-note (&optional args) - (w3-handle-emphasis) - (w3-handle-paragraph) - (let ((align (or (w3-get-default-style-info 'align) 'indent))) - (w3-push-alignment align)) - (w3-handle-text (concat (or (cdr-safe (assq 'role args)) "CAUTION") ":"))) - -(defun w3-handle-/note (&optional args) - (w3-handle-paragraph) - (w3-handle-emphasis-end) - (let ((tag (cdr-safe (assoc tag w3-end-tags)))) - (w3-pop-alignment))) - -(defun w3-handle-fig (&optional args) - (w3-put-state :figdata args) - (w3-put-state :figalt (set-marker (make-marker) (point))) - ) - -(defun w3-handle-caption (&optional args) - ) - -(defun w3-handle-/caption (&optional args) - ) - -(defun w3-handle-/fig (&optional args) - (let* ((data (w3-get-state :figdata)) - (src (cdr-safe (assq 'src data))) - (aln (cdr-safe (assq 'align data))) - (alt (if (w3-get-state :figalt) - (prog1 - (buffer-substring (w3-get-state :figalt) (point)) - (delete-region (w3-get-state :figalt) (point))))) - (ack nil)) - (setq w3-last-fill-pos (point)) - (if (not src) - (w3-warn 'html "Malformed <fig> tag.") - (setq ack (list (cons 'src src) - (cons 'alt alt) - (cons 'align aln))) - (w3-handle-pre nil) - (w3-handle-image ack) - (w3-handle-/pre nil)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Netscape Compatibility -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; For some reason netscape treats </br> like <br> - ugh. -(fset 'w3-handle-/br 'w3-handle-br) - -(defun w3-create-blank-pixmap (width height) - (let ((retval - (concat "/* XPM */\n" - "static char *pixmap[] = {\n" - ;;"/* width height num_colors chars_per_pixel */\n" - (format "\" %d %d 2 1\",\n" width height) - ;;"/* colors */\n" - "\". c #000000 s background\",\n" - "\"# c #FFFFFF s foreground\",\n" - ;;"/* pixels /*\n" - )) - (line (concat "\"" (make-string width ?.) "\""))) - (while (/= 1 height) - (setq retval (concat retval line ",\n") - height (1- height))) - (concat retval line "\n};"))) - -(defun w3-handle-spacer (&optional args) - (let ((type (cdr-safe (assq 'type args))) - (size (cdr-safe (assq 'size args))) - (w (or (cdr-safe (assq 'width args)) 1)) - (h (or (cdr-safe (assq 'height args)) 1)) - (align (cdr-safe (assq 'align args))) - (glyph nil)) - (condition-case () - (setq glyph (make-glyph - (vector 'xpm :data (w3-create-blank-pixmap w h)))) - (error nil)) - ) - ) - -(defun w3-handle-font (&optional args) - (let* ((sizearg (cdr-safe (assq 'size args))) - (sizenum (cond - ((null sizearg) nil) - ((= ?+ (string-to-char sizearg)) - (min (+ 3 (string-to-int (substring sizearg 1))) 7)) - ((= ?- (string-to-char sizearg)) - (max (- 3 (string-to-int (substring sizearg 1))) 0)) - ((string= sizearg (int-to-string (string-to-int sizearg))) - (string-to-int sizearg)) - (t nil))) - (family (cdr-safe (assq 'face args))) - (color (cdr-safe (assq 'color args))) - (normcolor (if color (w3-normalize-color color))) - (w3-current-stylesheet (list - (list 'font - (list 'internal - (cons 'font-family family) - (cons 'font-size-index sizenum) - (cons 'foreground normcolor)))))) - (w3-style-post-process-stylesheet w3-current-stylesheet) - (w3-handle-emphasis args))) - -(defun w3-handle-/font (&optional args) - (w3-handle-emphasis-end)) - -(defun w3-handle-center (&optional args) - (w3-handle-paragraph) - (w3-push-alignment 'center)) - -(defun w3-handle-/center (&optional args) - (w3-handle-paragraph) - (let ((tag 'center)) - (w3-pop-alignment))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Bonus HTML Tags just for fun :) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-embed (&optional args) - ;; This needs to be reimplemented!!! - ) - -(defun w3-handle-blink (&optional args) - ;; Keep track of all the buffers with blinking in them, and do GC - ;; of this list whenever a new <blink> tag is encountered. The - ;; timer checks this list to see if any of the buffers are visible, - ;; and only blinks the face if there are any visible. This cuts - ;; down tremendously on the amount of X traffic, and frame !@#!age - ;; due to lots of face munging. - (w3-handle-emphasis args) - (let ((buffs w3-blinking-buffs) - (name1 (buffer-name)) - (name2 nil) - (add t)) - (setq w3-blinking-buffs nil) - ;; Get rid of old buffers - (while buffs - (setq name2 (buffer-name (car buffs))) - (if (null name2) - nil - (setq w3-blinking-buffs (cons (car buffs) w3-blinking-buffs)) - (if (string= name1 name2) - (setq add nil))) - (setq buffs (cdr buffs))) - (if add - (setq w3-blinking-buffs (cons (current-buffer) w3-blinking-buffs))))) - -(defun w3-handle-/blink (&optional args) - (w3-handle-emphasis-end args)) - -(defun w3-handle-peek (&optional args) - ;; Handle the peek tag. Valid attributes are: - ;; VARIABLE:: any valid lisp variable - ;; If VARIABLE is bound and non-nil, then the value of the variable is - ;; inserted at point. This can handle variables whos values are any - ;; arbitrary lisp type. - (let* ((var-name (cdr-safe (assq 'variable args))) - (var-sym (and var-name (intern var-name))) - (val (and var-sym (boundp var-sym) (symbol-value var-sym)))) - (cond - ((null val) nil) - ((stringp val) (w3-handle-text val)) - (t (w3-handle-text (format "%S" val)))))) - -(defun w3-rotate-region (st nd &optional rotation) - "Ceasar rotate a region between ST and ND using ROTATION as the -amount to rotate the text. Defaults to caesar (13)." - (setq rotation (or rotation 13)) - (save-excursion - (let (x) - (while (< st nd) - (setq x (char-after st)) - (cond - ((and (>= x ?a) (<= x ?z)) - (setq x (- x ?a) - x (char-to-string (+ (% (+ x rotation) 26) ?a)))) - ((and (>= x ?A) (<= x ?Z)) - (setq x (- x ?A) - x (char-to-string (+ (% (+ x rotation) 26) ?A)))) - (t (setq x nil))) - (if x (progn (goto-char st) (delete-char 1) (insert x))) - (setq st (1+ st)))))) - -(defun w3-handle-kill-sgml (&optional args) - (w3-handle-text "SGML is the spawn of evil! It must be stopped!")) - -(defun w3-handle-secret (&optional args) - (if (fboundp 'valid-specifier-locale-p) - (let ((tag 'rot13)) - (w3-handle-emphasis)) - (w3-put-state :secret (set-marker (make-marker) (point))))) - -(defun w3-handle-/secret (&optional args) - "Close a secret region of text." - (if (fboundp 'valid-specifier-locale-p) - (let ((tag '/rot13)) - (w3-handle-emphasis-end)) - (if (integer-or-marker-p (w3-get-state :secret)) - (progn - (w3-rotate-region (w3-get-state :secret) (point)) - (w3-put-state :secret nil))))) - -(defun w3-handle-hype (&optional args) - (if (and (or (featurep 'nas-sound) (featurep 'native-sound)) - (assoc 'hype sound-alist)) - (play-sound 'hype 100) - (w3-handle-text "Hey, has Marca A. told you how cool he is?"))) - -(defun w3-handle-yogsothoth (&optional args) - (w3-handle-image (list (cons 'src "href-to-yogsothoth-pic") - (cons 'alt "YOGSOTHOTH LIVES!!!")))) - -(defun w3-handle-roach (&optional args) - (w3-handle-text "Man, I am so wasted...")) - -(defun w3-handle-/roach (&optional args) - (w3-handle-text (concat "So, you wanna get some " - (or (cdr-safe (assq 'munchy args)) - "nachos") "? "))) - -(defun w3-invert-face (face) - (let ((buffs w3-blinking-buffs) - (blink nil) - (buff nil)) - (if buffs - (while buffs - (setq buff (car buffs)) - (cond - ((bufferp buff) - (if (buffer-name buff) - (setq buff (car buffs)) - (setq buff nil))) - ((stringp buff) - (setq buff (get-buffer buff))) - (t - (setq buff nil))) - (setq buffs (cdr buffs) - buff (and buff (get-buffer-window buff 'visible)) - buff (and buff (window-live-p buff))) - (if buff (setq buffs nil - blink t)))) - (if blink (invert-face face)))) - -(autoload 'sentence-ify "flame") -(autoload 'string-ify "flame") -(autoload '*flame "flame") -(if (not (fboundp 'flatten)) (autoload 'flatten "flame")) - -(defvar w3-cookie-cache nil) - -(defun w3-handle-cookie (&optional args) - (if (not (fboundp 'cookie)) - (w3-handle-text "Sorry, no cookies today.") - (let* ((url-working-buffer (url-generate-new-buffer-name " *cookie*")) - (href (url-expand-file-name - (or (cdr-safe (assq 'src args)) - (cdr-safe (assq 'href args))) - (cdr-safe (assoc (cdr-safe (assq 'base args)) - w3-base-alist)))) - (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 (assoc href w3-cookie-cache)) - (save-excursion - (url-clear-tmp-buffer) - (setq url-be-asynchronous nil) - (url-retrieve href) - (url-uncompress) - (write-region (point-min) (point-max) fname 5) - (setq w3-cookie-cache (cons (cons href fname) w3-cookie-cache)))) - (w3-handle-text (cookie fname st nd))))) - -(defun w3-handle-flame (&optional args) - (condition-case () - (w3-handle-text - (concat - (sentence-ify - (string-ify - (append-suffixes-hack (flatten (*flame))))))) - (error nil))) - -(defun w3-handle-pinhead (&optional args) - (if (fboundp 'yow) - (w3-handle-text (yow)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Client-side Imagemaps -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-map (&optional args) - (w3-put-state :map (cons (or (cdr-safe (assq 'name args)) - (cdr-safe (assq 'id args)) - "unnamed") nil))) - -(defun w3-handle-/map (&optional args) - (and (w3-get-state :map) - (setq w3-imagemaps (cons (w3-get-state :map) w3-imagemaps))) - (w3-put-state :map nil)) - -(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-handle-area (&optional args) - (let ((type (downcase (or (cdr-safe (assq 'shape args)) "rect"))) - (coords (w3-decode-area-coords (or (cdr-safe (assq 'coords args)) ""))) - (alt (cdr-safe (assq 'alt args))) - (href (if (assq 'nohref args) - t - (url-expand-file-name - (or (cdr-safe (assq 'src args)) - (cdr-safe (assq 'href args))) - (cdr-safe (assoc (cdr-safe (assq 'base args)) - w3-base-alist))))) - (map (w3-get-state :map))) - ;; data structure in storage is a vector - ;; if (href == t) then no action should be taken - ;; [ type coordinates href (hopefully)descriptive-text] - (setcdr map (cons (vector type coords href alt) (cdr map))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Tags that don't really get drawn, etc. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-/html (&optional args) - ;; Technically, we are not supposed to have any text outside the - ;; html element, so start ignoring everything. - (put 'text 'w3-formatter 'ack)) - -(defun w3-handle-body (&optional args) - (if (not w3-user-colors-take-precedence) - (let* ((vlink (cdr-safe (assq 'vlink args))) - (alink (cdr-safe (assq 'alink args))) - (link (cdr-safe (assq 'link args))) - (text (cdr-safe (assq 'text args))) - (backg (cdr-safe (assq 'background args))) - (rgb (or (cdr-safe (assq 'bgcolor args)) - (cdr-safe (assq 'rgb args)))) - (temp-face nil) - (sheet "")) - (setq backg (url-expand-file-name - backg - (cdr-safe (assoc (cdr-safe (assq 'base args)) - w3-base-alist)))) - (if (or text rgb backg) - (progn - (setq sheet "html {") - (if text (setq sheet (format "%scolor: %s; " sheet - (w3-normalize-color text)))) - (if rgb (setq sheet (format "%sbackground: %s; " - sheet (w3-normalize-color rgb)))) - (if backg (setq sheet (format "%sbackdrop: %s; " - sheet backg))) - (setq sheet (concat sheet " }\n")))) - (if link - (setq sheet (format "%sa.link { color: %s }\n" sheet - (w3-normalize-color link)))) - (if vlink - (setq sheet (format "%sa.visited { color: %s }\n" sheet - (w3-normalize-color vlink)))) - (if alink - (setq sheet (format "%sa.active { color: %s }\n" sheet - (w3-normalize-color alink)))) - (if (/= (length sheet) 0) - (w3-handle-style (list (cons 'data sheet) - (cons 'notation "css"))))))) - -(defun w3-handle-cryptopts (&optional args) - (put 'text 'w3-formatter 'ack)) - -(defun w3-handle-/cryptopts (&optional args) - (put 'text 'w3-formatter nil)) - -(defun w3-handle-certs (&optional args) - (put 'text 'w3-formatter 'ack)) - -(defun w3-handle-/certs (&optional args) - (put 'text 'w3-formatter nil)) - -(defun w3-handle-base (&optional args) - (setq w3-base-alist (cons - (cons (or (cdr-safe (assq 'name args)) - (cdr-safe (assq 'id args))) - (or (cdr-safe (assq 'href args)) - (cdr-safe (assq 'src args)) - (url-view-url t))) - w3-base-alist))) - -(defun w3-handle-isindex (&optional args) - (let ((prompt (or (cdr-safe (assq 'prompt args)) - "Search on (+ separates keywords): ")) - action) - (setq action (url-expand-file-name - (or (cdr-safe (assq 'src args)) - (cdr-safe (assq 'href args)) - (url-view-url t)) - (cdr-safe (assoc (cdr-safe (assq 'base args)) - w3-base-alist)))) - (if (and prompt (string-match "[^: \t-]+$" prompt)) - (setq prompt (concat prompt ": "))) - (if w3-use-forms-index - (progn - (w3-handle-hr) - (w3-handle-form (list (cons 'action action) - (cons 'enctype "application/x-w3-isindex") - (cons 'method "get"))) - (w3-handle-text (concat prompt " ")) - (w3-handle-input (list (cons 'type "text") - (cons 'name "isindex"))))) - (setq w3-current-isindex (cons action prompt)))) - -(defun w3-handle-meta (&optional args) - (let* ((equiv (cdr-safe (assq 'http-equiv args))) - (value (cdr-safe (assq 'content args))) - (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))) - ;; 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)))) - -(defun w3-handle-link (&optional args) - (let* ((dest (cdr-safe (assq 'href args))) - (type (if (assq 'rel args) "Parent of" "Child of")) - (desc (or (cdr-safe (assq 'rel args)) - (cdr-safe (assq 'rev args)))) - (node-1 (assoc type w3-current-links)) - (node-2 (and node-1 desc (assoc desc (cdr node-1)))) - (base (cdr-safe (assq 'base args)))) - (if dest - (progn - (setq dest (url-expand-file-name - dest - (cdr-safe (assoc base w3-base-alist)))) - (cond - (node-2 ; Add to old value - (setcdr node-2 (cons dest (cdr node-2)))) - (node-1 ; first rel/rev - (setcdr node-1 (cons (cons desc (list dest)) (cdr node-1)))) - (t (setq w3-current-links - (cons (cons type (list (cons desc (list dest)))) - w3-current-links)))) - (if (and dest desc (member (downcase desc) - '("style" "stylesheet"))) - (w3-handle-style (list (cons 'src dest)))))))) - -(defun w3-maybe-start-image-download (widget) - (let* ((src (widget-get widget 'src)) - (cached-glyph (w3-image-cached-p src))) - (if (and cached-glyph (w3-glyphp cached-glyph)) - (setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting)) - (cond - ((or w3-delay-image-loads (not (fboundp 'valid-specifier-domain-p))) - (w3-add-delayed-graphic widget)) - ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it! - (w3-warn 'images (format "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 widget) - url-be-asynchronous t - url-current-callback-func 'w3-finalize-image-download) - (url-retrieve src)) - (setq-default url-be-asynchronous old-asynch))))))) - -(defun w3-finalize-image-download (widget) - (let ((glyph nil) - (url (widget-get widget 'src)) - (node nil) - (buffer (widget-get widget 'buffer))) - (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) - (w3-warn 'image (format "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)) - (if node - (set-glyph-image (cdr node) (glyph-image glyph)) - (setq w3-graphics-list (cons (cons url glyph) w3-graphics-list))) - - (if (and (buffer-name buffer) ; Dest. buffer exists - (w3-glyphp glyph)) ; got a valid glyph - (save-excursion - (set-buffer buffer) - (if (eq major-mode 'w3-mode) - (widget-value-set widget glyph) - (setq w3-image-widgets-waiting - (cons widget w3-image-widgets-waiting))))))) - -(defun w3-handle-image (&optional args) - (let* ((parms args) - (height (cdr-safe (assq 'height parms))) - (width (cdr-safe (assq 'width parms))) - (src (or (cdr-safe (assq 'src parms)) - "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 (cdr-safe (assq 'alt parms)) - our-alt)) - (ismap (and (assq 'ismap args) 'ismap)) - (usemap (cdr-safe (assq 'usemap args))) - (dest (w3-get-state :href)) - (base (cdr-safe (assq 'base args))) - (widget nil) - (zone (w3-get-state :zone)) - (align (intern (or (cdr-safe (assq 'align parms)) "middle")))) - (setq src (url-expand-file-name src - (cdr-safe (assoc base w3-base-alist)))) - (if dest - (w3-handle-hyperlink-end)) - (setq widget - (widget-create 'image - '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 dest ; Hyperlink destination - )) - (widget-put widget 'buffer (current-buffer)) - (w3-maybe-start-image-download widget) - (goto-char (point-max)) - (if dest - (w3-handle-hyperlink (list (cons 'href dest)))))) - -(defun w3-handle-title (&optional args) - (if (w3-get-state :title) - (w3-put-state :title nil)) - (put 'text 'w3-formatter 'w3-handle-title-text)) - -(defun w3-handle-title-text (&optional args) - (w3-put-state :title - (concat (w3-get-state :title) args))) - -(defun w3-handle-/title (&optional args) - (put 'text 'w3-formatter nil) - (let ((ttl (w3-get-state :title))) - (if (not (stringp ttl)) - nil - (setq ttl (w3-fix-spaces ttl)) - (if (and ttl (string= ttl "")) - (setq ttl (w3-fix-spaces (url-view-url t)))) - (rename-buffer (url-generate-new-buffer-name ttl)) - ;; Make the URL show in list-buffers output - (make-local-variable 'list-buffers-directory) - (setq list-buffers-directory (url-view-url t)) - (w3-put-state :title t)))) - -(fset 'w3-handle-/head 'w3-handle-/title) - -(defun w3-handle-hyperlink (&optional args) - (let* ((href-node (assq 'href args)) - (href (cdr href-node)) - (title (cdr-safe (assq 'title args))) - (base (cdr-safe (assq 'base args))) - (name (or (cdr-safe (assq 'id args)) - (cdr-safe (assq 'name args))))) - (if href - (progn - (setq href (url-expand-file-name href (cdr-safe - (assoc base w3-base-alist)))) - (setcdr href-node href))) - (w3-put-state :seen-this-url (url-have-visited-url href)) - (w3-put-state :zone (point)) - (w3-put-state :link-args args) - (if title (w3-put-state :link-title title)) - (if href (w3-put-state :href href)) - (if name (w3-put-state :name name)))) - -(defun w3-follow-hyperlink (widget &rest ignore) - (let* ((target (widget-get widget 'target)) - (href (widget-get widget 'href)) - (tag 'a) - (args '((class . "visited"))) - (face (cdr (w3-face-for-element))) - (old-face (and (widget-get widget :from) - (get-text-property (widget-get widget :from) 'face))) - (faces (cond - ((and old-face (consp old-face)) (cons face old-face)) - (old-face (cons face (list old-face))) - (t (list face))))) - (if target (setq target (intern (downcase target)))) - (put-text-property (widget-get widget :from) (widget-get widget :to) - 'face faces) - (case target - ((_blank external) - (w3-fetch-other-frame href)) - (_top - (delete-other-windows) - (w3-fetch href)) - (otherwise - (w3-fetch href))))) - -(defun w3-balloon-help-callback (object &optional event) - (let* ((widget (widget-at (extent-start-position object))) - (href (and widget (widget-get widget 'href)))) - (if href - (url-truncate-url-for-viewing href) - nil))) - -(defun w3-handle-hyperlink-end (&optional args) - (let* ((href (w3-get-state :href)) - (old-args (w3-get-state :link-args)) - (name (w3-get-state :name)) - (zone (w3-get-state :zone)) - (btdt (and href (w3-get-state :seen-this-url))) - (tag 'a) - (args (list (cons 'class (if btdt "visited" "link")))) - (face (cdr (w3-face-for-element))) - (old-face (and zone (get-text-property zone 'face))) - (faces (cond - ((and old-face (consp old-face)) (cons face old-face)) - (old-face (cons face (list old-face))) - (t (list face))))) - (if (not href) - nil - (add-text-properties zone (point) - (list 'mouse-face 'highlight - 'button - (append - (list 'push :args nil :value "" :tag "" - :notify 'w3-follow-hyperlink - :from (set-marker (make-marker) zone) - :to (set-marker (make-marker) (point)) - ) - (alist-to-plist old-args)) - 'face faces - 'balloon-help 'w3-balloon-help-callback - 'title (cons - (set-marker (make-marker) zone) - (set-marker (make-marker) (point))) - 'help-echo href)) - (w3-put-state :zone nil) - (w3-put-state :href nil) - (w3-put-state :name nil) - (if (and w3-link-info-display-function - (fboundp w3-link-info-display-function)) - (let ((info (condition-case () - (funcall w3-link-info-display-function href) - (error nil)))) - (if (and info (stringp info)) - (w3-handle-text info))))))) - -(defvar w3-tab-alist nil - "An assoc list of tab stops and their respective IDs") -(make-variable-buffer-local 'w3-tab-alist) - -(defun w3-handle-tab (&optional args) - (let* ((id (cdr-safe (assq 'id args))) - (to (cdr-safe (assq 'to args))) - (pos (cdr-safe (assoc to w3-tab-alist)))) - (cond - (id ; Define a new tab stop - (setq w3-tab-alist (cons (cons id (current-column)) w3-tab-alist))) - ((and to pos) ; Go to a currently defined tabstop - (while (<= (current-column) pos) - (insert " "))) - (to ; Tabstop 'to' is no defined yet - (w3-warn 'html (format "Unkown tab stop -- `%s'" to))) - (t ; Just do a tab - (insert (make-string w3-indent-level ? )))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Some bogus shit for pythia -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-margin (&optional args) - (if (assq 'reset args) - (w3-handle-/blockquote nil) - (w3-handle-blockquote nil))) - -(fset 'w3-handle-l 'w3-handle-br) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Guts of the forms interface for the new display engine -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-handle-form (&optional args) - (let ((actn (cdr-safe (assq 'action args))) - (enct (cdr-safe (assq 'enctype args))) - (meth (cdr-safe (assq 'method args)))) - (if (not meth) (setq args (cons (cons 'method "GET") args))) - (if (not actn) - (setq args (cons (cons 'action - (or - (cdr-safe (assoc (cdr-safe (assq 'base args)) - w3-base-alist)) - (url-view-url t))) args)) - (setcdr (assq 'action args) - (url-expand-file-name - actn - (cdr-safe (assoc (cdr-safe (assq 'base args)) - w3-base-alist))))) - (if (not enct) - (setq args - (cons (cons 'enctype "application/x-www-form-urlencoded") - args))) - (w3-put-state :form args))) - -(defun w3-handle-/form (&optional args) - (w3-handle-paragraph) - (w3-put-state :form nil) - (w3-put-state :formnum (1+ (w3-get-state :formnum))) - ) - -(defun w3-handle-keygen (&optional args) - (w3-form-add-element 'keygen - (or (cdr-safe (assq 'name args)) "") - nil - nil - 1000 - nil - (w3-get-state :form) - nil - (w3-get-state :formnum) - nil - (w3-face-for-element))) - -(defun w3-handle-input (&optional args) - (if (or (not (w3-get-state :form)) - (w3-get-state :select)) - (w3-warn - 'html - "<input> outside of a <form> or inside <select> construct - ERROR!!") - (let* ((type (intern (downcase (or (cdr-safe (assq 'type args)) "text")))) - (name (cdr-safe (assq 'name args))) - (value (or (cdr-safe (assq 'value args)) "")) - (size (string-to-int (or (cdr-safe (assq 'size args)) "20"))) - (maxlength (cdr (assoc 'maxlength args))) - (default value) - (action (w3-get-state :form)) - (options) - (num (w3-get-state :formnum)) - (id (cdr-safe (assq 'id args))) - (checked (assq 'checked args)) - (face (w3-face-for-element))) - (if (and (string-match "^[ \t\n\r]+$" value) - (not (eq type 'hidden))) - (setq value "")) - (if maxlength (setq maxlength (string-to-int maxlength))) - (if (and name (string-match "[\r\n]" name)) - (setq name (mapconcat (function - (lambda (x) - (if (memq x '(?\r ?\n)) - "" - (char-to-string x)))) - name ""))) - (if (memq type '(checkbox radio)) (setq default checked)) - (if (and (eq type 'checkbox) (string= value "")) - (setq value "on")) - (w3-form-add-element type name value size maxlength default action - options num id checked face)))) - -(defun w3-handle-/select (&optional args) - (if (not (and (w3-get-state :form) - (w3-get-state :select))) - (w3-warn 'html - "</select> outside of a <form> or <select> construct - ERROR!!") - (put 'text 'w3-formatter 'w3-handle-text) - (let* ((args (w3-get-state :select)) - (tag 'input) - (face (w3-face-for-element)) - (opts (w3-get-state :options)) - (form (w3-get-state :form)) - (max-size nil) - (type "OPTION") - (default nil) - (tmp nil) - (id (cdr-safe (assq 'id args))) - (checked nil) - ) - (setq tmp (reverse opts)) - (if (assq 'multiple args) - (let ((tag 'ul) ; Convert to a list of checkboxes - (nam (or (cdr-safe (assq 'name args)) "option")) - (old (w3-get-state :align)) - (first nil)) - (w3-put-state :options nil) - (w3-put-state :select nil) - (w3-handle-list-opening) - (w3-put-state :align nil) - (while tmp - (w3-handle-list-item) - (w3-handle-input (list (cons 'type "checkbox") - (cons 'name nam) - (cons 'value - (or (cdr-safe - (assq 'value (car tmp))) - (cdr-safe - (assoc 'ack (car tmp))) - "unknown")) - (if (or (assq 'checked (car tmp)) - (assq 'selected (car tmp))) - (cons 'checked "checked")))) - (w3-handle-text (concat " " (or - (cdr-safe (assq 'ack (car tmp))) - "unknown"))) - (setq tmp (cdr tmp))) - (w3-handle-list-ending) - (w3-put-state :align old)) - (while (and (not default) tmp) - (if (or (assq 'checked (car tmp)) - (assq 'selected (car tmp))) - (setq default (car tmp))) - (setq tmp (cdr tmp))) - (setq default (cdr (assq 'ack (or default - (nth (1- (length opts)) opts)))) - checked (mapcar - (function - (lambda (x) - (cons (cdr-safe (assq 'ack x)) - (or (cdr-safe (assq 'value x)) - (cdr-safe (assq 'ack x)))))) - opts) - max-size (car (sort (mapcar - (function - (lambda (x) - (length (cdr-safe (assq 'ack x))))) - opts) - '>))) - (if (and form args opts) - (let ((pos (point)) - (siz (max max-size - (string-to-int - (or (cdr-safe (assq 'size args)) "0"))))) - (w3-form-add-element 'option - (or (cdr-safe (assq 'name args)) "option") - default - siz - (string-to-int - (or (cdr-safe (assq 'maxlength args)) - "1000")) - default - (w3-get-state :form) - checked - (w3-get-state :formnum) - nil checked face))))) - (w3-put-state :options nil) - (w3-put-state :select nil))) - -(defun w3-handle-option-data (&optional args) - (let ((text (cond - ((null args) nil) - ((stringp args) args) - ((listp args) (mapconcat 'identity args " "))))) - (if text - (progn - (setq text (url-strip-leading-spaces - (url-eat-trailing-space text))) - (w3-put-state :options (cons (cons (cons 'ack text) - (w3-get-state :optargs)) - (w3-get-state :options)))))) - (put 'text 'w3-formatter 'w3-handle-text)) - -(defun w3-handle-option (&optional args) - (if (not (and (w3-get-state :form) - (w3-get-state :select))) - (w3-warn 'html - "<option> outside of a <form> or <select> construct - ERROR!!") - (w3-put-state :optargs args) - (put 'text 'w3-formatter 'w3-handle-option-data))) - -(defun w3-handle-select (&optional args) - (if (not (w3-get-state :form)) - (w3-warn 'html "<select> outside of a <FORM> construct - ERROR!!") - (w3-put-state :select args)) - ) - -(defun w3-handle-textarea (&optional args) - (if (not (w3-get-state :form)) - (w3-warn 'html "<textarea> outside of a <FORM> construct - ERROR!!") - (let ((node (assq 'maxlength args))) - (cond - ((null node) - (setq args (cons (cons 'maxlength nil) args))) - ((null (cdr-safe node)) - nil) - ((string= (downcase (cdr-safe node)) "unlimited") - (setcdr node nil)))) - (let* ( - (face (let ((tag 'input) - (args nil)) - (w3-face-for-element))) - (value (cdr-safe (assq 'data args))) - (type "TEXTAREA") - (name (cdr-safe (assq 'name args))) - (size (string-to-int (or (cdr-safe (assq 'size args)) "20"))) - (maxlength (string-to-int - (or (cdr (assq 'maxlength args)) "10000"))) - (default nil) - (action (w3-get-state :form)) - (options) - (pos) - (num (w3-get-state :formnum)) - (id (cdr-safe (assq 'id args))) - (checked (assq 'checked args))) - (setq default value - pos (point)) - (put 'text 'w3-formatter 'w3-handle-text) - (w3-form-add-element 'multiline name value size maxlength default - action options num id checked face)))) - -(defun w3-handle-label-text (&optional args) - (setcdr (w3-get-state :label-text) - (concat (cdr (w3-get-state :label-text)) args)) - (w3-handle-text args)) - -(defun w3-handle-/label (&optional args) - (let ((num (w3-get-state :formnum)) - (dat (w3-get-state :label-text))) - (setq w3-form-labels (cons (cons (format "%d:%s" num (car dat)) - (cdr dat)) - w3-form-labels)) - (put 'text 'w3-formatter 'w3-handle-text))) - -(defun w3-handle-label (&optional args) - (if (not (w3-get-state :form)) - (w3-warn 'html "<label> outside of a <FORM> construct - ERROR!!") - (put 'text 'w3-formatter 'w3-handle-label-text) - (w3-put-state :label-text (cons (or (cdr-safe (assq 'for args)) - "Unknown label") "")))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; For displaying the buffer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-show-buffer () - (let ((potential-title - (and (not (w3-get-state :title)) - (url-generate-new-buffer-name - (url-basepath url-current-file t))))) - (if (and potential-title (string= potential-title "")) - (setq potential-title - (url-generate-new-buffer-name url-current-file))) - (if (and potential-title (not (string= potential-title ""))) - (rename-buffer potential-title))) - (setq inhibit-read-only nil) - (if url-find-this-link - (w3-find-specific-link url-find-this-link)) - (let* ((tag 'html) - (args nil) - (face (cdr (w3-face-for-element)))) - (if (not face) - (setq tag 'body - face (cdr (w3-face-for-element)))) - (and face - (if (not (fboundp 'valid-specifier-locale-p)) - nil - (w3-my-safe-copy-face face 'default (current-buffer)))))) - -(defun w3-parse-header-link-items () - ;; Parse `url-current-mime-headers' and look for any <link> items - (let ((items url-current-mime-headers) - (node nil) - (url nil) - (type nil) - (args nil) - (title nil) - (label nil)) - (while items - (setq node (car items) - items (cdr items)) - (if (string= (car node) "link") - (progn - (setq args (mm-parse-args (cdr node)) - type (if (assoc "rel" args) "rel" "rev") - label (cdr-safe (assoc type args)) - title (cdr-safe (assoc "title" args)) - url (car-safe (rassoc nil args))) - (if (string-match "^<.*>$" url) - (setq url (substring url 1 -1))) - (and url label type - (w3-handle-link (list (cons "href" url) - (cons type label) - (cons "title" title))))))))) - -(defun w3-refresh-buffer (&rest args) - "Redraw the current buffer - this does not refetch or reparse the current -document, but uses the stored parse data." - (interactive) - (let ((buffer-read-only nil)) - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (error "Not yet reimplemented... sorry."))) - -(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 ((active-minibuffer-window - (if (minibuffer-window-active-p (minibuffer-window)) - (minibuffer-window)))) - (let ((pop-up-windows nil)) - (if active-minibuffer-window - (let* ((current-buffer (current-buffer)) - (window (get-buffer-window current-buffer t))) - (cond (window - (and (fboundp 'select-frame) - (fboundp 'window-frame) - (select-frame (window-frame window))) - (select-window window)) - ((and (fboundp 'selected-frame) - (fboundp 'window-frame) - (eq (selected-frame) - (window-frame (minibuffer-window)))) - ;; on minibuffer-only-frame - (select-frame (previous-frame)) - (select-window (frame-first-window (selected-frame)))) - ((fboundp 'frame-first-window) - (select-window (frame-first-window)))) - (set-buffer current-buffer)))) - (let* ((source (buffer-string)) - (parse (w3-preparse-buffer (current-buffer))) - (buff (car parse))) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer)) - (set-buffer buff) - (setq w3-current-source source - w3-current-parse w3-last-parse-tree) - (w3-parse-header-link-items) - (save-excursion - (goto-char (point-max)) - (w3-handle-paragraph) - (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting) - (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))) - (widget-value-set widget glyph)))) - (w3-mode) - (w3-handle-annotations) - (w3-handle-headers) - (set-buffer-modified-p nil) - ) - (switch-to-buffer (current-buffer)) - (or active-minibuffer-window - (let ((window nil) - (pop-up-windows nil)) - (display-buffer (current-buffer)) - (if (or w3-running-FSF19 w3-running-xemacs) - (setq window (get-buffer-window (current-buffer) t)) - (setq window (get-buffer-window (current-buffer)))) - (select-window window) - (if (and (fboundp 'select-frame) - (fboundp 'window-frame)) - (select-frame (window-frame window))))) - (goto-char (point-min)) - (w3-show-buffer) - (if url-keep-history - (let ((url (url-view-url t))) - (if (not (url-hashtablep url-history-list)) - (setq url-history-list (url-make-hashtable 131))) - (url-puthash url (buffer-name) url-history-list) - (if (fboundp 'w3-shuffle-history-menu) - (w3-shuffle-history-menu))))) - (cond (active-minibuffer-window - (select-window active-minibuffer-window) - (sit-for 0))))) - -(defun w3-handle-headers () - ;; Insert any headers the user wants to see into the current buffer. - (let ((show w3-show-headers) - (cur nil) - (hdrs nil) - (tag 'ol) - (header nil) - (w3-last-fill-pos (point-max)) - (val nil) - (first t)) - (goto-char (point-max)) - (if (eq show t) (setq show '(".*"))) - (while show - (setq cur (car show) - show (cdr show) - hdrs url-current-mime-headers) - (while hdrs - (setq header (car (car hdrs)) - val (cdr (car hdrs)) - hdrs (cdr hdrs)) - (if (numberp val) (setq val (int-to-string val))) - (if (and (/= 0 (length header)) - (string-match cur header)) - (progn - (if first - (progn - (w3-handle-hr) - (w3-handle-list-opening '(("value" . 1))) - (setq tag 'li - first nil))) - (w3-handle-list-item) - (w3-handle-text (concat (capitalize header) - ": " val)))))) - (if (not first) ; We showed some headers - (setq tag '/ol - tag (w3-handle-list-ending))))) - -(defun w3-handle-annotations () - ;; Insert personal annotations into the current buffer - (let ((annos (w3-fetch-personal-annotations)) - (tag nil)) - (if (not annos) - nil ; No annotations - (goto-char (cond - ((eq w3-annotation-position 'bottom) (point-max)) - ((eq w3-annotation-position 'top) (point-min)) - (t (message "Bad value for w3-annotation-position") - (point-max)))) - (w3-handle-div '((class . "annotations"))) - (w3-handle-hr '((width . "75%") - (label . " Personal Annotations ") - (align . "center"))) - (setq tag 'ol) - (w3-handle-list-opening) - (while annos - (w3-handle-list-item) - (w3-handle-hyperlink (list (cons 'href (car (car annos))))) - (w3-handle-text (cdr (car annos))) - (w3-handle-hyperlink-end) - (setq annos (cdr annos))) - (w3-handle-list-ending) - (w3-handle-hr '((width . "75%") - (align . "center"))) - (w3-handle-/div) - ))) - -(defun w3-fetch-personal-annotations () - ;; Grab any personal annotations for the current url - (let ((url (url-view-url t)) - (anno w3-personal-annotations) - (annolist nil)) - (if (assoc url anno) - (while anno - (if (equal (car (car anno)) url) - (setq annolist - (cons - (cons - (format "file:%s%s/PAN-%s.html" - (if (= ?/ (string-to-char - w3-personal-annotation-directory)) "" - "/") - w3-personal-annotation-directory - (car (car (cdr (car anno))))) - (car (cdr (car (cdr (car anno)))))) - annolist))) - (setq anno (cdr anno)))) - annolist)) - -(defun w3-normalize-spaces (string) - ;; nuke spaces at the beginning - (if (string-match "^[ \t\r\n]+" string) - (setq string (substring string (match-end 0)))) - - ;; 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 end - (if (string-match "[ \t\n\r]+$" string) - (setq string (substring string 0 (match-beginning 0)))) - string) - -(defun w3-upcase-region (st nd &optional end) - (and st nd (upcase-region st nd))) - -(provide 'w3-draw) -
--- a/lisp/w3/w3-e19.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-e19.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,11 +1,12 @@ ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1996/07/11 04:49:02 -;; Version: 1.3 +;; Created: 1996/12/31 15:38:51 +;; Version: 1.12 ;; Keywords: faces, help, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -32,97 +34,57 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Help menu ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-links-menu nil "Menu for w3-mode in emacs 19.") -(make-variable-buffer-local 'w3-links-menu) - -(defun w3-add-hotlist-menu () - ;; Add the hotlist menu to this buffer - used when it changes. - (let ((hot-menu (make-sparse-keymap "w3-hotlist")) - (ctr 0) - (hot w3-hotlist)) - (while hot - (define-key hot-menu (vector (intern (concat "w3-hotlist-" - (int-to-string ctr)))) - (cons (car (car hot)) - (list 'lambda () '(interactive) - (list 'w3-fetch (car (cdr (car hot))))))) - (setq ctr (1+ ctr) - hot (cdr hot))) - (setq w3-e19-hotlist-menu hot-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.") +(mapcar 'make-variable-buffer-local + '(w3-e19-hotlist-menu w3-e19-links-menu w3-e19-nav-menu)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Functions to build menus of urls ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-e19-show-hotlist-menu (e) - (interactive "e") - (if w3-html-bookmarks - (popup-menu w3-html-bookmarks) - (let* ((x (condition-case () - (x-popup-menu e w3-e19-hotlist-menu) - (error nil))) ; to trap for empty menus - (y (and x (lookup-key w3-e19-hotlist-menu (apply 'vector x))))) - (if (and x y) - (funcall y))))) +(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 (e) - (interactive "e") +(defun w3-e19-show-links-menu () + (interactive) (if (not w3-e19-links-menu) (w3-build-FSF19-menu)) - (let* ((x (condition-case () - (x-popup-menu e w3-e19-links-menu) - (error nil))) ; to trap for empty menus - (y (and x (lookup-key w3-e19-links-menu (apply 'vector x))))) + (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* ((ctr 0) - (menu-ctr 0) - (tmp nil) - (widgets (w3-only-links)) - (widget nil) - (href nil) - (menus nil)) - (setq tmp (make-sparse-keymap "Links")) - (while widgets - (setq widget (car widgets) - widgets (cdr widgets) - href (widget-get widget 'href)) - (if (> ctr w3-max-menu-length) - (setq menus (cons tmp menus) - ctr 0 - tmp (make-sparse-keymap - (concat "Links" (int-to-string - (setq menu-ctr - (1+ menu-ctr))))))) - (let ((ttl (w3-fix-spaces - (buffer-substring - (widget-get widget :from) - (widget-get widget :to)))) - (key (vector (intern (concat "link" - (int-to-string - (setq ctr (1+ ctr)))))))) - (if (and (> (length ttl) 0) href) - (define-key tmp key - (cons ttl - (list 'lambda () '(interactive) - (list 'w3-fetch href))))))) - (if (not menus) - (setq w3-e19-links-menu tmp) - (setq w3-e19-links-menu (make-sparse-keymap "LinkMenu") - menus (nreverse (cons tmp menus)) - ctr 0) - (while menus - (define-key w3-e19-links-menu - (vector (intern (concat "SubMenu" ctr))) - (cons "More..." (car menus))) - (setq menus (cdr menus) - ctr (1+ ctr)))))) + (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)) + (require 'lmenu) ; for popup-menu + ) (defun w3-store-in-clipboard (str) "Store string STR in the Xwindows clipboard" @@ -137,7 +99,7 @@ ;; Emacs 19 specific stuff for w3-mode (make-local-variable 'track-mouse) (if w3-track-mouse (setq track-mouse t)) - (if (or (memq (device-type) '(x pm ns))) + '(if (or (memq (device-type) '(x pm ns))) (w3-build-FSF19-menu))) (defun w3-mouse-handler (e) @@ -146,12 +108,13 @@ (let* ((pt (posn-point (event-start e))) (good (eq (posn-window (event-start e)) (selected-window))) (widget (and good pt (number-or-marker-p pt) (widget-at pt))) - (link (and widget (widget-get widget 'href))) + (link (and widget (or (widget-get widget 'href) + (widget-get widget 'name)))) (form (and widget (widget-get widget 'w3-form-data))) (imag nil) ; (nth 1 (memq 'w3graphic props)))) ) (cond - (link (message "%s" link)) + (link (w3-widget-echo widget)) (form (cond ((eq 'submit (w3-form-element-type form))
--- a/lisp/w3/w3-emulate.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-emulate.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-emulate.el --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1996/06/30 18:05:22 -;; Version: 1.2 +;; Created: 1996/10/09 19:00:59 +;; Version: 1.4 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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/lisp/w3/w3-forms.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-forms.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine ;; Author: wmperry -;; Created: 1996/08/10 16:14:08 -;; Version: 1.14 +;; Created: 1997/01/02 20:20:29 +;; Version: 1.32 ;; Keywords: faces, help, comm, data, languages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,25 +21,20 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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-and-compile - (require 'w3-draw)) - -(require 'widget) - -(if (featurep 'mule) (fset 'string-width 'length)) + (require 'w3-display) + (require 'widget)) -;; These are things in later versions of the widget package that I don't -;; have yet. -(defun widget-at (pt) - (or (get-text-property pt 'button) - (get-text-property pt 'field))) +(require 'w3-vars) +(require 'mule-sysdp) ;; A form entry area is a vector ;; [ type name default-value value maxlength options widget] @@ -69,40 +65,72 @@ (defsubst w3-form-element-set-widget (obj val) (aset obj 8 val)) ;; The main function - this adds a single widget to the form -(defun w3-form-add-element (&rest args) +(defun w3-form-add-element (type name value size maxlength default + action options number id checked + face) + (let* ((name (or name (case type + ((submit reset) nil) + (otherwise (symbol-name type))))) + (el (vector type + name + default + value + size + maxlength + options + action nil)) + (size (if size + (+ 2 size) + (case type + ((checkbox radio) 3) + ((reset submit) + (+ 2 (length (or value (symbol-name type))))) + (multiline 21) + (hidden nil) + (otherwise 22)))) + ) + (if size + (set-text-properties (point) + (progn (insert-char ?T size) (point)) + (list 'w3-form-info el + 'start-open t + 'end-open t + 'rear-nonsticky t))))) + +(defun w3-form-resurrect-widgets () + (let ((st (point-min)) + info nd node action) + (while st + (if (setq info (get-text-property st 'w3-form-info)) + (progn + (setq nd (next-single-property-change st 'w3-form-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)) + (if node + (setcdr node (cons info (cdr node))) + (setq w3-form-elements (cons (cons action (list info)) + w3-form-elements))) + (w3-form-add-element-internal info) + (setq st (next-single-property-change st 'w3-form-info))) + (setq st (next-single-property-change st 'w3-form-info)))))) + +(defun w3-form-add-element-internal (el) (let* ((widget nil) (buffer-read-only nil) (inhibit-read-only t) - (widget-creation-function nil) - (action (cons (cons 'form-number (w3-get-state :formnum)) - (nth 6 args))) - (node (assoc action w3-form-elements)) - (name (or (nth 1 args) - (if (memq (nth 0 args) '(submit reset)) - nil - (symbol-name (nth 0 args))))) - (val (vector (nth 0 args) ; type - name ; name - (nth 5 args) ; default - (nth 2 args) ; value - (nth 3 args) ; size - (nth 4 args) ; maxlength - (nth 7 args) ; options - action - nil)) ; widget - ) - (setq widget-creation-function (or (get (car args) + (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 (funcall widget-creation-function val - (cdr (nth 10 args)))) - (if node - (setcdr node (cons val (cdr node))) - (setq w3-form-elements (cons (cons action (list val)) w3-form-elements))) + widget (funcall widget-creation-function el nil)) (if (not widget) nil - (w3-form-element-set-widget val widget) - (widget-put widget 'w3-form-data val)))) + (w3-form-element-set-widget el widget) + (widget-put widget 'w3-form-data el)))) ;; These properties tell the add-element function how to actually create ;; each type of widget. @@ -138,7 +166,7 @@ (if (w3-form-element-default-value el) (widget-value-set widget (w3-form-element-value el))) nil) - (setq widget (widget-create 'radio + (setq widget (widget-create 'radio-button-choice :value (w3-form-element-value el) (list 'item :format "%t" @@ -154,10 +182,10 @@ (let ((val (w3-form-element-value el))) (if (or (not val) (string= val "")) (setq val "Push Me")) - (widget-create 'push :notify 'ignore :button-face face val))) + (widget-create 'push-button :notify 'ignore :button-face face val))) (defun w3-form-create-image (el face) - (let ((widget (widget-create 'push + (let ((widget (widget-create 'push-button :notify 'w3-form-submit/reset-callback :value "Form-Image"))) widget)) @@ -168,7 +196,8 @@ (setq val (if (eq (w3-form-element-type el) 'submit) "Submit" "Reset"))) - (widget-create 'push :notify 'w3-form-submit/reset-callback + (widget-create 'push-button + :notify 'w3-form-submit/reset-callback :button-face face val))) (defun w3-form-create-file-browser (el face) @@ -195,14 +224,18 @@ (setq options (cons (list 'choice-item :tag (caar tmp) :value (cdar tmp)) options) tmp (cdr tmp))) - (apply 'widget-create 'choice :value 1024 + (apply 'widget-create 'menu-choice + :value 1024 + :ignore-case t :tag "Key Length" :size (1+ longest) :value-face face options))) (defun w3-form-create-option-list (el face) - (let ((widget (apply 'widget-create 'choice :value (w3-form-element-value el) + (let ((widget (apply 'widget-create 'menu-choice + :value (w3-form-element-value el) + :ignore-case t :tag "Choose" :format "%v" :size (w3-form-element-size el) @@ -212,7 +245,7 @@ (lambda (x) (list 'choice-item :format "%[%t%]" :tag (car x) :value (car x)))) - (reverse (w3-form-element-options el)))))) + (w3-form-element-options el))))) (widget-value-set widget (w3-form-element-value el)) widget)) @@ -221,14 +254,14 @@ ; (widget-create 'field :value-face face (w3-form-element-value el))) (defun w3-form-create-multiline (el face) - (widget-create 'push :notify 'w3-do-text-entry "Multiline text area")) + (widget-create 'push-button :notify 'w3-do-text-entry "Multiline text area")) (defun w3-form-default-widget-creator (el face) (widget-create 'link :notify 'w3-form-default-button-callback :size (w3-form-element-size el) - :tag (w3-truncate-string (w3-form-element-value el) - (w3-form-element-size el) ?_) + :tag (mule-truncate-string (w3-form-element-value el) + (w3-form-element-size el) ?_) :value-face face (w3-form-element-value el))) @@ -241,34 +274,17 @@ (case typ (password (setq val (funcall url-passwd-entry-func "Password: " def)) - (widget-put widget :tag (w3-truncate-string + (widget-put widget :tag (mule-truncate-string (make-string (length val) ?*) (w3-form-element-size obj) ?_))) (otherwise (setq val (read-string (concat (capitalize (symbol-name typ)) ": ") def)) - (widget-put widget :tag (w3-truncate-string + (widget-put widget :tag (mule-truncate-string val (w3-form-element-size obj) ?_)))) (widget-value-set widget val)) (apply 'w3-form-possibly-submit widget ignore)) -(defun w3-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." - (if (featurep 'mule) - (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)) - (concat (if (> (length str) len) (substring str 0 len) str) - (if (or (null pad) (> (length str) len)) - "" - (make-string (- len (length str)) pad))))) - (defun w3-form-possibly-submit (widget &rest ignore) (let* ((formobj (widget-get widget 'w3-form-data)) (ident (w3-form-element-action formobj)) @@ -474,8 +490,8 @@ ((get-text-property pos 'field) (next-single-property-change pos 'field)) (t pos))) - (button (next-single-property-change next 'button)) - (field (next-single-property-change next 'field))) + (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)) @@ -518,35 +534,18 @@ (defun w3-form-encode-application/x-gopher-query (result) (concat "\t" (cdr (car (w3-form-encode-helper result))))) -(defconst w3-xwfu-acceptable-chars - (list - ?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 - ?_ ;; BOGUS! This is for #!%#@!ing netscape compatibility - ?. ;; BOGUS! This is for #!%#@!ing netscape compatibility - ) - "A list of characters that we do not have to escape in the media type -application/x-www-form-urlencoded") - (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." - (if (and (featurep 'mule) chunk) - (setq chunk (if w3-running-xemacs - (decode-coding-string - chunk url-mule-retrieval-coding-system) - (code-convert-string - chunk *internal* url-mule-retrieval-coding-system)))) (mapconcat (function (lambda (char) (cond ((= char ? ) "+") - ((memq char w3-xwfu-acceptable-chars) (char-to-string char)) + ((memq char url-unreserved-chars) (char-to-string char)) (t (upcase (format "%%%02x" char)))))) - chunk "")) + (mule-encode-string chunk) "")) (defun w3-form-encode-application/x-www-form-urlencoded (result) (mapconcat @@ -579,7 +578,8 @@ (defun w3-submit-form (ident) ;; Submit form entry fields matching ACTN as their action identifier. (let* ((result (w3-all-widgets ident)) - (enctype (cdr (assq 'enctype 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))))
--- a/lisp/w3/w3-hot.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-hot.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1996/07/26 05:22:59 -;; Version: 1.5 +;; Created: 1996/12/31 15:39:34 +;; Version: 1.10 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -71,7 +73,7 @@ (insert-file-contents fname) (let* ((w3-debug-html nil) (bkmarks nil) - (parse (w3-parse-buffer (current-buffer) t))) + (parse (w3-parse-buffer (current-buffer)))) (setq parse w3-last-parse-tree bkmarks (nreverse (w3-grok-html-bookmarks parse)) w3-html-bookmarks bkmarks))) @@ -166,8 +168,7 @@ (defun w3-hotlist-refresh () "Reload the default hotlist file into memory" (interactive) - (w3-parse-hotlist) - (if (fboundp 'w3-add-hotlist-menu) (w3-add-hotlist-menu))) + (w3-parse-hotlist)) (defun w3-delete-from-alist (x alist) ;; Remove X from ALIST, return new alist @@ -203,8 +204,7 @@ (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)))))) - (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))) + (message "%s was not found in %s" title w3-hotlist-file))))))) (defun w3-hotlist-rename-entry (title) "Rename a hotlist item" @@ -246,16 +246,14 @@ (progn (delete-menu-item '("Go")) (w3-build-FSF19-menu)))) - (message "%s was not found in %s" title w3-hotlist-file)))) - (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))) + (message "%s was not found in %s" title w3-hotlist-file))))) (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)) - (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))) + (setq w3-hotlist (nconc x w3-hotlist)))) (defun w3-hotlist-parse-old-mosaic-format () (let (cur-link cur-alias) @@ -272,9 +270,7 @@ (end-of-line) (point)))) (if (not (equal cur-alias "")) - (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist))) - (if (fboundp 'w3-add-hotlist-menu) - (funcall 'w3-add-hotlist-menu))))) + (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist)))))) (defun w3-parse-hotlist (&optional fname) "Read in the hotlist specified by FNAME" @@ -328,8 +324,7 @@ (marker-buffer (cdr title))) (setq title (buffer-substring-no-properties (car title) (cdr title))) (setq title "None")) - (w3-hotlist-add-document pref-arg title url) - (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu)))) + (w3-hotlist-add-document pref-arg title url))) (defun w3-hotlist-add-document (pref-arg &optional the-title the-url) "Add this documents url to the hotlist" @@ -358,10 +353,8 @@ (insert-file-contents w3-hotlist-file) (goto-char (point-max)) (backward-char 1))) - (insert "\n" (url-hexify-string url) " " (current-time-string) - "\n" title) + (insert "\n" url " " (current-time-string) "\n" title) (write-file w3-hotlist-file) - (kill-buffer (current-buffer)))) - (and (fboundp 'w3-add-hotlist-menu) (funcall 'w3-add-hotlist-menu))) + (kill-buffer (current-buffer))))) (provide 'w3-hot)
--- a/lisp/w3/w3-imap.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-imap.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,11 +1,12 @@ ;;; w3-imap.el --- Imagemap functions ;; Author: wmperry -;; Created: 1996/06/30 18:07:16 -;; Version: 1.2 +;; Created: 1996/12/29 01:49:45 +;; Version: 1.6 ;; Keywords: hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -20,13 +21,14 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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 'widget) -(require 'widget-edit) +(eval-and-compile + (require 'widget)) (eval-when-compile (defmacro x-coord (pt) (list 'aref pt 0))
--- a/lisp/w3/w3-keyword.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-keyword.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-keyword.el --- Emacs-W3 binding style sheet mechanism ;; Author: wmperry -;; Created: 1996/07/23 00:40:54 -;; Version: 1.4 +;; Created: 1996/10/09 19:00:59 +;; Version: 1.8 ;; Keywords: hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -93,6 +95,19 @@ :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))
--- a/lisp/w3/w3-latex.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-latex.el Mon Aug 13 09:06:37 2007 +0200 @@ -5,7 +5,7 @@ ;; Keywords: hypermedia, printing, typesetting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by Stephen Peters <speters%samsun@us.oracle.com> +;;; Copyright (c) 1996 by Stephen Peters <speters@cygnus.com> ;;; ;;; This file is not part of GNU Emacs, but the same permissions apply. ;;; @@ -20,8 +20,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;
--- a/lisp/w3/w3-menu.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,11 +1,12 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1996/07/21 18:29:01 -;; Version: 1.7 +;; Created: 1996/12/31 15:37:49 +;; Version: 1.19 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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) @@ -37,6 +39,7 @@ (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) @@ -60,8 +63,9 @@ options -- Various options buffers -- The standard buffers menu emacs -- A toggle button to switch back to normal emacs menus -style -- Control fonts and who gets to set them -help -- The help +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 @@ -78,7 +82,41 @@ (list 'w3-fetch (car (cdr (car hot)))) t) hot-menu) hot (cdr hot))) - (or hot-menu '(["No Hotlist" undefined nil]))))) + (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 @@ -90,13 +128,14 @@ href (widget-get widget 'href) menu (cons (vector (w3-truncate-menu-item - (w3-fix-spaces - (buffer-substring - (widget-get widget :from) - (widget-get widget :to)))) + (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" undefined nil]))))) + (or menu '(["No Links" nil nil]))))) (defun w3-toggle-minibuffer () (interactive) @@ -217,6 +256,7 @@ ["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.") @@ -230,7 +270,10 @@ "----" (if w3-running-xemacs '("Links" :filter w3-menu-links-constructor) - ["Link..." w3-e19-show-links-menu t]) + ["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.") @@ -294,10 +337,10 @@ ["Allow Document Stylesheets" (setq w3-honor-stylesheets (not w3-honor-stylesheets)) :style toggle :selected w3-honor-stylesheets] - ["IE 3.0 Compatible Parsing" (setq w3-style-ie-compatibility - (not w3-style-ie-compatibility)) + ["IE 3.0 Compatible Parsing" (setq css-ie-compatibility + (not css-ie-compatibility)) :style toggle :selected (and w3-honor-stylesheets - w3-style-ie-compatibility)] + css-ie-compatibility)] ["Honor Color Requests" (setq w3-user-colors-take-precedence (not w3-user-colors-take-precedence)) :style toggle :selected (not w3-user-colors-take-precedence)] @@ -315,6 +358,16 @@ 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)) @@ -363,6 +416,8 @@ 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. @@ -398,6 +453,8 @@ (cons "View" w3-menu-fsfemacs-view-menu)) (style (cons "Style" w3-menu-fsfemacs-style-menu)) + (search + (cons "Search" w3-menu-fsfemacs-search-menu)) (emacs (cons "[Emacs]" 'w3-menu-toggle-menubar)))) cons @@ -434,6 +491,7 @@ (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) ) ) @@ -580,7 +638,7 @@ w3-preferences-ok-hook w3-preferences-setup-hook w3-source-file-hook - w3-style-ie-compatibility + css-ie-compatibility w3-toolbar-orientation w3-toolbar-type w3-use-menus @@ -608,8 +666,11 @@ (let* ((glyph (event-glyph e)) (widget (or (and glyph (glyph-property glyph 'widget)) (widget-at (point)))) - (href (and widget (widget-get widget 'href))) - (imag (and widget (widget-get widget 'src))) + (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
--- a/lisp/w3/w3-mouse.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-mouse.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,11 +1,12 @@ ;;; w3-xemac.el --- XEmacs specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1996/06/30 18:09:28 -;; Version: 1.2 +;; Created: 1996/10/09 19:00:59 +;; Version: 1.4 ;; Keywords: mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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)
--- a/lisp/w3/w3-mule.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,74 +0,0 @@ -;;; w3-mule.el --- MULE 18/19 specific functions for emacs-w3 -;; Author: wmperry -;; Created: 1996/06/30 18:09:59 -;; Version: 1.2 -;; Keywords: faces, help, i18n, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; -;;; This file is part of GNU Emacs. -;;; -;;; GNU Emacs is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Printing a mule buffer as postscript. Requires m2ps -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-m2ps-buffer (&optional buffer) - "Print a buffer by passing it through m2ps and lpr." - (or buffer (setq buffer (current-buffer))) - (let ((x (save-excursion (set-buffer buffer) tab-width))) - (save-excursion - (set-buffer (get-buffer-create " *mule-print*")) - (erase-buffer) - (insert-buffer buffer) - (if (/= x tab-width) - (progn - (setq tab-width x) - (message "Converting tabs") - (untabify (point-min) (point-max)))) - (setq file-coding-system *internal*) - (shell-command-on-region (point-min) (point-max) - "m2ps | lpr" t)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Multi-Lingual Emacs (MULE) Specific Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar attributed-region nil - "Bogus definition to get rid of compile-time warnings.") - -(defun w3-inhibit-code-conversion (proc buf) - "Inhibit Mule's subprocess PROC from code converting in BUF." - (save-excursion - (set-buffer buf) - (setq mc-flag nil)) - (set-process-coding-system proc *noconv* *noconv*)) - -(defvar w3-mime-list-for-code-conversion - '("text/plain" "text/html") - "List of MIME types that require Mules' code conversion.") -(make-variable-buffer-local 'w3-mime-list-for-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)) - (let* ((c (code-detect-region (point-min) (point-max))) - (code (or (and (listp c) (car c)) c))) - (setq mc-flag t) - (code-convert-region (point-min) (point-max) code *internal*) - (set-file-coding-system code)))) - -(provide 'w3-mule)
--- a/lisp/w3/w3-parse.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-parse.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,4 +1,4 @@ -;; Created by: Joe Wells, jbw@csb.bu.edu +;; 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. @@ -17,8 +17,9 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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 @@ -57,6 +58,7 @@ ;; 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 @@ -116,11 +118,6 @@ "A stack of the currently open elements, with the innermost enclosing element on top and the outermost on bottom.") - (defvar w3-p-d-parse-tag-stream-tail-pointer) - (put 'w3-p-d-parse-tag-stream-tail-pointer 'variable-documentation - "Points to last cons cell in parse-tag stream. We add items to tail of -parse-tag-stream instead of head.") - (defvar w3-p-d-shortrefs) (put 'w3-p-d-shortrefs 'variable-documentation "An alist of the magic entity reference strings in the current @@ -289,15 +286,7 @@ (put (car (car html-entities)) 'html-entity-expansion (cons 'CDATA (if (integerp (cdr (car html-entities))) (char-to-string - (let ((c (cdr (car html-entities)))) - (cond - ((and (> c 127) (boundp 'MULE)) - (make-character lc-ltn1 c)) - ;;((and (> c 127) (featurep 'mule)) - ;; What??? - ;;) - (t - c)))) + (mule-make-iso-character (cdr (car html-entities)))) (cdr (car html-entities))))) (setq html-entities (cdr html-entities)))) @@ -441,18 +430,11 @@ ;; 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. - ;; <URL:ftp://ds.internic.net/internet-drafts/draft-ietf-html-i18n-01.txt> + ;; 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 - (cond - ((and (boundp 'MULE) (> w3-p-s-num 127)) - (make-character lc-ltn1 w3-p-s-num)) - ;;((and (featurep 'mule) (> w3-p-s-num 127)) - ;;what?? - ;;) - (t - w3-p-s-num))))) + (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 @@ -785,15 +767,6 @@ (if w3-p-d-null-end-tag-enabled "/" "") (if w3-p-d-in-parsed-marked-section "]" "") (or w3-p-d-shortref-chars "")))) - - ;; Modifies free variable: - ;; w3-p-d-parse-tag-stream-tail-pointer - (defsubst w3-add-display-item (tag value) - (setcdr w3-p-d-parse-tag-stream-tail-pointer - (list (cons tag value))) - (setq w3-p-d-parse-tag-stream-tail-pointer - (cdr w3-p-d-parse-tag-stream-tail-pointer))) - ) (eval-when-compile @@ -808,13 +781,6 @@ ;; w3-p-s-overrides, w3-p-s-undo-list, w3-p-s-var (defsubst w3-open-element (tag attributes) - ;; Send trailing data character item in the old current element to - ;; display engine. - (if (stringp (car-safe (w3-element-content w3-p-d-current-element))) - (w3-add-display-item - 'text - (car-safe (w3-element-content w3-p-d-current-element)))) - ;; Push new element on stack. (setq w3-p-d-open-element-stack (cons w3-p-d-current-element w3-p-d-open-element-stack)) @@ -874,14 +840,7 @@ w3-p-d-current-element (w3-element-content-model (car w3-p-d-open-element-stack)))) - ;; Send the start-tag and attributes to the display engine. - (if (memq tag '(plaintext style xmp textarea)) - ;; Garbage special-casing for old display engine. - ;; Nothing is sent until end-tag is found. - ;; The DTD will ensure no subelements of these elements. - nil - ;; Normal procedure. - (w3-add-display-item tag attributes))) + ) ) ;; The protocol for handing items to the display engine is as follows. @@ -960,33 +919,14 @@ (cond ((null w3-p-s-content)) ((equal "\n" (car w3-p-s-content)) (setq w3-p-s-content (cdr w3-p-s-content))) - ((and (stringp (car w3-p-s-content)) - ;; Garbage special-casing for old display engine. - (not (memq w3-p-s-end-tag - '(/plaintext /style /xmp /textarea)))) - (w3-add-display-item 'text (car w3-p-s-content)))) + ) - ;; Send the end-tag to the display engine, but only if the element is - ;; allowed to have an end tag. - (cond ((memq w3-p-s-end-tag '(/plaintext /style /xmp /textarea)) - ;; Garbage special-casing for old display engine. - ;; Format old display engine expects for these elements: - ;; (START-TAG . ((data . DATA-CHARACTERS) . ATTRIBUTES)) - (w3-add-display-item - ;; Use the *start*-tag, not the end-tag. - (w3-element-name w3-p-d-current-element) - (cons (cons 'data - (condition-case nil - (mapconcat 'identity w3-p-s-content "") - (error "eeek! subelement content!"))) - (w3-element-attributes w3-p-d-current-element)))) - ;; *** Handle LISTING the way the old parser did. + (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. - (w3-add-display-item w3-p-s-end-tag nil) (if (null w3-p-s-content) (w3-debug-html :bad-style :outer @@ -1175,14 +1115,14 @@ (%imagemaps . (area map)) ;; special action is taken for %text inside %body.content in the ;; content model of each element. - (%body.content . (%heading %block hr div address %imagemaps)) + (%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 font + (%block . (p %list dl form %preformatted %blockquote isindex fn table fig note center %block-deprecated %block-obsoleted)) (%list . (ul ol)) @@ -1196,10 +1136,10 @@ (%text . (*data b %notmath sub sup %emacsw3-crud)) (%notmath . (%special %font %phrase %misc)) - (%font . (i u s strike tt big small sub sup + (%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 font br script map math tab)) + (%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)) @@ -1277,8 +1217,9 @@ (end-tag-omissible . t)) ;; SCRIPT - - (#PCDATA) ((script) - (content-model . CDATA ; not official, but allows - ; comment hiding of script + (content-model . XCDATA ; not official, but allows + ; comment hiding of script, and also + ; idiots that use '</' in scripts. )) ;; TITLE - - (#PCDATA) ((title) @@ -1327,6 +1268,12 @@ include-space ((%in-text-ignore)) nil)])) + ((span bdo) + (content-model . [((%text) + include-space + nil + nil)]) + ) ((p) (content-model . [((%text) include-space @@ -1456,7 +1403,7 @@ ((credit) *close)) nil)]) (end-tag-omissible . t)) - ((%emacsw3-crud) + ((%emacsw3-crud basefont) (content-model . EMPTY)) ;; FORM - - %body.content -(FORM) +(INPUT|KEYGEN|SELECT|TEXTAREA) ((form) @@ -1716,8 +1663,9 @@ (content-model . EMPTY)) ;; ;; APPLET is a Java thing. + ;; OBJECT is a cougar thing ;; <URL:http://java.sun.com/JDK-beta/filesinkit/README> - ((applet) + ((applet object) ;; I really don't want to add another ANY content-model. (content-model . XINHERIT) (inclusions . (param))) @@ -1749,6 +1697,8 @@ (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: @@ -1765,7 +1715,7 @@ '(CDATA RCDATA XCDATA XXCDATA)) (memq tag-name '(*data *space))) ;; *** Implement ANY. - (error "impossible")) + (error "impossible content model lossage")) (setq w3-p-s-includep t) ;; Exit loop. nil) @@ -1945,7 +1895,7 @@ ;; content-model. t) (t - (error "impossible"))))))) + (error "impossible transition"))))))) ;; Empty while loop body. ) @@ -1985,12 +1935,10 @@ ;; % DO NOT call any of the other functions! % ;; % % ;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -(defun w3-parse-buffer (&optional buff nodraw) +(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. -Unless optional second argument NODRAW is non-nil, calls the display -engine on the parsed HTML. Returns a data structure containing the parsed information." (set-buffer (or buff url-working-buffer)) @@ -2011,10 +1959,6 @@ ;; *** Should premunge line boundaries. ;; ******************** - ;; Prepare another buffer to draw in unless told not to. - (if (not nodraw) - (w3-prepare-draw-buffer-for-parse-buffer)) - (let* ( ;; Speed hack, see the variable doc string. (gc-cons-threshold (if (> w3-gc-cons-threshold-multiplier 0) @@ -2039,20 +1983,6 @@ ;; Determine which we can use outside of the loop for speed. (one-hundred (funcall (if (fboundp 'float) 'float 'identity) 100)) - ;; Speed up checking whether to do incremental display. - (w3-do-incremental-display (if nodraw nil w3-do-incremental-display)) - - ;; Used to convert parse tree to tag stream that old display - ;; engine expects. Will change when display engine is rewritten. - (parse-tag-stream '(*dummy)) - - ;; See doc string. - (w3-p-d-parse-tag-stream-tail-pointer parse-tag-stream) - - ;; Points to cons cell in parse-tag-stream whose car is the last - ;; item that has been sent to display engine. - (parse-tag-stream-last-displayed-item parse-tag-stream) - ;; The buffer which contains the HTML we are parsing. This ;; variable is used to avoid using the more expensive ;; save-excursion. @@ -2138,9 +2068,8 @@ ) ;; 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, @@ -2173,8 +2102,6 @@ ;; Display progress messages if asked and/or do incremental display ;; of results (cond ((= 0 (% (setq loop-count (1+ loop-count)) 40)) - (if w3-do-incremental-display - (w3-pause)) (if status-message-format (message status-message-format ;; Percentage of buffer processed. @@ -2196,17 +2123,24 @@ ((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 (downcase (buffer-substring (match-beginning 1) - (match-end 1))))) + (intern (buffer-substring (match-beginning 1) + (match-end 1)))) (setq w3-p-d-end-tag-p (= ?/ (following-char))) (setq between-tags-end (1- (point))) (goto-char (match-end 0)) ;; Read the attributes from a start-tag. - (or - w3-p-d-end-tag-p + (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 @@ -2227,7 +2161,7 @@ "[ \n\r\t]*" ;; The attribute name, possibly with a bad syntax ;; component. - "\\([a-z][-a-z0-9.]*\\(\\([_][-a-z0-9._]*\\)?\\)\\)" + "\\([a-z_][-a-z0-9.]*\\(\\([_][-a-z0-9._]*\\)?\\)\\)" ;; Trailing whitespace and perhaps an "=". "[ \n\r\t]*\\(\\(=[ \n\r\t]*\\)?\\)"))) @@ -2237,10 +2171,12 @@ (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 (downcase (buffer-substring (match-beginning 1) - (match-end 1))))) + (intern (buffer-substring (match-beginning 1) + (match-end 1)))) (goto-char (match-end 0)) (cond ((< (match-beginning 4) (match-end 4)) @@ -2253,7 +2189,7 @@ "\"\\([^\"]*\\)\"" "\\|" ;; Literal with single quotes. - "'\\([^']\\)*'" + "'\\([^']*\\)'" "\\|" ;; Handle bad HTML conflicting with NET-enabling ;; start-tags. @@ -2286,8 +2222,8 @@ (skip-chars-forward "^&") (not (eobp))) (w3-expand-entity-at-point-maybe)) - (subst-char-in-region (point-min) (point-max) ?\t 32) - (subst-char-in-region (point-min) (point-max) ?\n 32)) + (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)))) @@ -2305,13 +2241,13 @@ (format "Evil attribute value syntax: %s" (buffer-substring (point-min) (point-max))))) (t - (error "impossible")))) + (error "impossible attribute value")))) ((memq (following-char) '(?\" ?')) ;; Missing terminating quote character. (narrow-to-region (point) (progn (forward-char 1) - (skip-chars-forward "^ \t\n\r'\"=<>") + (skip-chars-forward "^ \t\n\r'\"<>") (setq attribute-value-end (point)))) (w3-debug-html :nocontext (format "Attribute value missing end quote: %s" @@ -2322,7 +2258,7 @@ ;; make a best guess as to what the author intended. (narrow-to-region (point) (progn - (skip-chars-forward "^ \t\n\r'\"=<>") + (skip-chars-forward "^ \t\n\r'\"<>") (setq attribute-value-end (point)))) (w3-debug-html :nocontext (format "Bad attribute value syntax: %s" @@ -2339,6 +2275,23 @@ ;; * 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 @@ -2352,7 +2305,31 @@ ;; Accumulate the attributes. (setq tag-attributes (cons (cons attr-name attr-value) - tag-attributes)))) + tag-attributes))) + + (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)))) + ) + ) ;; Process the end of the tag. (skip-chars-forward " \t\n\r") @@ -2473,7 +2450,7 @@ (or (= ?\[ (following-char)) ;; I probably shouldn't even check this, since it is so ;; impossible. - (error "impossible")) + (error "impossible ??")) (forward-char 1) (delete-region (1- (match-beginning 0)) (point)) (cond ((eq 'IGNORE keyword) @@ -2625,26 +2602,12 @@ nil ;; We are definitely going to add data characters to the ;; content. - ;; Protocol is that all but last data character item - ;; must have been sent to display engine. - (and content - (stringp (car content)) - ;; Gross, disgusting hack to deal with old interface - ;; to display engine. Remove as soon as possible. - (not (memq (w3-element-name w3-p-d-current-element) - '(plaintext style xmp textarea))) - (w3-add-display-item 'text (car content))) (cond ((and (= ?\n (preceding-char)) (/= between-tags-start (1- (point)))) (setq content (cons (buffer-substring between-tags-start (1- (point))) content)) - ;; Gross, disgusting hack to deal with old interface - ;; to display engine. Remove as soon as possible. - (or (memq (w3-element-name w3-p-d-current-element) - '(plaintext style xmp textarea)) - (w3-add-display-item 'text (car content))) (setq content (cons "\n" content))) (t (setq content (cons (buffer-substring between-tags-start @@ -2774,72 +2737,22 @@ (setq tag-attributes nil) (setq tag-end nil))) - ;; Hand items to the display engine. - (cond ((not nodraw) - (set-buffer w3-draw-buffer) - (while (not (eq parse-tag-stream-last-displayed-item - w3-p-d-parse-tag-stream-tail-pointer)) - (setq parse-tag-stream-last-displayed-item - (cdr parse-tag-stream-last-displayed-item)) - ;; We call w3-handle-single-tag from only one spot so that it - ;; is reasonable to inline it, since it is a big function. - (w3-handle-single-tag - (car (car parse-tag-stream-last-displayed-item)) - (cdr (car parse-tag-stream-last-displayed-item)))) - (set-buffer parse-buffer))) - ;; End of main while loop. ) ;; We have finished parsing the buffer! (if status-message-format (message "%sdone" (format status-message-format 100))) - ;; Do this now so the user can see the full results before Emacs - ;; goes off and garbage-collects for an hour. :-( - (if w3-do-incremental-display - (w3-pause)) ;; *** 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)) - - ;; Return the parse in the format expected, a stream of tags - ;; possibly with a buffer at the front. - (if nodraw - ;; Discard the *dummy item at start of list. - (cdr parse-tag-stream) - (cons w3-draw-buffer (cdr parse-tag-stream))) - + + (w3-element-content w3-p-d-current-element) ))) -;;; -;;; Initialization of display engine to accept parser output. -;;; - -(defun w3-prepare-draw-buffer-for-parse-buffer () - (setq list-buffers-directory nil) - (let ((buf (get-buffer-create (url-generate-new-buffer-name - "Untitled"))) - (info (mapcar (function (lambda (x) (cons x (symbol-value x)))) - w3-persistent-variables))) - (setq w3-draw-buffer buf) - (save-excursion - (set-window-buffer (selected-window) buf) - (set-buffer buf) - (setq w3-draw-buffer (current-buffer)) - (erase-buffer) - (buffer-disable-undo (current-buffer)) - (mapcar (function (lambda (x) (set (car x) (cdr x)))) info) - (setq w3-last-fill-pos (point)) - (setq fill-column (min (- (or w3-strict-width (window-width)) - w3-right-border) - (or w3-maximum-line-length (window-width)))) - (setq fill-prefix "") - (w3-init-state)))) - - (provide 'w3-parse)
--- a/lisp/w3/w3-prefs.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-prefs.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-prefs.el --- Preferences panels for Emacs-W3 ;; Author: wmperry -;; Created: 1996/06/30 18:10:45 -;; Version: 1.5 +;; Created: 1996/12/29 01:49:57 +;; Version: 1.12 ;; Keywords: hypermedia, preferences ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,19 +21,19 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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 'widget) -(require 'widget-edit) (require 'w3-vars) (require 'w3-keyword) -(require 'w3-widget) (require 'w3-toolbar) +(eval-and-compile + (require 'w3-widget)) (defvar w3-preferences-glyph nil) (defvar w3-preferences-map nil) @@ -104,6 +105,7 @@ (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)) @@ -129,6 +131,7 @@ (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) @@ -137,7 +140,7 @@ (widget-insert "\n\t\tURL: ") (widget-put (widget-create - 'field + '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) @@ -271,7 +274,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar w3-preferences-compatibility-variables '( - (w3-style-ie-compatibility + (css-ie-compatibility . "Internet Explorer (tm) 3.0 compatible stylesheet parsing") (w3-netscape-compatible-comments . "Allow Netscape compatible comments") @@ -345,7 +348,7 @@ port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))) (widget-insert (format "%10s Proxy: " proxy)) (widget-put - (widget-create 'field + (widget-create 'editable-field :size 20 :value-face 'underline :notify 'w3-preferences-generic-variable-callback @@ -353,7 +356,7 @@ 'variable host-var) (widget-insert " Port: ") (widget-put - (widget-create 'field + (widget-create 'editable-field :size 5 :value-face 'underline :notify 'w3-preferences-generic-variable-callback @@ -410,8 +413,8 @@ (defun w3-preferences-notify (widget widget-ignore &optional event) (let* ((glyph (and event w3-running-xemacs (event-glyph event))) - (x (and glyph (w3-glyphp glyph) (event-glyph-x-pixel event))) - (y (and glyph (w3-glyphp glyph) (event-glyph-y-pixel 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) @@ -512,15 +515,15 @@ (w3-preferences-create-panel (caar w3-preferences-panels)) (goto-char (point-max)) (widget-insert "\n\n") - (widget-create 'push + (widget-create 'push-button :notify 'w3-preferences-ok-callback :value "Ok") (widget-insert " ") - (widget-create 'push + (widget-create 'push-button :notify 'w3-preferences-cancel-callback :value "Cancel") (widget-insert " ") - (widget-create 'push + (widget-create 'push-button :notify 'w3-preferences-reset-callback :value "Reset") (center-region (point-min) w3-preferences-panel-begin-marker)
--- a/lisp/w3/w3-print.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-print.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,11 +1,12 @@ ;;; w3-print.el --- Printing support for emacs-w3 ;; Author: wmperry -;; Created: 1996/07/09 02:54:01 -;; Version: 1.3 +;; Created: 1996/10/09 19:00:59 +;; Version: 1.5 ;; Keywords: faces, help, printing, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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-use-ps-print nil "*If non-nil, then printing will be done via the ps-print package by
--- a/lisp/w3/w3-speak.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-speak.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,12 +1,14 @@ -;;; w3-speak.el --- Emacs-W3 speech interface -;; Authors: wmperry and Raman -;; Created: 1996/07/09 14:08:09 -;; Version: 1.4 +;;; 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 - -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 by T.V. Raman (raman@adobe.com) +;;; Copyright (c) 1996 by William M. Perry (wmperry@spry.com) ;;; ;;; This file is not part of GNU Emacs, but the same permissions apply. ;;; @@ -21,8 +23,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -32,32 +35,26 @@ ;;; 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. :) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;}}} -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;{{{ Required modules +;;; 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 'dtk-css-speech) (require 'emacspeak-speak) (require 'emacspeak-sounds) (eval-when (compile) - (require 'emacspeak-fix-interactive))) + (require 'emacspeak-fix-interactive))) (error (message "Emacspeak not found - speech will not work."))) -;;}}} - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; How to get information summarizing a form field, so it can be spoken in @@ -76,6 +73,21 @@ (get type 'w3-speak-summarizer)) ;;}}} +;;{{{ Associate summarizer functions for form fields + +(w3-speak-define-field-summarizer 'text) +(w3-speak-define-field-summarizer 'option) +(w3-speak-define-field-summarizer 'checkbox) +(w3-speak-define-field-summarizer 'reset) +(w3-speak-define-field-summarizer 'submit) +(w3-speak-define-field-summarizer 'button) +(w3-speak-define-field-summarizer 'radio) +(w3-speak-define-field-summarizer 'multiline) +(w3-speak-define-field-summarizer 'image) + +;;}}} + + ;;{{{ define the form field summarizer functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -92,23 +104,13 @@ (let ( (label (w3-speak-extract-form-field-label data)) (name (w3-form-element-name data)) - (value (widget-value (w3-form-element-widget data)))) + (value (widget-get (w3-form-element-widget data) :value))) (dtk-speak (format "Text field %s %s " (or label (concat "called " name)) (concat "set to " value))))) -(defun w3-speak-summarize-file-field (data) - "Summarize a f field of type file given the field data." - (let ( - (label (w3-speak-extract-form-field-label data)) - (name (w3-form-element-name data)) - (value (widget-value (w3-form-element-widget data)))) - (dtk-speak - (format "File field %s %s " (or label (concat "called " name)) - (concat "set to " value))))) - -(defun w3-speak-summarize-textarea-field (data) - "Summarize a textarea field given the field data." +(defun w3-speak-summarize-multiline-field (data) + "Summarize a text field given the field data." (let ( (name (w3-form-element-name data)) (label (w3-speak-extract-form-field-label data)) @@ -160,7 +162,7 @@ (reset "Reset Form") (button "A Button")))))) -(defalias 'w3-speak-summarize-reset-field 'w3-speak-summarize-submit-field) +(defalias 'w3-speak-summarize-reset-field 'w3-speak-summarize-submit-field) (defalias 'w3-speak-summarize-button-field 'w3-speak-summarize-submit-field) (defun w3-speak-summarize-radio-field (data) @@ -175,22 +177,8 @@ "not pressed"))))) ;;}}} -;;{{{ Associate summarizer functions for form fields - -(w3-speak-define-field-summarizer 'text) -(w3-speak-define-field-summarizer 'option) -(w3-speak-define-field-summarizer 'checkbox) -(w3-speak-define-field-summarizer 'reset) -(w3-speak-define-field-summarizer 'submit) -(w3-speak-define-field-summarizer 'button) -(w3-speak-define-field-summarizer 'radio) -(w3-speak-define-field-summarizer 'multiline) -(w3-speak-define-field-summarizer 'image) -(w3-speak-define-field-summarizer 'file) - -;;}}} -;;{{{ speaking form fields +;;{{{ speaking form fields ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Now for the guts @@ -206,7 +194,9 @@ (type (and data (w3-form-element-type data))) (summarizer (and type (w3-speak-get-field-summarizer type)))) (cond - ((and data summarizer (fboundp summarizer)) + ((and data + summarizer + (fboundp summarizer)) (funcall summarizer data)) (data (message "Please define a summarizer function for %s" type)) @@ -214,38 +204,37 @@ ;;}}} -;;{{{ Movement notification - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Movement notification ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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 )))))) + (let ((start (point ))) + (emacspeak-auditory-icon 'scroll) + (save-excursion + (forward-line (window-height)) + (emacspeak-speak-region start (point )))))) (defadvice w3-follow-link (around emacspeak pre act) "Provide feedback on what you did. " - (let ((data (w3-speak-extract-form-field-information)) - (form-field-p nil)) + (let ((data (emacspeak-w3-extract-form-field-information)) + (form-field-p nil) + (this-zone nil) + (opoint nil)) (if data - (setq form-field-p t)) + (setq form-field-p t + opoint (point))) ad-do-it (when form-field-p (w3-speak-summarize-form-field) (case (w3-form-element-type data) - ((radio checkbox button) + ((radio checkbox) (emacspeak-auditory-icon 'button)) - ((text textarea) - (emacspeak-auditory-icon 'close-object) ;; fill in any others here (otherwise nil))) - ad-return-value))) + ad-return-value)) (defadvice w3-revert-form (after emacspeak pre act) "Announce that you cleared the form. " @@ -256,24 +245,6 @@ (when (interactive-p) (w3-speak-summarize-form-field))) -(defadvice widget-forward (after emacspeak pre act) - "Produce an auditory icon when moving forward. -If on a form field, then summarize it." - (declare (special emacspeak-lazy-message-time)) - (when (interactive-p) - (let ((emacspeak-lazy-message-time 0)) - (w3-speak-summarize-form-field) - (emacspeak-auditory-icon 'large-movement)))) - -(defadvice widget-backward (after emacspeak pre act) - "Produce an auditory icon when moving backward. -If on a form field, then summarize it." - (declare (special emacspeak-lazy-message-time)) - (when (interactive-p ) - (let ((emacspeak-lazy-message-time 0)) - (w3-speak-summarize-form-field) - (emacspeak-auditory-icon 'large-movement)))) - (defadvice w3-start-of-document (after emacspeak pre act) "Produce an auditory icon. Also speak the first line. " (when (interactive-p) @@ -281,7 +252,7 @@ (emacspeak-auditory-icon 'large-movement))) (defadvice w3-end-of-document (after emacspeak pre act) - "Produce an auditory icon. " + "Produce an auditory icon. Also speak the first line." (when (interactive-p) (emacspeak-speak-line) (emacspeak-auditory-icon 'large-movement))) @@ -299,21 +270,13 @@ (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. " + "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)) - (when (interactive-p) - (emacspeak-auditory-icon 'select-object) - ad-do-it - (set (make-local-variable 'voice-lock-mode) t) - (setq dtk-punctuation-mode "some") - (modify-syntax-entry 10 " ") - (emacspeak-auditory-icon 'open-object) - (emacspeak-speak-mode-line ))) - -;;}}} -;;{{{ top level + (emacspeak-auditory-icon 'select-object) + ad-do-it) (defun w3-speak-mode-hook () (set (make-local-variable 'voice-lock-mode) t) @@ -340,14 +303,25 @@ w3-delimit-emphasis nil) (add-hook 'w3-mode-hook 'w3-speak-mode-hook))) -;;}}} -;;{{{ make-local-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) -;;; hope this is correct: -(unless (fboundp 'make-local-hook) -(defun make-local-hook (var) - (make-variable-buffer-local var)) -) +(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) + (emacspeak-auditory-icon 'progress)))) + (provide 'w3-speak)
--- a/lisp/w3/w3-style.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-style.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-style.el --- Emacs-W3 binding style sheet mechanism ;; Author: wmperry -;; Created: 1996/08/12 03:10:30 -;; Version: 1.13 +;; Created: 1996/12/13 18:01:46 +;; Version: 1.23 ;; Keywords: faces, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -33,518 +35,9 @@ (require 'font) (require 'w3-keyword) (require 'cl) - -(defvar w3-style-css-syntax-table - (copy-syntax-table mm-parse-args-syntax-table) - "The syntax table for parsing stylesheets") - -(defvar w3-style-ie-compatibility nil - "*Whether we want to do Internet Explorer 3.0 compatible parsing of -CSS stylesheets.") - -(defun w3-style-css-parse-args (st &optional nd defines) - ;; 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 - ) - (save-excursion - (if (stringp st) - (progn - (set-buffer (get-buffer-create " *w3-style-temp*")) - (set-syntax-table w3-style-css-syntax-table) - (erase-buffer) - (insert st) - (setq st (point-min) - nd (point-max))) - (set-syntax-table w3-style-css-syntax-table)) - (save-restriction - (if (< nd st) - (narrow-to-region nd nd) - (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 (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 - (if w3-style-ie-compatibility - (skip-chars-forward "^;") - (skip-chars-forward "^,;")) - (skip-chars-backward " \t") - (point))))))) - (setq results (cons (cons name value) results)) - (skip-chars-forward ";, \n\t")) - results)))) - -(defvar w3-style-css-define-table nil) - -(defun w3-style-css-handle-define () - (let ((name nil) - (save-pos (point)) - (retval nil)) - (skip-chars-forward "^ \t\r\n") ; Past the name token - (downcase-region save-pos (point)) - (setq name (buffer-substring save-pos (point))) - (skip-chars-forward "= \t\r") - (setq save-pos (point)) - (skip-chars-forward "^;") - (setq retval (cons name (buffer-substring save-pos (point)))) - (skip-chars-forward " \t\r\n") - retval)) - -(defun w3-style-css-handle-import () - (let ((url nil) - (save-pos (point))) - (if (looking-at "'\"") - (condition-case () - (forward-sexp 1) - (error (skip-chars-forward "^ \t\r\n;"))) - (skip-chars-forward "^ \t\r\n;")) - (setq url (url-expand-file-name (buffer-substring save-pos (point)))) - (skip-chars-forward "\"; \t\r\n") - (setq save-pos (point)) - (let ((url-working-buffer (url-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) - (w3-style-css-clean) - (setq sheet (buffer-string)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (insert sheet) - (goto-char save-pos)))) - -(defun w3-style-css-clean () - ;; 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 - (w3-replace-regexp "^[ \t\r]+" "") ; Nuke whitespace at beg. of line - (w3-replace-regexp "[ \t\r]+$" "") ; Nuke whitespace at end of line - (goto-char (point-min))) - -(defun w3-style-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 (buffer-substring save-pos (point)) results)) - (skip-chars-forward ", \t\r\n")) - (widen) - results)) - -(defun w3-style-active-device-types (&optional device) - (let ((types (list 'normal 'default (if w3-running-xemacs 'xemacs 'emacs))) - (type (device-type device))) - (cond - ((featurep 'emacspeak) - (setq types (cons 'speech types))) - ((eq type 'tty) - (if (and (fboundp 'tty-color-list) - (/= 0 (length (tty-color-list)))) - (setq types (cons 'ansi-tty types)) - (setq types (cons 'tty types)))) - ((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)))) - types)) - -(defun w3-style-parse-css (fname &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 - (tag nil) - (att nil) - (cur nil) - (val nil) - (class nil) - (defines nil) - (device-type nil) - (active-device-types (w3-style-active-device-types (selected-device))) - (sheet inherit)) - (save-excursion - (set-buffer (get-buffer-create - (url-generate-new-buffer-name " *style*"))) - (set-syntax-table w3-style-css-syntax-table) - (erase-buffer) - (if fname (url-insert-file-contents fname)) - (goto-char (point-max)) - (if string (insert string)) - (w3-style-css-clean) - (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, and we are doing IE compatibility - ((and (looking-at "//") w3-style-ie-compatibility) - (end-of-line)) - ;; Pre-Processor directives - ((looking-at "[ \t\r]*@\\([^ \t\r\n]\\)") - (let ((directive nil)) - (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 (buffer-substring save-pos (point))) - (skip-chars-forward " \t\r") ; Past any trailing whitespace - (setq save-pos (point)) - (cond - ((string= directive "define") - (let ((retval (w3-style-css-handle-define))) - (and defines - (setq defines (cons retval defines))))) - ((string= directive "import") - (w3-style-css-handle-import)) - (t - (w3-warn 'style (format "Unknown directive: @%s" directive) - 'warning))))) - ;; Giving us some output device information - ((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 (w3-style-css-applies-to save-pos (point))) - (skip-chars-forward "^{") - (setq save-pos (point)) - (forward-sexp 1) - (end-of-line) - (skip-chars-backward "\r}") - (subst-char-in-region save-pos (point) ?\n ? ) - (subst-char-in-region save-pos (point) ?\r ? ) - (setq attrs (w3-style-css-parse-args (1+ save-pos) - (point) defines)) - (skip-chars-forward "}\r\n") - (while applies-to - (setq cur (car applies-to) - applies-to (cdr applies-to)) - (cond - ((string-match "\\([^.]*\\)\\.\\(.*\\)" cur) ; Normal class - (setq tag (intern (downcase (match-string 1 cur))) - class (match-string 2 cur))) - ((string-match "\\(.*\\):\\(.*\\)" cur) ; Pseudo class - (setq tag (intern (downcase (match-string 1 cur))) - class (match-string 2 cur))) - (t ; No class - global - (setq tag (intern (downcase cur)) - class 'internal))) - (let ((loop attrs)) - (while loop - (if (stringp (car (car loop))) - (setcar (car loop) (intern (car (car loop))))) - (setq att (car (car loop)) - val (cdr (car loop)) - loop (cdr loop)) - (case att - ((align textalign text-align display white-space) - (setq val (intern (downcase val)))) - ((indent left-margin right-margin top-margin bottom-margin) - (setq val (string-to-int val))) - (otherwise - nil)) - (let* ((node-1 (assq tag sheet)) - (node-2 (and node-1 (assoc class node-1))) - (node-3 (and node-2 (assq att node-2)))) - (cond - ((not node-1) ; New top-level element - (setq sheet (cons (cons tag (list (cons class - (list - (cons att val))))) - sheet))) - ((and node-1 (not node-2)) ; New class for existing element - (setcdr node-1 (cons (cons class (list (cons att val))) - (cdr node-1)))) - ((and node-2 (not node-3)) ; attribute/value on old class - (setcdr node-2 (cons (cons att val) (cdr node-2)))) - (node-3 ; Replace existing attribute value - (setcdr node-3 val))))))))) - (skip-chars-forward " \t\r\n")) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (cons sheet defines))) +(require 'css) -(defvar w3-style-font-size-mappings - '(("xx-small" . 0) - ("x-small" . 1) - ("small" . 2) - ("medium" . 3) - ("large" . 4) - ("x-large" . 5) - ("xx-large" . 6) - ) - "A list of font size mappings") - -(defvar w3-style-font-weight-mappings - '(("-3" . :extra-light) - ("-2" . :light) - ("-1" . :demi-light) - ("0" . :medium) - ("1" . :normal) - ("2" . :demi-bold) - ("3" . :bold) - ("4" . :extrabold) - ("bold" . :bold) - ("demi-light" . :demi-light) - ("demi-bold" . :demi-bold) - ("extra-bold" . :extra-bold) - ("extra-light". :extra-light) - ) - "A list of font weight mappings.") - -(defun w3-style-font-size-for-index (index) - (if (stringp index) - (setq index (or - (cdr-safe (assoc (downcase index) - w3-style-font-size-mappings)) - 3))) - (setq index (- index 3)) - (let ((scaler (if (> index 0) - 1.44 - 0.695)) - (size 12)) - (setq index (abs index)) - (while (/= index 0) - (setq size (* size scaler) - index (1- index))) - ;; This rounds to the nearest '10' - (format "%dpt" (* 10 (round (/ size 10)))))) - -(defsubst w3-style-speech-normalize-number (num) - (if num (% (abs (read num)) 9))) - -(defun w3-generate-stylesheet-voices (sheet) - (let ((todo sheet) - cur cur-classes - node family gain - left right pitch - pitch-range stress - richness voice - ) - (while todo - (setq cur (car todo) - cur-classes (cdr cur) - todo (cdr todo)) - (while cur-classes - (setq node (cdr (car cur-classes)) - cur (car cur-classes) - cur-classes (cdr cur-classes) - family (cdr-safe (assq 'voice-family node)) - family (if family (intern (downcase family))) - gain (w3-style-speech-normalize-number - (cdr-safe (assq 'gain node))) - left (w3-style-speech-normalize-number - (cdr-safe (assq 'left-volume node))) - right (w3-style-speech-normalize-number - (cdr-safe (assq 'right-volume node))) - pitch (w3-style-speech-normalize-number - (cdr-safe (assq 'pitch node))) - pitch-range (w3-style-speech-normalize-number - (cdr-safe (assq 'pitch-range node))) - stress (w3-style-speech-normalize-number - (cdr-safe (assq 'stress node))) - richness (w3-style-speech-normalize-number - (cdr-safe (assq '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)) - (if voice (setcdr cur (cons (cons 'voice-spec voice) (cdr cur)))) - ) - ) - ) - ) - -(defun w3-style-post-process-stylesheet (sheet) - (w3-generate-stylesheet-faces sheet) - (if (featurep 'emacspeak) - (w3-generate-stylesheet-voices w3-user-stylesheet))) - -(defun w3-style-css-split-font-shorthand (font) - ;; [<font-weight> || <font-style>]? <font-size> [ / <line-height> ]? <font-family> - (let (weight size height family) - (if (not (string-match " *\\([0-9.]+[^ /]+\\)" font)) - (error "Malformed font shorthand: %s" font)) - (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)) - (setq family (url-strip-leading-spaces font))) - (list weight size height family))) - -(defun w3-generate-stylesheet-faces (sheet) - (let ((todo sheet) - (cur nil) - (cur-classes nil) - (node nil) - (fore nil) - (back nil) - (pixmap nil) - (font nil) - (family nil) - (decoration nil) - (style nil) - (size nil) - (index nil) - (shorthand nil) - (weight nil) - (break-style nil)) - (while todo - (setq cur (car todo) - cur-classes (cdr cur) - todo (cdr todo)) - (while cur-classes - (setq node (cdr (car cur-classes)) - cur (car cur-classes) - cur-classes (cdr cur-classes) - fore (cdr-safe (assq 'color node)) - back (cdr-safe (assq 'background node)) - decoration (cdr-safe (assq 'text-decoration node)) - pixmap (cdr-safe (assq 'backdrop node)) - index (cdr-safe (assq 'font-size-index node)) - size (or (and index (w3-style-font-size-for-index index)) - (cdr-safe (assq 'font-size node))) - family (cdr-safe (assq 'font-family node)) - weight (cdr-safe (assq 'font-weight node)) - weight (or (cdr-safe (assoc weight - w3-style-font-weight-mappings)) - weight) - style (cdr-safe (assq 'font-style node)) - shorthand (cdr-safe (assq 'font node))) - - ;; Make sure all 'break' items get intern'd - (if (or style decoration) - (setq style (concat style decoration))) - (setq break-style (assq 'break node)) - (if (and (cdr break-style) (stringp (cdr break-style))) - (setcdr break-style (intern (cdr break-style)))) - (if shorthand - (progn - (setq shorthand (w3-style-css-split-font-shorthand shorthand)) - (setq weight (or (nth 0 shorthand) weight) - size (or (nth 1 shorthand) size) - family (or (nth 3 shorthand) family) - weight (or (cdr-safe - (assoc weight - w3-style-font-weight-mappings)) - weight)))) - (if style - (setq style (mapcar - (function - (lambda (x) - (while (string-match "-" x) - (setq x (concat - (substring x 0 (match-beginning 0)) - (substring x (match-end 0) nil)))) - (intern-soft - (concat "font-set-" (downcase x) "-p")))) - (delete "" (split-string style "[ \t&,]"))))) - (if family (setq family (delete "" (split-string family ",")))) - (if (or family weight style size) - (progn - (setq font (make-font :family family :weight weight :size size)) - (while style - (and (fboundp (car style)) - (funcall (car style) font t)) - (setq style (cdr style)))) - (setq font nil)) - (if font (setcdr cur (cons (cons 'font-spec font) (cdr cur)))) - (if fore (setcdr cur (cons (cons 'foreground fore) (cdr cur)))) - (if back (setcdr cur (cons (cons 'background back) (cdr cur)))) - ) - ) - ) - ) (defun w3-handle-style (&optional args) (let ((fname (or (cdr-safe (assq 'href args)) @@ -566,22 +59,17 @@ (erase-buffer) (setq url-be-asynchronous nil) (cond - ((member type '("experimental" "arena" "w3c-style" "css")) - (let ((data (w3-style-parse-css fname string cur-sheet))) - (setq stylesheet (nth 0 data) - defines (nth 1 data)))) + ((member type '("experimental" "arena" "w3c-style" "css" "text/css")) + (setq stylesheet (css-parse fname string cur-sheet))) (t (w3-warn 'html "Unknown stylesheet notation: %s" type)))) (setq w3-current-stylesheet stylesheet) - (w3-style-post-process-stylesheet w3-current-stylesheet))) + ) + ) (defun w3-display-stylesheet (&optional sheet) (interactive) (if (not sheet) (setq sheet w3-current-stylesheet)) - (with-output-to-temp-buffer "W3 Stylesheet" - (set-buffer standard-output) - (emacs-lisp-mode) - (require 'pp) - (pp sheet (current-buffer)))) + (css-display sheet)) (provide 'w3-style)
--- a/lisp/w3/w3-sysdp.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-sysdp.el Mon Aug 13 09:06:37 2007 +0200 @@ -2,9 +2,9 @@ ;; Copyright (C) 1995 Ben Wing. -;; Author: Ben Wing <wing@666.com> +;; Author: Ben Wing <wing@666.com>, William Perry <wmperry@aventail.com> ;; Keywords: lisp, tools -;; Version: 0.001 +;; 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 @@ -50,21 +50,10 @@ ;; to sysdep.el; that way, the collective body of knowledge gets ;; increased. -;; DO NOT load this file with `require'. -;; DO NOT put a `provide' statement in this file. - ;; 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.002") - -(if (and (boundp 'sysdep-version) - (not (string-lessp sysdep-version sysdep-potential-version))) - ;; if a more recent version of sysdep was already loaded, - ;; or if the same package is loaded again, don't load. - nil - -(defconst sysdep-version sysdep-potential-version) +(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 @@ -77,20 +66,39 @@ ;; in v18.) (defmacro sysdep-defun (function &rest everything-else) - (` (cond ((or (not (fboundp (quote (, function)))) - (get (quote (, function)) 'sysdep-defined-this)) - (put (quote (, function)) 'sysdep-defined-this t) + (` (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 ((or (not (boundp (quote (, function)))) - (get (quote (, function)) 'sysdep-defined-this)) + (` (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 ((or (not (boundp (quote (, function)))) - (get (quote (, function)) 'sysdep-defined-this)) + (` (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)))))) @@ -98,15 +106,25 @@ ;; is already quoted. (defmacro sysdep-fset (function def) - (` (cond ((and (or (not (fboundp (, function))) - (get (, function) 'sysdep-defined-this)) + (` (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 (or (not (fboundp (, function))) - (get (, function) 'sysdep-defined-this)) + (` (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)) @@ -262,32 +280,34 @@ (sysdep-defalias 'x-display-grayscale-p 'x-grayscale-display-p) (sysdep-defalias 'menu-event-p 'misc-user-event-p) -(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)) +;; WMP - commention 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 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))) @@ -295,14 +315,23 @@ (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)))) + (sysdep-defun facep (face) "Return t if X is a face name or an internal face vector." ;; CAUTION!!! This is Emacs 19.x, for x <= 28, specific ;; I know of no version of Lucid Emacs or XEmacs that did not have ;; facep. Even if they did, they are unsupported, so big deal. - (and (or (internal-facep face) - (and (symbolp face) (assq face global-face-data))) - t)) + (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))) (sysdep-defun set-face-property (face property value &optional locale tag-set how-to-add) @@ -314,6 +343,83 @@ "Return FACE's value of the given PROPERTY." (and (symbolp face) (get face property))) +;;; 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. + +(sysdep-defun 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))))) + +;; This function (from simon's unique.el) is rewritten and inlined for speed. +;(defun unique (list function) +; "Uniquify LIST, deleting elements using FUNCTION. +;Return the list with subsequent duplicate items removed by side effects. +;FUNCTION is called with an element of LIST and a list of elements from LIST, +;and should return the list of elements with occurrences of the element removed, +;i.e., a function such as `delete' or `delq'. +;This function will work even if LIST is unsorted. See also `uniq'." +; (let ((list list)) +; (while list +; (setq list (setcdr list (funcall function (car list) (cdr list)))))) +; list) + +(sysdep-defun 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. +(sysdep-defun 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 + (unique (append val (if (listp prev) prev (list prev)))) + object) + (setq start next)))) + +(sysdep-defun 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 + (unique (append (if (listp prev) prev (list prev)) val)) + object) + (setq start next)))) + ;; Property list functions ;; (sysdep-defun plist-put (plist prop val) @@ -336,7 +442,9 @@ (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." - (car-safe (cdr-safe (memq prop plist)))) + (while (and plist (not (eq (car plist) prop))) + (setq plist (cdr (cdr plist)))) + (and plist (car (cdr plist)))) ;; Device functions ;; By wmperry@cs.indiana.edu @@ -374,7 +482,7 @@ have no effect." (cond ((and (eq type 'x) connection) - (make-frame-on-display display props)) + (make-frame-on-display connection props)) ((eq type 'x) (make-frame props)) ((eq type 'tty) @@ -401,7 +509,7 @@ Windows 95. Not currently implemented. pc A direct-write MS-DOS frame. Not currently implemented. -PROPS should be a plist of properties, as in the call to `make-frame'. +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." @@ -547,7 +655,10 @@ (t 'ignore))) (sysdep-defun try-font-name (fontname &rest args) - (car-safe (x-list-fonts fontname))) + (cond + ((eq window-system 'x) (car-safe (x-list-fonts fontname))) + ((eq window-system 'ns) (car-safe (ns-list-fonts fontname))) + (t nil))) (sysdep-defalias 'device-pixel-width (cond @@ -943,6 +1054,15 @@ (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)))) @@ -956,6 +1076,7 @@ ;; not defined in v18 (sysdep-defun eval-buffer (bufname &optional printflag) + (interactive) (save-excursion (set-buffer bufname) (eval-current-buffer))) @@ -969,13 +1090,7 @@ (and (windowp window) (window-point window))) -;; this parenthesis closes the if statement at the top of the file. - -) - -;; DO NOT put a provide statement here. This file should never be -;; loaded with `require'. Use `load-library' instead. - +(provide 'w3-sysdp) ;;; sysdep.el ends here ;;;(sysdep.el) Local Variables:
--- a/lisp/w3/w3-toolbar.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-toolbar.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,11 +1,12 @@ ;;; w3-toolbar.el --- Toolbar functions for emacs-w3 ;; Author: wmperry -;; Created: 1996/06/30 18:12:43 -;; Version: 1.2 +;; Created: 1996/12/30 16:04:40 +;; Version: 1.6 ;; Keywords: mouse, toolbar ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -20,15 +21,19 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'xpm-button) -(require 'xbm-button) +(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") @@ -170,9 +175,8 @@ (defun w3-link-is-defined (rel &optional rev) (or - (cdr-safe (assoc rel (cdr-safe (assoc "Parent of" w3-current-links)))) - (cdr-safe (assoc (or rev rel) (cdr-safe (assoc "Child of" - w3-current-links)))))) + (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 @@ -288,7 +292,7 @@ (if toolbar (if (w3-toolbar-active) (set-specifier toolbar (cons (current-buffer) nil)) - (set-specifier toolbar (cons (current-buffer) w3-link-toolbar)))))) + (set-specifier toolbar w3-link-toolbar (current-buffer)))))) (defun w3-toggle-toolbar () (interactive)
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1996/08/29 04:09:40 -;; Version: 1.18 +;; Created: 1997/01/03 16:47:06 +;; Version: 1.64 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,15 +21,16 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst w3-version-number - (let ((x "p3.0.12")) + (let ((x "p3.0.43")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -36,7 +38,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1996/08/29 04:09:40")) +(defconst w3-version-date (let ((x "1997/01/03 16:47:06")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -123,6 +125,8 @@ url == show the url of the target in the minibuffer text == show the text of the link in the minibuffer + title == show the title attribute of the link in the minibuffer, + or the url if there is no title nil == show nothing") (defvar w3-horizontal-rule-char ?- @@ -137,13 +141,6 @@ of commonly accessed URL's without having to go through 20 levels of menus to get to them.") -(defvar w3-html2latex-args "-s -" - "*Args to pass `w3-html2latex-prog'. This should send the LaTeX source -to standard output.") - -(defvar w3-html2latex-prog "html2latex" - "*Program to convert html to latex.") - (defvar w3-icon-directory "http://cs.indiana.edu/elisp/w3/icons/" "*Where to find standard icons. Must end in a /!") @@ -273,7 +270,7 @@ 'yes 'reuse 'always ==> always reuse 'ask nil ==> always ask") -(defvar w3-right-border 2 +(defvar w3-right-margin 2 "*Amount of space to leave on right margin of WWW buffers. This amount is subtracted from (window-width) for each new WWW buffer and used as the new fill-column.") @@ -281,7 +278,7 @@ (defvar w3-maximum-line-length nil "*Maximum length of a line. If nil, then lines can extend all the way to the window margin. If a number, the smaller of this and -(- (window-width) w3-right-border) is used.") +(- (window-width) w3-right-margin) is used.") (defvar w3-right-justify-address t "*Whether to make address fields right justified, like Arena.") @@ -318,12 +315,6 @@ A single text entry box will be drawn where the ISINDEX tag appears. If t, the isindex handling will be the same as Mosaic for X.") -(defvar w3-use-html2latex nil - "*This controls how HTML is converted into LaTeX for printing or mailing. -If nil, the w3-convert-html-to-latex function is used instead of the -html2latex in a subprocess. The lisp function gives slightly better -formatting in my biased opinion.") - (defvar w3-use-netscape-configuration-file nil "*Whether to use a netscape configuration file to determine things like home pages, link colors, etc. If non-nil, then `w3-netscape-configuration-file' @@ -469,46 +460,6 @@ 255 255 255 255 10000 then it's safe to set this variable to nil.") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; How to look up styles -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-style-tags-assoc - '( - (b . ("*" . "*")) - (address . ("*" . "*")) - (byline . ("_" . "_")) - (cite . ("_" . "_")) - (cmd . ("*" . "*")) - (dfn . ("*" . "*")) - (em . ("~" . "~")) - (i . ("~" . "~")) - (q . ("\"" . "\"")) - (removed . ("" . "")) - (s . ("" . "")) - (strong . ("*" . "*")) - (sub . ("" . "")) - (sup . ("" . "")) - (u . ("_" . "_")) - ) - "*An assoc list of emphasis tags and their corresponding -begin and end characters.") - -(defvar w3-header-chars-assoc - '( - (h1 . (?* ?* w3-upcase-region)) - (h2 . (?* ?* w3-upcase-region)) - (h3 . (?- ?- w3-upcase-region)) - (h4 . (nil ?= nil)) - (h5 . (nil ?= nil)) - (h6 . (nil ?: nil))) - "*An assoc list of header tags and a list of formatting instructions. -This list consists of 3 items - the first item is no longer used. The -second item is the character to insert after the header. A <BR> is -inserted before and after this string. And the third is a function to -call on the region between the start and end of the header. This will -be called with 2 arguments, the buffer positions of the start and end -of the headers.") - ;; Store the database of HTML general entities. (defvar w3-html-entities '( @@ -740,16 +691,6 @@ If there is a 3rd item in the list, it is the alternative text to use for the image.") -(defvar w3-list-chars-assoc - '( - (ul . ("o" "*" "+" ">")) - (ol . ("." ")" "]" ":")) - (dl . ("o" "*" "+" ">"))) - "An assoc list of characters to put at the front of list items. It is -keyed on the type of list, followed by a list of items. Each item should -be placed in the nth position of the list, where n is the nesting level it -should be used for. n starts at 1.") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Menu definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -790,6 +731,14 @@ the link. Each label can have exactly one `%s' that will be replaced by the URL of the link.") +(defvar 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.") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables internal to W3, you should not change any of these ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -913,7 +862,8 @@ (defvar w3-current-annotation nil "URL of document we are annotating...") (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-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.") (defconst w3-default-continuation '(url-uncompress url-clean-text) @@ -942,12 +892,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; buffer-local variables to keep around when going into w3-mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-e19-hotlist-menu nil - "A menu for hotlists.") - -(defvar w3-e19-links-menu nil - "A buffer-local menu for links.") - (defvar w3-id-positions nil "Internal use only.") (defvar w3-imagemaps nil "Internal use only.") @@ -971,12 +915,12 @@ url-current-server url-current-type url-current-user - w3-e19-links-menu w3-current-parse w3-current-annotation w3-current-isindex w3-current-last-buffer w3-current-links + w3-current-metainfo w3-current-source w3-delayed-images w3-hidden-forms @@ -1088,20 +1032,19 @@ (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-\C-i" 'w3-insert-this-url) (define-key w3-mode-map "\M-m" 'w3-mail-current-document) (define-key w3-mode-map "\M-s" 'w3-search) (define-key w3-mode-map "\M-\r" 'w3-follow-inlined-image) (define-key w3-mode-map "\r" 'w3-widget-button-press) -(define-key w3-mode-map "b" 'widget-backward) +(define-key w3-mode-map "b" 'w3-widget-backward) (define-key w3-mode-map "c" 'w3-mail-document-author) -(define-key w3-mode-map "f" 'widget-forward) +(define-key w3-mode-map "f" 'w3-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 "n" 'w3-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) @@ -1116,8 +1059,8 @@ (define-key w3-mode-map [(control meta t)] 'url-list-processes) ;; Widget navigation -(define-key w3-mode-map "\t" 'widget-forward) -(define-key w3-mode-map [(shift tab)] 'widget-backward) +(define-key w3-mode-map "\t" 'w3-widget-forward) +(define-key w3-mode-map [(shift tab)] 'w3-widget-backward) (define-key w3-annotation-minor-mode-map "\C-c\C-c" 'w3-personal-annotation-finish)
--- a/lisp/w3/w3-widget.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-widget.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,14 +1,14 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; w3-widget.el --- An image widget ;; Author: wmperry -;; Created: 1996/07/21 18:11:36 -;; Version: 1.3 -;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia +;; Created: 1996/12/29 01:27:32 +;; Version: 1.12 +;; Keywords: faces, images ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -21,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -51,32 +52,46 @@ (require 'cl) (require 'widget) -(require 'w3-vars) -(require 'w3-mouse) -(defvar w3-image-widget-keymap (make-sparse-keymap) +(defvar widget-image-keymap (make-sparse-keymap) "Keymap used over glyphs in an image widget") -(define-key w3-image-widget-keymap (vector w3-mouse-button1) - 'w3-image-widget-button-press) -(define-key w3-image-widget-keymap (vector w3-mouse-button2) - 'w3-image-widget-button-press) +(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)) + +(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 'w3-image-widget-convert + :convert-widget 'widget-image-convert :value-to-internal (lambda (widget value) value) :value-to-external (lambda (widget value) value) - :value-set 'w3-image-widget-value-set - :create 'w3-image-widget-create - :delete 'w3-image-widget-delete - :value-create 'w3-image-widget-value-create - :value-delete 'w3-image-widget-value-delete - :value-get 'w3-image-widget-value-get - :notify 'w3-image-widget-notify + :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 w3-image-widget-convert (widget) +(defun widget-image-convert (widget) (let ((args (widget-get widget :args))) (widget-put widget :args nil) (while args @@ -84,12 +99,12 @@ (setq args (cddr args))) widget)) -(defun w3-image-widget-value-get (widget) +(defun widget-image-value-get (widget) (let ((children (widget-get widget :children))) (and (car children) (widget-apply (car children) :value-get)))) -(defun w3-image-widget-create (widget) +(defun widget-image-create (widget) ;; Create an image widget at point in the current buffer (let ((where (widget-get widget 'where))) (cond @@ -100,20 +115,20 @@ ((integerp where) (setq where (set-marker (make-marker) where))) (t - (error "IMPOSSIBLE position in w3-image-widget-create: %s" where))) + (error "IMPOSSIBLE position in widget-image-create: %s" where))) (widget-put widget 'where where)) - (w3-image-widget-value-create widget)) + (widget-image-value-create widget)) -(defun w3-image-widget-value-set (widget value) +(defun widget-image-value-set (widget value) ;; Recreate widget with new value. (save-excursion - (w3-image-widget-delete widget) - (if (w3-glyphp value) + (widget-image-delete widget) + (if (widget-glyphp value) (widget-put widget 'glyph value) (widget-put widget :value value)) (widget-apply widget :create))) -(defsubst w3-image-widget-usemap (widget) +(defsubst widget-image-usemap (widget) (let ((usemap (widget-get widget 'usemap))) (if (listp usemap) usemap @@ -121,15 +136,24 @@ (setq usemap (substring usemap 1 nil))) (cdr-safe (assoc usemap w3-imagemaps))))) -(defun w3-image-widget-callback (widget widget-ignore &optional event) +(defun widget-image-callback (widget widget-ignore &optional event) (and (widget-get widget 'href) (w3-fetch (widget-get widget 'href)))) - -(defun w3-image-widget-value-create (widget) + +(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 (w3-image-widget-usemap widget)) + (client-map (widget-image-usemap widget)) (where (or (widget-get widget 'where) (point))) (glyph (widget-get widget 'glyph)) (alt (widget-get widget 'alt)) @@ -166,34 +190,39 @@ :tag (or (aref x 3) (aref x 2)) :value (aref x 2)))) client-map))) (setq real-widget - (apply 'widget-create 'choice + (apply 'widget-create 'menu-choice :tag (or (widget-get widget :tag) "Imagemap") :notify (widget-get widget :notify) - :value default options)))) + :action (widget-get widget :action) + :value default + :parent widget + :help-echo 'widget-image-summarize + options)))) ((and server-map (stringp href)) (setq real-widget - (widget-create 'push :tag alt - :delete 'widget-default-delete - :value href - :notify (widget-get widget :notify)))) + (widget-image-create-subwidget + 'push-button :tag alt + :delete 'widget-default-delete + :value href + :action (widget-get widget :action) + :notify (widget-get widget :notify)))) (href (setq real-widget - (widget-create 'push :tag (or alt "Image") - :value href - :delete 'widget-default-delete - :notify 'w3-image-widget-callback))) + (widget-image-create-subwidget + 'push-button :tag (or alt "Image") + :value href + :delete 'widget-default-delete + :action (widget-get widget :action) + :notify 'widget-image-callback))) (alt (setq real-widget - (widget-create 'push :tag alt :format "%[%t%]" - :delete 'widget-default-delete - :notify 'w3-image-widget-callback)))) + (widget-image-create-subwidget + 'push-button :tag alt :format "%[%t%]" + :delete 'widget-default-delete + :action (widget-get widget :action) + :notify 'widget-image-callback)))) (if (not real-widget) nil - (widget-put real-widget 'usemap (widget-get widget 'usemap)) - (widget-put real-widget 'href href) - (widget-put real-widget 'src (widget-get widget 'src)) - (widget-put real-widget 'ismap server-map) - (widget-put real-widget :parent widget) (widget-put widget :children (list real-widget)))) ;;; Actually use the image (let ((extent (or (widget-get widget 'extent) @@ -201,7 +230,7 @@ (set-extent-endpoints extent where where) (widget-put widget 'extent extent) (widget-put widget :children nil) - (set-extent-property extent 'keymap w3-image-widget-keymap) + (set-extent-property extent 'keymap widget-image-keymap) (set-extent-property extent 'begin-glyph glyph) (set-extent-property extent 'help-echo (cond ((and href (or client-map @@ -211,7 +240,7 @@ (t nil))) (set-glyph-property glyph 'widget widget))))) -(defun w3-image-widget-delete (widget) +(defun widget-image-delete (widget) ;; Remove the widget from the buffer (let ((extent (widget-get widget 'extent)) (child (car (widget-get widget :children)))) @@ -224,26 +253,62 @@ nil)))) (if (fboundp 'mouse-event-p) - (fset 'w3-mouse-event-p 'mouse-event-p) - (fset 'w3-mouse-event-p 'ignore)) + (fset 'widget-mouse-event-p 'mouse-event-p) + (fset 'widget-mouse-event-p 'ignore)) (if (fboundp 'glyphp) - (fset 'w3-glyphp 'glyphp) - (fset 'w3-glyphp 'ignore)) + (fset 'widget-glyphp 'glyphp) + (fset 'widget-glyphp 'ignore)) -(defun w3-image-widget-button-press (event) +(defun widget-image-button-press (event) (interactive "@e") - (let* ((glyph (and event (w3-mouse-event-p event) (event-glyph event))) + (let* ((glyph (and event (widget-mouse-event-p event) (event-glyph event))) (widget (and glyph (glyph-property glyph 'widget)))) - (w3-image-widget-notify widget widget event))) + (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 w3-image-widget-notify (widget widget-changed &optional event) +(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)) + (i nil)) + (cond + (usemap + (setq i (length usemap) + 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.")))) + +(defun widget-image-notify (widget widget-changed &optional event) ;; Happens when anything changes - (let* ((glyph (and event (w3-mouse-event-p event) (event-glyph event))) + (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 (w3-image-widget-usemap widget)) + (usemap (widget-image-usemap widget)) (href (widget-get widget 'href)) (value (widget-value widget)) )
--- a/lisp/w3/w3-xem20.el Mon Aug 13 09:05:44 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,76 +0,0 @@ -;;; w3-xem20.el,v --- XEmacs 20.0 with Mule specific functions -;; Author: MORIOKA Tomohiko -;; Created: 1996/06/14 16:44:59 -;; Version: 1.1 -;; Keywords: faces, help, i18n, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by MORIOKA Tomohiko -;;; -;;; This file is part of GNU Emacs. -;;; -;;; GNU Emacs is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Printing a mule buffer as postscript. Requires m2ps -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-m2ps-buffer (&optional buffer) - "Print a buffer by passing it through m2ps and lpr." - (or buffer (setq buffer (current-buffer))) - (let ((x (save-excursion (set-buffer buffer) tab-width))) - (save-excursion - (set-buffer (get-buffer-create " *mule-print*")) - (erase-buffer) - (insert-buffer buffer) - (if (/= x tab-width) - (progn - (setq tab-width x) - (message "Converting tabs") - (untabify (point-min) (point-max)))) - (setq file-coding-system *internal*) - (shell-command-on-region (point-min) (point-max) - "m2ps | lpr" t)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Multi-Lingual Emacs (MULE) Specific Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar attributed-region nil - "Bogus definition to get rid of compile-time warnings.") - -(defun w3-inhibit-code-conversion (proc buf) - "Inhibit Mule's subprocess PROC from code converting in BUF." - (save-excursion - (set-buffer buf) - (setq mc-flag nil)) - (set-process-input-coding-system proc url-mule-no-coding-system) - (set-process-output-coding-system proc url-mule-no-coding-system)) - -(defvar w3-mime-list-for-code-conversion - '("text/plain" "text/html") - "List of MIME types that require Mules' code conversion.") -(make-variable-buffer-local 'w3-mime-list-for-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)) - (let* ((c (detect-coding-region (point-min) (point-max))) - (code (or (and (listp c) (car c)) c))) - (setq mc-flag t) - (decode-coding-region (point-min) (point-max) code) - (set-file-coding-system code) - ))) - -(provide 'w3-xem20)
--- a/lisp/w3/w3-xemac.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3-xemac.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,11 +1,12 @@ ;;; w3-xemac.el --- XEmacs specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1996/07/21 06:38:10 -;; Version: 1.4 +;; Created: 1996/11/27 15:11:46 +;; Version: 1.7 ;; Keywords: faces, help, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Emacs. ;;; @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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) @@ -37,12 +39,13 @@ (let* ((pt (event-point e)) (good (eq (event-window e) (selected-window))) (widget (and good pt (number-or-marker-p pt) (widget-at pt))) - (link (and widget (widget-get widget 'href))) + (link (and widget (or (widget-get widget 'href) + (widget-get widget 'name)))) (form (and widget (widget-get widget 'w3-form-data))) (imag nil) ) (cond - (link (message "%s" link)) + (link (w3-widget-echo widget)) (form (cond ((eq 'submit (w3-form-element-type form))
--- a/lisp/w3/w3.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:06:37 2007 +0200 @@ -1,13 +1,14 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1996/08/19 03:30:47 -;; Version: 1.22 +;; Created: 1996/12/30 20:37:55 +;; Version: 1.48 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996 Free Software Foundation, Inc. ;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; 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 @@ -20,8 +21,9 @@ ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; along with 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. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -67,7 +69,9 @@ ) -(load-library "w3-sysdp") +(require 'w3-sysdp) +(require 'mule-sysdp) + (or (featurep 'efs) (featurep 'efs-auto) (condition-case () @@ -75,9 +79,10 @@ (error nil))) (require 'cl) +(require 'css) (require 'w3-vars) (eval-and-compile - (require 'w3-draw)) + (require 'w3-display)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -286,11 +291,10 @@ (funcall view))) ((stringp view) (let ((fname (url-generate-unique-filename fmt)) - (proc nil) - (file-coding-system url-mule-no-coding-system)) + (proc nil)) (if (url-file-directly-accessible-p (url-view-url t)) (make-symbolic-link url-current-file fname t) - (write-region (point-min) (point-max) fname)) + (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)) @@ -323,9 +327,7 @@ (file-name-nondirectory (url-view-url t))))) (require-final-newline nil)) (set-buffer old-buff) - (let ((mc-flag t) - (file-coding-system url-mule-no-coding-system)) - (write-region (point-min) (point-max) file)) + (mule-write-region-no-coding-system (point-min) (point-max) file) (kill-buffer (current-buffer)))) (defun w3-build-url (protocol) @@ -386,6 +388,7 @@ is non-nil, then an HTML directory listing is created on the fly. Otherwise, dired-mode is used to visit the buffer." (interactive "FLocal file: ") + (setq fname (expand-file-name fname)) (if (not w3-setup-done) (w3-do-setup)) (w3-fetch (concat "file:" fname))) @@ -426,42 +429,29 @@ (defun w3-url-completion-function (string predicate function) (if (not w3-setup-done) (w3-do-setup)) (cond - ((null function) - (cond - ((get 'url-gethash 'sysdep-defined-this) - ;; Cheat! If we know that these are the sysdep-defined version - ;; of hashtables, they are an obarray. - (try-completion string url-global-history-hash-table predicate)) - ((url-hashtablep url-global-history-hash-table) - (let ((list nil)) - (url-maphash (function (lambda (key val) - (setq list (cons (cons (symbol-name key) val) - list)))) - url-global-history-hash-table) - (try-completion string (nreverse list) predicate))) - (t nil))) + ((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) - (cond - ((get 'url-gethash 'sysdep-defined-this) - ;; Cheat! If we know that these are the sysdep-defined version - ;; of hashtables, they are an obarray. - (all-completions string url-global-history-hash-table predicate)) - ((url-hashtablep url-global-history-hash-table) - (let ((stub (concat "^" (regexp-quote string))) - (retval nil)) - (url-maphash - (function - (lambda (url time) - (setq url (symbol-name url)) - (if (string-match stub url) - (setq retval (cons url retval))))) - url-global-history-hash-table) - retval)) - (t nil))) + (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-hashtablep url-global-history-hash-table) - (url-gethash string url-global-history-hash-table) - t)))) + (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) @@ -540,12 +530,14 @@ (not (funcall url-confirmation-func (format "Reuse URL in buffer %s? " (buffer-name buf))))))) - (let ((cached (url-retrieve url))) + (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 (string-match "^http:" url) + ((and url-be-asynchronous (not cached)) (save-excursion (set-buffer url-working-buffer) @@ -554,7 +546,8 @@ (setq w3-current-last-buffer lastbuf))) (t (w3-add-urls-to-history x url) - (w3-sentinel lastbuf))))) + (w3-sentinel lastbuf) + )))) (if w3-track-last-buffer (setq w3-last-buffer buf)) (let ((w3-notify (if (memq w3-notify '(newframe bully @@ -682,7 +675,8 @@ url-current-mime-headers)) (and (member url-current-type '("file" "ftp")) (nth 5 (url-file-attributes url))))) - (hdrs url-current-mime-headers)) + (hdrs url-current-mime-headers) + (info w3-current-metainfo)) (set-buffer (get-buffer-create url-working-buffer)) (setq url-current-can-be-cached nil url-current-type "about" @@ -698,21 +692,19 @@ " <title>Document Information</title>\n" " </head>\n" " <body\n" - " <h1 align=\"center\">Document Information</h1>\n" - " <hr>\n" - " <pre>\n" - " Title: " title "\n" - " Location: " url "\n" - " Last Modified: " (or lastmod "None Given") "\n" - " </pre>\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>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 "%%%ds: %%s" maxlength))) - (insert " <hr label=\" MetaInformation \" textalign=\"left\">\n" - " <pre>\n" + (fmtstring (format " <tr><td align=right>%%%ds:</td><td>%%s</td></tr>" maxlength))) + (insert " <tr><th>MetaInformation</th></tr>\n" (mapconcat (function (lambda (x) @@ -725,36 +717,27 @@ (sort hdrs (function (lambda (x y) (string-lessp (car x) (car y))))) - "\n") - " </pre>\n"))) - (if cur-links - (while cur-links - (let* ((tmp (car cur-links)) - (label (car tmp)) - (nodes (cdr tmp)) - (links nil) - (maxlength (car (sort (mapcar - (function (lambda (x) - (length (car x)))) - nodes) - '>))) - (fmtstring (format "%%%ds: %%s" maxlength))) - (insert " \n" - " <hr width=\"50%\" label=\" " - label " \" align=\"left\" textalign=\"left\">\n" - " <pre>\n") - (while nodes - (setq label (car (car nodes)) - links (cdr (car nodes)) - nodes (cdr nodes)) - (while links - (insert (format " %15s -- <a href=\"%s\">%s</a>\n" - label (car links) (car links))) - (setq links (cdr links) - label ""))) - (insert " </pre>\n")) - (setq cur-links (cdr cur-links)))) - (insert " </body>\n" + "\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>Miscellaneous Variables</th></tr>\n") + (while info + (insert (format fmtstring (capitalize (caar info)) + (cdar info)) "\n") + (setq info (cdr info)) + ) + ) + ) + (insert " </table>\n" + " </body>\n" "</html>\n"))))) (defun w3-truncate-menu-item (string) @@ -942,7 +925,7 @@ url-setup-done nil w3-hotlist nil url-mime-accept-string nil) - (let ((x '(w3 w3-mule w3-e19 w3-xem20 mm url w3-xemac w3-toolbar font))) + (let ((x '(w3 mule-sysdp w3-e19 mm url w3-xemac w3-toolbar font))) (while x (setq features (delq (car x) features) x (cdr x))) @@ -1008,10 +991,8 @@ (concat "Source for " url " found, reuse? ")) (w3-notify-when-ready (get-buffer url))))) (if (not url) nil - (setq face (and w3-current-stylesheet (cdr (w3-face-for-element)))) (set-buffer (get-buffer-create tmp)) (insert src) - (put-text-property (point-min) (point-max) 'face face) (put-text-property (point-min) (point-max) 'w3-base url) (goto-char (point-min)) (setq buffer-file-truename nil @@ -1299,6 +1280,18 @@ (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)) + (let* ((c (mule-detect-coding-version (point-min) (point-max))) + (code (or (and (listp c) (car c)) c))) + (mule-code-convert-region (point-min) (point-max) code)))) + (defun w3-sentinel (&optional proc string) (set-buffer url-working-buffer) (if (or (stringp proc) @@ -1316,18 +1309,12 @@ (url-file-extension url-current-file)) "text/html"))))) - (let ((x (w3-build-continuation)) - (done-mule-conversion nil)) + (if (not (string-match "^www:" (or (url-view-url t) ""))) + (w3-convert-code-for-mule url-current-mime-type)) + + (let ((x (w3-build-continuation))) (while x - (if (and (featurep 'mule) (not (eq 'url-uncompress (car x))) - (not done-mule-conversion)) - (progn - (if (string-match "^www:" (url-view-url t)) - (setq w3-mime-list-for-code-conversion nil)) - (w3-convert-code-for-mule url-current-mime-type) - (setq done-mule-conversion t))) - (funcall (car x)) - (setq x (cdr x))))) + (funcall (pop x))))) (defun w3-show-history-list () "Format the url-history-list prettily and show it to the user" @@ -1357,8 +1344,11 @@ (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)) @@ -1519,12 +1509,11 @@ (w3-running-FSF19 (require 'w3-e19)) (t (error "Unable to determine the capabilities of this emacs."))) - (cond - ((boundp 'MULE) - (require 'w3-mule)) - ((featurep 'mule) - (require 'w3-xem20) - )) + (if (featurep 'emacspeak) + (condition-case () + (progn + (require 'dtk-css-speech) + (require 'w3-speak)))) (condition-case () (require 'w3-site-init) (error nil))) @@ -1578,25 +1567,23 @@ (defun w3-search () "Perform a search, if this is a searchable index." (interactive) - (or w3-current-isindex - (error "Not a searchable index (via <isindex>)")) (let* (querystring ; The string to send to the server (data (cond ((null w3-current-isindex) - (let ((rels (mapcar - (function - (lambda (data) - (if (assoc "rel" data) data))) - w3-current-links)) - val) + (let ((rels (cdr-safe (assq 'rel w3-current-links))) + val cur) (while rels - (if (string-match "useindex" - (or (cdr (assoc "rel" (car rels))) "")) - (setq val (cdr (assoc "href" (car 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)) - (setq rels (cdr rels))) - (cons val "Search on (+ separates keywords): "))) + ) + (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) @@ -1742,7 +1729,7 @@ "<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") - (url-maphash + (cl-maphash (function (lambda (url desc) (insert (format "\t\t\t\t<li> <a href=\"%s\">%s</a>\n" @@ -1965,7 +1952,7 @@ (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 (concat "mailto:" found))) + (setq found (list (concat "mailto:" found)))) (while (and x (not found)) (setq y (car x) x (cdr x) @@ -2049,16 +2036,19 @@ BUFFER, the end of BUFFER, nil, and (current-buffer), respectively." (let ((cur (point-min)) (widget nil) - (url nil)) + (parent nil)) (while (setq cur (next-single-property-change cur 'button)) - (setq widget (widget-at cur)) + (setq widget (widget-at cur) + parent (and widget (widget-get widget :parent))) ;; Check to see if its a push widget, its got the correct callback, ;; and actually has a URL. Remember the url as a side-effect of the ;; test for later use. - (if (and (eq (car widget) 'push) - (eq (widget-get widget :notify) 'w3-follow-hyperlink) - (setq url (widget-get widget 'href))) - (funcall function widget maparg))))) + (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) @@ -2097,7 +2087,7 @@ (setq w3-user-stylesheet nil w3-face-cache nil) (w3-find-default-stylesheets) - (w3-style-post-process-stylesheet w3-user-stylesheet)) + ) (defun w3-find-default-stylesheets () (let* ((lightp (w3-color-light-p 'default)) @@ -2106,6 +2096,7 @@ (directories (list data-directory (concat data-directory "w3/") + (expand-file-name "../../w3" data-directory) (file-name-directory (locate-library "w3")) w3-configuration-directory)) (total-found 0) @@ -2135,10 +2126,8 @@ (not (file-directory-p cur)) cur)) (if found (setq total-found (1+ total-found) - w3-user-stylesheet (car - (w3-style-parse-css - (concat "file:" cur) nil - w3-user-stylesheet))))) + 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 @@ -2304,12 +2293,7 @@ (defun w3-mark-link-as-followed (ext dat) ;; Mark a link as followed - (let* ((st (w3-zone-start ext)) - (nd (w3-zone-end ext)) - (tag 'a) - (args (list (cons 'class "visited"))) - (face (cdr (w3-face-for-element)))) - (w3-add-zone st nd face dat t))) + (message "Reimplement w3-mark-link-as-followed")) (defun w3-only-links () (let* (result temp) @@ -2330,8 +2314,10 @@ (file-name-handler-alist nil) (write-file-hooks nil) (write-contents-hooks nil) - (mc-flag t) - (file-coding-system url-mule-no-coding-system)) + (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) @@ -2388,6 +2374,19 @@ (t (w3-fetch href))))) +;;; FIXME! Need to rewrite these so that we can pass a predicate to +(defun w3-widget-forward (arg) + "Move point to the next field or button. +With optional ARG, move across that many fields." + (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) @@ -2401,8 +2400,8 @@ (widget-get link-at-point 'href) (w3-fix-spaces (buffer-substring - (car (widget-get link-at-point 'title)) - (cdr (widget-get link-at-point 'title)))))) + (widget-get link-at-point :from) + (widget-get link-at-point :to))))) (w3-map-links (function (lambda (widget arg) (setq links-alist (cons @@ -2436,17 +2435,6 @@ (w3-follow-link) (w3-fetch (cdr (assoc choice links-alist)))))) -(defun w3-widget-motion-hook (widget) - (assert widget nil "Bad data to w3-widget-motion-hook! Bad hook bad!") - (case w3-echo-link - (text - (message "%s" (w3-fix-spaces (buffer-substring (widget-get widget :from) - (widget-get widget :to))))) - (url - (if (widget-get widget 'href) - (message "%s" (widget-get widget 'href)))) - (otherwise nil))) - (defun w3-mode () "Mode for viewing HTML documents. If called interactively, will display the current buffer as HTML. @@ -2466,8 +2454,6 @@ (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp) (w3-mode-version-specifics) (w3-menu-install-menus) - (make-local-hook 'widget-motion-hook) - (add-hook 'widget-motion-hook 'w3-widget-motion-hook) (run-hooks 'w3-mode-hook) (widget-setup) (setq url-current-passwd-count 0 @@ -2477,9 +2463,8 @@ (require 'mm) (require 'url) -(require 'url-hash) (require 'w3-parse) -(require 'w3-draw) +(require 'w3-display) (require 'w3-auto) (require 'w3-emulate) (require 'w3-menu)
--- a/lisp/w3/widget-edit.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/widget-edit.el Mon Aug 13 09:06:37 2007 +0200 @@ -3,8 +3,9 @@ ;; Copyright (C) 1996 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> -;; Keywords: help, extensions, faces, hypermedia -;; Version: 0.4 +;; Keywords: extensions +;; Version: 1.13 +;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: ;; @@ -14,6 +15,46 @@ (require 'widget) (require 'cl) +(autoload 'pp-to-string "pp") +(autoload 'Info-goto-node "info") + +(if (string-match "XEmacs" emacs-version) + ;; XEmacs spell `intangible' as `atomic'. + (defun widget-make-intangible (from to side) + "Make text between FROM and TO atomic with regard to movement. +Third argument should be `start-open' if it should be sticky to the rear, +and `end-open' if it should sticky to the front." + (require 'atomic-extents) + (let ((ext (make-extent from to))) + ;; XEmacs doesn't understant different kinds of read-only, so + ;; we have to use extents instead. + (put-text-property from to 'read-only nil) + (set-extent-property ext 'read-only t) + (set-extent-property ext 'start-open nil) + (set-extent-property ext 'end-open nil) + (set-extent-property ext side t) + (set-extent-property ext 'atomic t))) + (defun widget-make-intangible (from to size) + "Make text between FROM and TO intangible." + (put-text-property from to 'intangible 'front))) + +;; The following should go away when bundled with Emacs. +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + + (unless (and (featurep 'custom) (fboundp 'custom-declare-variable)) + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) nil) + (defmacro defcustom (&rest args) nil) + (defmacro defface (&rest args) nil) + (when (fboundp 'copy-face) + (copy-face 'default 'widget-documentation-face) + (copy-face 'bold 'widget-button-face) + (copy-face 'italic 'widget-field-face)) + (defvar widget-mouse-face 'highlight) + (defvar widget-menu-max-size 40))) ;;; Compatibility. @@ -26,28 +67,46 @@ into the buffer visible in the event's window." (posn-point (event-start event)))) -(or (fboundp 'set-keymap-parent) - ;; Xemacs function missing in Emacs. - ;; Definition stolen from `lucid.el'. - (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))))) +;;; Customization. + +(defgroup widgets nil + "Customization support for the Widget Library." + :link '(custom-manual "(widget)Top") + :link '(url-link :tag "Development Page" + "http://www.dina.kvl.dk/~abraham/custom/") + :prefix "widget-" + :group 'emacs) + +(defface widget-documentation-face '((t ())) + "Face used for documentation text." + :group 'widgets) + +(defface widget-button-face '((t (:bold t))) + "Face used for widget buttons." + :group 'widgets) -;;; Customization. -;; -;; These should be specified with the custom package. +(defcustom widget-mouse-face 'highlight + "Face used for widget buttons when the mouse is above them." + :type 'face + :group 'widgets) -(defvar widget-button-face 'bold) -(defvar widget-mouse-face 'highlight) -(defvar widget-field-face 'italic) +(defface widget-field-face '((((type x) + (class grayscale color) + (background light)) + (:background "light gray")) + (((type x) + (class grayscale color) + (background dark)) + (:background "dark gray")) + (t + (:italic t))) + "Face used for editable fields." + :group 'widgets) -(defvar widget-motion-hook nil - "*Hook to be run after widget traversal (via `widget-forward|backward'). -The hooks will all be called with on argument - the widget that was just -selected.") +(defcustom widget-menu-max-size 40 + "Largest number of items allowed in a popup-menu. +Larger menus are read through the minibuffer." + :type 'integer) ;;; Utility functions. ;; @@ -80,6 +139,43 @@ (buffer-disable-undo (current-buffer)) (buffer-enable-undo)) +(defun widget-choose (title items &optional event) + "Choose an item from a list. + +First argument TITLE is the name of the list. +Second argument ITEMS is an alist (NAME . VALUE). +Optional third argument EVENT is an input event. + +The user is asked to choose between each NAME from the items alist, +and the VALUE of the chosen element will be returned. If EVENT is a +mouse event, and the number of elements in items is less than +`widget-menu-max-size', a popup menu will be used, otherwise the +minibuffer." + (cond ((and (< (length items) widget-menu-max-size) + event (fboundp 'x-popup-menu) window-system) + ;; We are in Emacs-19, pressed by the mouse + (x-popup-menu event + (list title (cons "" items)))) + ((and (< (length items) widget-menu-max-size) + event (fboundp 'popup-menu) window-system) + ;; We are in XEmacs, pressed by the mouse + (let ((val (get-popup-menu-response + (cons "" + (mapcar + (function + (lambda (x) + (vector (car x) (list (car x)) t))) + items))))) + (setq val (and val + (listp (event-object val)) + (stringp (car-safe (event-object val))) + (car (event-object val)))) + (cdr (assoc val items)))) + (t + (cdr (assoc (completing-read (concat title ": ") + items nil t) + items))))) + ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. @@ -92,46 +188,81 @@ ;; Default properties. (add-text-properties from to (list 'read-only t 'front-sticky t + 'start-open t + 'end-open t 'rear-nonsticky nil))) (defun widget-specify-field (widget from to) ;; Specify editable button for WIDGET between FROM and TO. (widget-specify-field-update widget from to) - ;; Make it possible to edit both end of the field. + + ;; Make it possible to edit the front end of the field. (add-text-properties (1- from) from (list 'rear-nonsticky t 'end-open t 'invisible t)) - (add-text-properties to (1+ to) (list 'font-sticky nil - 'start-open t))) + (when (or (string-match "\\(.\\|\n\\)%v" (widget-get widget :format)) + (widget-get widget :hide-front-space)) + ;; WARNING: This is going to lose horrible if the character just + ;; before the field can be modified (e.g. if it belongs to a + ;; choice widget). We try to compensate by checking the format + ;; string, and hope the user hasn't changed the :create method. + (widget-make-intangible (- from 2) from 'end-open)) + + ;; Make it possible to edit back end of the field. + (add-text-properties to (1+ to) (list 'front-sticky nil + 'read-only t + 'start-open t)) + + (cond ((widget-get widget :size) + (put-text-property to (1+ to) 'invisible t) + (when (or (string-match "%v\\(.\\|\n\\)" (widget-get widget :format)) + (widget-get widget :hide-rear-space)) + ;; WARNING: This is going to lose horrible if the character just + ;; after the field can be modified (e.g. if it belongs to a + ;; choice widget). We try to compensate by checking the format + ;; string, and hope the user hasn't changed the :create method. + (widget-make-intangible to (+ to 2) 'start-open))) + ((string-match "XEmacs" emacs-version) + ;; XEmacs does not allow you to insert before a read-only + ;; character, even if it is start.open. + ;; XEmacs does allow you to delete an read-only extent, so + ;; making the terminating newline read only doesn't help. + ;; I tried putting an invisible intangible read-only space + ;; before the newline, which gave really weird effects. + ;; So for now, we just have trust the user not to delete the + ;; newline. + (put-text-property to (1+ to) 'read-only nil)))) (defun widget-specify-field-update (widget from to) ;; Specify editable button for WIDGET between FROM and TO. (let ((map (widget-get widget :keymap)) (face (or (widget-get widget :value-face) - widget-field-face))) - (add-text-properties from to (list 'field widget + 'widget-field-face))) + (set-text-properties from to (list 'field widget 'read-only nil + 'keymap map 'local-map map - 'keymap map - 'face widget-field-face)))) + 'face face)) + (unless (widget-get widget :size) + (put-text-property to (1+ to) 'face face)))) (defun widget-specify-button (widget from to) ;; Specify button for WIDGET between FROM and TO. - (let ((face (or (widget-get widget :button-face) - widget-button-face))) + (let ((face (widget-apply widget :button-face-get))) (add-text-properties from to (list 'button widget 'mouse-face widget-mouse-face + 'start-open t + 'end-open t 'face face)))) (defun widget-specify-doc (widget from to) ;; Specify documentation for WIDGET between FROM and TO. - (put-text-property from to 'widget-doc widget)) - + (add-text-properties from to (list 'widget-doc widget + 'face 'widget-documentation-face))) (defmacro widget-specify-insert (&rest form) ;; Execute FORM without inheriting any text properties. - (` - (save-restriction + `(save-restriction (let ((inhibit-read-only t) result after-change-functions) @@ -139,11 +270,11 @@ (narrow-to-region (- (point) 2) (point)) (widget-specify-none (point-min) (point-max)) (goto-char (1+ (point-min))) - (setq result (progn (,@ form))) + (setq result (progn ,@form)) (delete-region (point-min) (1+ (point-min))) (delete-region (1- (point-max)) (point-max)) (goto-char (point-max)) - result)))) + result))) ;;; Widget Properties. @@ -186,16 +317,18 @@ :value-set (widget-apply widget :value-to-internal value))) -(defun widget-match-inline (widget values) - ;; Match the head of values. +(defun widget-match-inline (widget vals) + ;; In WIDGET, match the start of VALS. (cond ((widget-get widget :inline) - (widget-apply widget :match-inline values)) - ((widget-apply widget :match (car values)) - (cons (list (car values)) (cdr values))) + (widget-apply widget :match-inline vals)) + ((and vals + (widget-apply widget :match (car vals))) + (cons (list (car vals)) (cdr vals))) (t nil))) ;;; Creating Widgets. +;;;###autoload (defun widget-create (type &rest args) "Create widget of TYPE. The optional ARGS are additional keyword arguments." @@ -203,6 +336,42 @@ (widget-apply widget :create) widget)) +(defun widget-create-child-and-convert (parent type &rest args) + "As part of the widget PARENT, create a child widget TYPE. +The child is converted, using the keyword arguments ARGS." + (let ((widget (apply 'widget-convert type args))) + (widget-put widget :parent parent) + (unless (widget-get widget :indent) + (widget-put widget :indent (+ (or (widget-get parent :indent) 0) + (or (widget-get widget :extra-offset) 0) + (widget-get parent :offset)))) + (widget-apply widget :create) + widget)) + +(defun widget-create-child (parent type) + "Create widget of TYPE." + (let ((widget (copy-list type))) + (widget-put widget :parent parent) + (unless (widget-get widget :indent) + (widget-put widget :indent (+ (or (widget-get parent :indent) 0) + (or (widget-get widget :extra-offset) 0) + (widget-get parent :offset)))) + (widget-apply widget :create) + widget)) + +(defun widget-create-child-value (parent type value) + "Create widget of TYPE with value VALUE." + (let ((widget (copy-list type))) + (widget-put widget :value (widget-apply widget :value-to-internal value)) + (widget-put widget :parent parent) + (unless (widget-get widget :indent) + (widget-put widget :indent (+ (or (widget-get parent :indent) 0) + (or (widget-get widget :extra-offset) 0) + (widget-get parent :offset)))) + (widget-apply widget :create) + widget)) + +;;;###autoload (defun widget-delete (widget) "Delete WIDGET." (widget-apply widget :delete)) @@ -232,7 +401,7 @@ ;; Then Convert the widget. (setq type widget) (while type - (let ((convert-widget (widget-get type :convert-widget))) + (let ((convert-widget (plist-get (cdr type) :convert-widget))) (if convert-widget (setq widget (funcall convert-widget widget)))) (setq type (get (car type) 'widget-type))) @@ -244,6 +413,11 @@ (widget-put widget next (nth 1 keys)) (setq keys (nthcdr 2 keys))) (setq keys nil)))) + ;; Convert the :value to internal format. + (if (widget-member widget :value) + (let ((value (widget-get widget :value))) + (widget-put widget + :value (widget-apply widget :value-to-internal value)))) ;; Return the newly create widget. widget)) @@ -268,8 +442,11 @@ (define-key widget-keymap "\t" 'widget-forward) (define-key widget-keymap "\M-\t" 'widget-backward) (define-key widget-keymap [(shift tab)] 'widget-backward) + (define-key widget-keymap [(shift tab)] 'widget-backward) + (define-key widget-keymap [backtab] 'widget-backward) (if (string-match "XEmacs" (emacs-version)) (define-key widget-keymap [button2] 'widget-button-click) + (define-key widget-keymap [menu-bar] 'nil) (define-key widget-keymap [mouse-2] 'widget-button-click)) (define-key widget-keymap "\C-m" 'widget-button-press)) @@ -356,10 +533,7 @@ (goto-char (max button field))) (button (goto-char button)) (field (goto-char field))))) - (run-hook-with-args 'widget-motion-hook (or - (get-text-property (point) 'button) - (get-text-property (point) 'field))) - ) + (widget-echo-help (point))) (defun widget-backward (arg) "Move point to the previous field or button. @@ -380,6 +554,7 @@ (defun widget-setup () "Setup current buffer so editing string widgets works." (let ((inhibit-read-only t) + (after-change-functions nil) field) (while widget-field-new (setq field (car widget-field-new) @@ -430,6 +605,7 @@ (inhibit-read-only t)) (cond ((null field)) ((not (eq field (widget-field-find to))) + (debug) (message "Error: `widget-after-change' called on two fields")) (t (let ((size (widget-get field :size))) @@ -441,7 +617,10 @@ ;; Field too small. (save-excursion (goto-char end) - (insert-char ?\ (- (+ begin size) end)))) + (insert-char ?\ (- (+ begin size) end)) + (widget-specify-field-update field + begin + (+ begin size)))) ((> (- end begin) size) ;; Field too large and (if (or (< (point) (+ begin size)) @@ -459,6 +638,22 @@ (widget-apply field :notify field)))) (error (debug)))) +;;; Widget Functions +;; +;; These functions are used in the definition of multiple widgets. + +(defun widget-children-value-delete (widget) + "Delete all :children and :buttons in WIDGET." + (mapcar 'widget-delete (widget-get widget :children)) + (widget-put widget :children nil) + (mapcar 'widget-delete (widget-get widget :buttons)) + (widget-put widget :buttons nil)) + +(defun widget-types-convert-widget (widget) + "Convert :args as widget types in WIDGET." + (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args))) + widget) + ;;; The `default' Widget. (define-widget 'default nil @@ -466,12 +661,15 @@ :value-to-internal (lambda (widget value) value) :value-to-external (lambda (widget value) value) :create 'widget-default-create + :indent nil + :offset 0 :format-handler 'widget-default-format-handler + :button-face-get 'widget-default-button-face-get :delete 'widget-default-delete :value-set 'widget-default-value-set :value-inline 'widget-default-value-inline :menu-tag-get 'widget-default-menu-tag-get - :validate (lambda (widget) t) + :validate (lambda (widget) nil) :action 'widget-default-action :notify 'widget-default-notify) @@ -496,6 +694,10 @@ (setq button-begin (point))) ((eq escape ?\]) (setq button-end (point))) + ((eq escape ?n) + (when (widget-get widget :indent) + (insert "\n") + (insert-char ? (widget-get widget :indent)))) ((eq escape ?t) (if tag (insert tag) @@ -532,8 +734,49 @@ (widget-put widget :to to)))) (defun widget-default-format-handler (widget escape) - ;; By default unknown escapes are errors. - (error "Unknown escape `%c'" escape)) + ;; We recognize the %h escape by default. + (let* ((buttons (widget-get widget :buttons)) + (doc-property (widget-get widget :documentation-property)) + (doc-try (cond ((widget-get widget :doc)) + ((symbolp doc-property) + (documentation-property (widget-get widget :value) + doc-property)) + (t + (funcall doc-property (widget-get widget :value))))) + (doc-text (and (stringp doc-try) + (> (length doc-try) 1) + doc-try))) + (cond ((eq escape ?h) + (when doc-text + (and (eq (preceding-char) ?\n) + (widget-get widget :indent) + (insert-char ? (widget-get widget :indent))) + ;; The `*' in the beginning is redundant. + (when (eq (aref doc-text 0) ?*) + (setq doc-text (substring doc-text 1))) + ;; Get rid of trailing newlines. + (when (string-match "\n+\\'" doc-text) + (setq doc-text (substring doc-text 0 (match-beginning 0)))) + (push (if (string-match "\n." doc-text) + ;; Allow multiline doc to be hiden. + (widget-create-child-and-convert + widget 'widget-help + :doc (progn + (string-match "\\`.*" doc-text) + (match-string 0 doc-text)) + :widget-doc doc-text + "?") + ;; A single line is just inserted. + (widget-create-child-and-convert + widget 'item :format "%d" :doc doc-text nil)) + buttons))) + (t + (error "Unknown escape `%c'" escape))) + (widget-put widget :buttons buttons))) + +(defun widget-default-button-face-get (widget) + ;; Use :button-face or widget-button-face + (or (widget-get widget :button-face) 'widget-button-face)) (defun widget-default-delete (widget) ;; Remove widget from the buffer. @@ -590,10 +833,11 @@ :format "%t\n") (defun widget-item-convert-widget (widget) - ;; Initialize :value and :tag from :args in WIDGET. + ;; Initialize :value from :args in WIDGET. (let ((args (widget-get widget :args))) (when args - (widget-put widget :value (car args)) + (widget-put widget :value (widget-apply widget + :value-to-internal (car args))) (widget-put widget :args nil))) widget) @@ -623,9 +867,9 @@ ;; Items are simple. (widget-get widget :value)) -;;; The `push' Widget. +;;; The `push-button' Widget. -(define-widget 'push 'item +(define-widget 'push-button 'item "A pushable button." :format "%[[%t]%]") @@ -635,39 +879,80 @@ "An embedded link." :format "%[_%t_%]") -;;; The `field' Widget. +;;; The `info-link' Widget. + +(define-widget 'info-link 'link + "A link to an info file." + :action 'widget-info-link-action) + +(defun widget-info-link-action (widget &optional event) + "Open the info node specified by WIDGET." + (Info-goto-node (widget-value widget))) + +;;; The `url-link' Widget. -(define-widget 'field 'default +(define-widget 'url-link 'link + "A link to an www page." + :action 'widget-url-link-action) + +(defun widget-url-link-action (widget &optional event) + "Open the url specified by WIDGET." + (require 'browse-url) + (funcall browse-url-browser-function (widget-value widget))) + +;;; The `editable-field' Widget. + +(define-widget 'editable-field 'default "An editable text field." :convert-widget 'widget-item-convert-widget :format "%v" :value "" - :tag "field" + :action 'widget-field-action :value-create 'widget-field-value-create :value-delete 'widget-field-value-delete :value-get 'widget-field-value-get :match 'widget-field-match) +;; History of field minibuffer edits. +(defvar widget-field-history nil) + +(defun widget-field-action (widget &optional event) + ;; Edit the value in the minibuffer. + (let ((tag (widget-apply widget :menu-tag-get)) + (invalid (widget-apply widget :validate))) + (when invalid + (error (widget-get invalid :error))) + (widget-value-set widget + (widget-apply widget + :value-to-external + (read-string (concat tag ": ") + (widget-apply + widget + :value-to-internal + (widget-value widget)) + 'widget-field-history))) + (widget-apply widget :notify widget event) + (widget-setup))) + (defun widget-field-value-create (widget) ;; Create an editable text field. (insert " ") (let ((size (widget-get widget :size)) (value (widget-get widget :value)) (from (point))) - (if (null size) - (insert value) - (insert value) - (if (< (length value) size) - (insert-char ?\ (- size (length value))))) + (insert value) + (and size + (< (length value) size) + (insert-char ?\ (- size (length value)))) (unless (memq widget widget-field-list) (setq widget-field-new (cons widget widget-field-new))) - (widget-put widget :value-from (copy-marker from)) - (set-marker-insertion-type (widget-get widget :value-from) t) (widget-put widget :value-to (copy-marker (point))) (set-marker-insertion-type (widget-get widget :value-to) nil) (if (null size) (insert ?\n) - (insert ?\ )))) + (insert ?\ )) + (widget-put widget :value-from (copy-marker from)) + (set-marker-insertion-type (widget-get widget :value-from) t))) (defun widget-field-value-delete (widget) ;; Remove the widget from the list of active editing fields. @@ -678,32 +963,43 @@ (defun widget-field-value-get (widget) ;; Return current text in editing field. (let ((from (widget-get widget :value-from)) - (to (widget-get widget :value-to))) + (to (widget-get widget :value-to)) + (size (widget-get widget :size)) + (old (current-buffer))) (if (and from to) (progn + (set-buffer (marker-buffer from)) (setq from (1+ from) to (1- to)) - (while (and (> to from) + (while (and size + (not (zerop size)) + (> to from) (eq (char-after (1- to)) ?\ )) (setq to (1- to))) - (buffer-substring-no-properties from to)) + (prog1 (buffer-substring-no-properties from to) + (set-buffer old))) (widget-get widget :value)))) (defun widget-field-match (widget value) ;; Match any string. (stringp value)) -;;; The `choice' Widget. +;;; The `text' Widget. + +(define-widget 'text 'editable-field + "A multiline text area.") -(define-widget 'choice 'default +;;; The `menu-choice' Widget. + +(define-widget 'menu-choice 'default "A menu of options." - :convert-widget 'widget-choice-convert-widget + :convert-widget 'widget-types-convert-widget :format "%[%t%]: %v" + :case-fold t :tag "choice" - :inline t - :void '(item "void") + :void '(item :format "invalid (%t)\n") :value-create 'widget-choice-value-create - :value-delete 'widget-radio-value-delete + :value-delete 'widget-children-value-delete :value-get 'widget-choice-value-get :value-inline 'widget-choice-value-inline :action 'widget-choice-action @@ -712,11 +1008,6 @@ :match 'widget-choice-match :match-inline 'widget-choice-match-inline) -(defun widget-choice-convert-widget (widget) - ;; Expand type args into widget objects. - (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args))) - widget) - (defun widget-choice-value-create (widget) ;; Insert the first choice that matches the value. (let ((value (widget-get widget :value)) @@ -726,17 +1017,15 @@ (setq current (car args) args (cdr args)) (when (widget-apply current :match value) - (widget-put widget :children (list (widget-create current - :parent widget - :value value))) + (widget-put widget :children (list (widget-create-child-value + widget current value))) (widget-put widget :choice current) (setq args nil current nil))) (when current (let ((void (widget-get widget :void))) - (widget-put widget :children (list (widget-create void - :parent widget - :value value))) + (widget-put widget :children (list (widget-create-child-and-convert + widget void :value value))) (widget-put widget :choice void))))) (defun widget-choice-value-get (widget) @@ -752,7 +1041,14 @@ (let ((args (widget-get widget :args)) (old (widget-get widget :choice)) (tag (widget-apply widget :menu-tag-get)) + (completion-ignore-case (widget-get widget :case-fold)) current choices) + ;; Remember old value. + (if (and old (not (widget-apply widget :validate))) + (let* ((external (widget-value widget)) + (internal (widget-apply old :value-to-internal external))) + (widget-put old :value internal))) + ;; Find new choice. (setq current (cond ((= (length args) 0) nil) @@ -771,32 +1067,13 @@ (cons (cons (widget-apply current :menu-tag-get) current) choices))) - (cond - ((and event (fboundp 'x-popup-menu) window-system) - ;; We are in Emacs-19, pressed by the mouse - (x-popup-menu event - (list tag (cons "" (reverse choices))))) - ((and event (fboundp 'popup-menu) window-system) - ;; We are in XEmacs, pressed by the mouse - (let ((val (get-popup-menu-response - (cons "" - (mapcar - (function - (lambda (x) - (vector (car x) (list (car x)) t))) - (reverse choices)))))) - (setq val (and val - (listp (event-object val)) - (stringp (car-safe (event-object val))) - (car (event-object val)))) - (cdr (assoc val choices)))) - (t - (cdr (assoc (completing-read (concat tag ": ") - choices nil t) - choices))))))) + (widget-choose tag (reverse choices) event)))) (when current - (widget-value-set widget (widget-value current)) - (widget-setup))) + (widget-value-set widget + (widget-apply current :value-to-external + (widget-get current :value))) + (widget-apply widget :notify widget event) + (widget-setup))) ;; Notify parent. (widget-apply widget :notify widget event) (widget-clear-undo)) @@ -832,22 +1109,26 @@ ;;; The `toggle' Widget. -(define-widget 'toggle 'choice +(define-widget 'toggle 'menu-choice "Toggle between two states." :convert-widget 'widget-toggle-convert-widget - :format "%[%v%]" + :format "%v" :on "on" :off "off") (defun widget-toggle-convert-widget (widget) ;; Create the types representing the `on' and `off' states. - (let ((args (widget-get widget :args)) - (on-type (widget-get widget :on-type)) + (let ((on-type (widget-get widget :on-type)) (off-type (widget-get widget :off-type))) (unless on-type - (setq on-type (list 'item :value t :tag (widget-get widget :on)))) + (setq on-type + (list 'choice-item + :value t + :match (lambda (widget value) value) + :tag (widget-get widget :on)))) (unless off-type - (setq off-type (list 'item :value nil :tag (widget-get widget :off)))) + (setq off-type + (list 'choice-item :value nil :tag (widget-get widget :off)))) (widget-put widget :args (list on-type off-type))) widget) @@ -856,19 +1137,21 @@ (define-widget 'checkbox 'toggle "A checkbox toggle." :convert-widget 'widget-item-convert-widget - :on-type '(item :format "[X]" t) - :off-type '(item :format "[ ]" nil)) + :on-type '(choice-item :format "%[[X]%]" t) + :off-type '(choice-item :format "%[[ ]%]" nil)) ;;; The `checklist' Widget. (define-widget 'checklist 'default "A multiple choice widget." - :convert-widget 'widget-choice-convert-widget + :convert-widget 'widget-types-convert-widget :format "%v" + :offset 4 :entry-format "%b %v" :menu-tag "checklist" + :greedy nil :value-create 'widget-checklist-value-create - :value-delete 'widget-radio-value-delete + :value-delete 'widget-children-value-delete :value-get 'widget-checklist-value-get :validate 'widget-checklist-validate :match 'widget-checklist-match @@ -886,6 +1169,9 @@ (defun widget-checklist-add-item (widget type chosen) ;; Create checklist item in WIDGET of type TYPE. ;; If the item is checked, CHOSEN is a cons whose cdr is the value. + (and (eq (preceding-char) ?\n) + (widget-get widget :indent) + (insert-char ? (widget-get widget :indent))) (widget-specify-insert (let* ((children (widget-get widget :children)) (buttons (widget-get widget :buttons)) @@ -900,21 +1186,18 @@ (cond ((eq escape ?%) (insert "%")) ((eq escape ?b) - (setq button (widget-create 'checkbox - :parent widget - :value (not (null chosen))))) + (setq button (widget-create-child-and-convert + widget 'checkbox :value (not (null chosen))))) ((eq escape ?v) (setq child (cond ((not chosen) - (widget-create type :parent widget)) + (widget-create-child widget type)) ((widget-get type :inline) - (widget-create type - :parent widget - :value (cdr chosen))) + (widget-create-child-value + widget type (cdr chosen))) (t - (widget-create type - :parent widget - :value (car (cdr chosen))))))) + (widget-create-child-value + widget type (car (cdr chosen))))))) (t (error "Unknown escape `%c'" escape))))) ;; Update properties. @@ -947,33 +1230,35 @@ values nil))))) (cons found rest))) -(defun widget-checklist-match-find (widget values) - ;; Find the values which match a type in the checklist. +(defun widget-checklist-match-find (widget vals) + ;; Find the vals which match a type in the checklist. ;; Return an alist of (TYPE MATCH). (let ((greedy (widget-get widget :greedy)) (args (copy-list (widget-get widget :args))) found) - (while values - (let ((answer (widget-checklist-match-up args values))) + (while vals + (let ((answer (widget-checklist-match-up args vals))) (cond (answer - (let ((vals (widget-match-inline answer values))) - (setq found (cons (cons answer (car vals)) found) - values (cdr vals) + (let ((match (widget-match-inline answer vals))) + (setq found (cons (cons answer (car match)) found) + vals (cdr match) args (delq answer args)))) (greedy - (setq values (cdr values))) + (setq vals (cdr vals))) (t - (setq values nil))))) + (setq vals nil))))) found)) -(defun widget-checklist-match-up (args values) - ;; Rerturn the first type from ARGS that matches VALUES. +(defun widget-checklist-match-up (args vals) + ;; Rerturn the first type from ARGS that matches VALS. (let (current found) (while (and args (null found)) (setq current (car args) args (cdr args) - found (widget-match-inline current values))) - (and found current))) + found (widget-match-inline current vals))) + (if found + current + nil))) (defun widget-checklist-value-get (widget) ;; The values of all selected items. @@ -1009,7 +1294,7 @@ (define-widget 'choice-item 'item "Button items that delegate action events to their parents." :action 'widget-choice-item-action - :format "%[%t%]\n") + :format "%[%t%] \n") (defun widget-choice-item-action (widget &optional event) ;; Tell parent what happened. @@ -1019,7 +1304,6 @@ (define-widget 'radio-button 'toggle "A radio button for use in the `radio' widget." - :format "%v" :notify 'widget-radio-button-notify :on-type '(choice-item :format "%[(*)%]" t) :off-type '(choice-item :format "%[( )%]" nil)) @@ -1028,16 +1312,17 @@ ;; Notify the parent. (widget-apply (widget-get widget :parent) :action widget event)) -;;; The `radio' Widget. +;;; The `radio-button-choice' Widget. -(define-widget 'radio 'default +(define-widget 'radio-button-choice 'default "Select one of multiple options." - :convert-widget 'widget-choice-convert-widget + :convert-widget 'widget-types-convert-widget + :offset 4 :format "%v" :entry-format "%b %v" :menu-tag "radio" :value-create 'widget-radio-value-create - :value-delete 'widget-radio-value-delete + :value-delete 'widget-children-value-delete :value-get 'widget-radio-value-get :value-inline 'widget-radio-value-inline :value-set 'widget-radio-value-set @@ -1050,17 +1335,18 @@ (defun widget-radio-value-create (widget) ;; Insert all values (let ((args (widget-get widget :args)) - (indent (widget-get widget :indent)) arg) (while args (setq arg (car args) args (cdr args)) - (widget-radio-add-item widget arg) - (and indent args (insert-char ?\ indent))))) + (widget-radio-add-item widget arg)))) (defun widget-radio-add-item (widget type) "Add to radio widget WIDGET a new radio button item of type TYPE." - (setq type (widget-convert type)) + ;; (setq type (widget-convert type)) + (and (eq (preceding-char) ?\n) + (widget-get widget :indent) + (insert-char ? (widget-get widget :indent))) (widget-specify-insert (let* ((value (widget-get widget :value)) (children (widget-get widget :children)) @@ -1078,15 +1364,14 @@ (cond ((eq escape ?%) (insert "%")) ((eq escape ?b) - (setq button (widget-create 'radio-button - :parent widget - :value (not (null chosen))))) + (setq button (widget-create-child-and-convert + widget 'radio-button + :value (not (null chosen))))) ((eq escape ?v) (setq child (if chosen - (widget-create type - :parent widget - :value value) - (widget-create type :parent widget)))) + (widget-create-child-value + widget type value) + (widget-create-child widget type)))) (t (error "Unknown escape `%c'" escape))))) ;; Update properties. @@ -1099,13 +1384,6 @@ (widget-put widget :children (nconc children (list child)))) child))) -(defun widget-radio-value-delete (widget) - ;; Delete the child widgets. - (mapcar 'widget-delete (widget-get widget :children)) - (widget-put widget :children nil) - (mapcar 'widget-delete (widget-get widget :buttons)) - (widget-put widget :buttons nil)) - (defun widget-radio-value-get (widget) ;; Get value of the child widget. (let ((chosen (widget-radio-chosen widget))) @@ -1188,8 +1466,8 @@ ;;; The `insert-button' Widget. -(define-widget 'insert-button 'push - "An insert button for the `repeat' widget." +(define-widget 'insert-button 'push-button + "An insert button for the `editable-list' widget." :tag "INS" :action 'widget-insert-button-action) @@ -1200,8 +1478,8 @@ ;;; The `delete-button' Widget. -(define-widget 'delete-button 'push - "A delete button for the `repeat' widget." +(define-widget 'delete-button 'push-button + "A delete button for the `editable-list' widget." :tag "DEL" :action 'widget-delete-button-action) @@ -1210,38 +1488,35 @@ (widget-apply (widget-get widget :parent) :delete-at (widget-get widget :widget))) -;;; The `repeat' Widget. +;;; The `editable-list' Widget. -(define-widget 'repeat 'default +(define-widget 'editable-list 'default "A variable list of widgets of the same type." - :convert-widget 'widget-choice-convert-widget + :convert-widget 'widget-types-convert-widget + :offset 12 :format "%v%i\n" - :format-handler 'widget-repeat-format-handler + :format-handler 'widget-editable-list-format-handler :entry-format "%i %d %v" - :menu-tag "repeat" - :value-create 'widget-repeat-value-create - :value-delete 'widget-radio-value-delete - :value-get 'widget-repeat-value-get - :validate 'widget-repeat-validate - :match 'widget-repeat-match - :match-inline 'widget-repeat-match-inline - :insert-before 'widget-repeat-insert-before - :delete-at 'widget-repeat-delete-at) + :menu-tag "editable-list" + :value-create 'widget-editable-list-value-create + :value-delete 'widget-children-value-delete + :value-get 'widget-editable-list-value-get + :validate 'widget-editable-list-validate + :match 'widget-editable-list-match + :match-inline 'widget-editable-list-match-inline + :insert-before 'widget-editable-list-insert-before + :delete-at 'widget-editable-list-delete-at) -(defun widget-repeat-format-handler (widget escape) +(defun widget-editable-list-format-handler (widget escape) ;; We recognize the insert button. (cond ((eq escape ?i) - (insert " ") - (backward-char 1) - (let* ((from (point)) - (button (widget-create (list 'insert-button - :parent widget)))) - (widget-specify-button button from (point))) - (forward-char 1)) + (and (widget-get widget :indent) + (insert-char ? (widget-get widget :indent))) + (widget-create-child-and-convert widget 'insert-button)) (t (widget-default-format-handler widget escape)))) -(defun widget-repeat-value-create (widget) +(defun widget-editable-list-value-create (widget) ;; Insert all values (let* ((value (widget-get widget :value)) (type (nth 0 (widget-get widget :args))) @@ -1252,21 +1527,23 @@ (while value (let ((answer (widget-match-inline type value))) (if answer - (setq children (cons (widget-repeat-entry-create - widget (if inlinep - (car answer) - (car (car answer)))) + (setq children (cons (widget-editable-list-entry-create + widget + (if inlinep + (car answer) + (car (car answer))) + t) children) value (cdr answer)) (setq value nil)))) (widget-put widget :children (nreverse children)))) -(defun widget-repeat-value-get (widget) +(defun widget-editable-list-value-get (widget) ;; Get value of the child widget. (apply 'append (mapcar (lambda (child) (widget-apply child :value-inline)) (widget-get widget :children)))) -(defun widget-repeat-validate (widget) +(defun widget-editable-list-validate (widget) ;; All the chilren must be valid. (let ((children (widget-get widget :children)) child found) @@ -1276,12 +1553,12 @@ found (widget-apply child :validate))) found)) -(defun widget-repeat-match (widget value) - ;; Value must be a list and all the members must match the repeat type. +(defun widget-editable-list-match (widget value) + ;; Value must be a list and all the members must match the type. (and (listp value) - (null (cdr (widget-repeat-match-inline widget value))))) + (null (cdr (widget-editable-list-match-inline widget value))))) -(defun widget-repeat-match-inline (widget value) +(defun widget-editable-list-match-inline (widget value) (let ((type (nth 0 (widget-get widget :args))) (ok t) found) @@ -1293,21 +1570,23 @@ (setq ok nil)))) (cons found value))) -(defun widget-repeat-insert-before (widget before) +(defun widget-editable-list-insert-before (widget before) ;; Insert a new child in the list of children. (save-excursion (let ((children (widget-get widget :children)) (inhibit-read-only t) after-change-functions) (cond (before - (goto-char (widget-get before :from))) + (goto-char (widget-get before :entry-from))) (t (goto-char (widget-get widget :value-pos)))) - (let ((child (widget-repeat-entry-create - widget (widget-get (nth 0 (widget-get widget :args)) - :value)))) - (widget-specify-text (widget-get child :from) - (widget-get child :to)) + (let ((child (widget-editable-list-entry-create + widget nil nil))) + (when (< (widget-get child :entry-from) (widget-get widget :from)) + (set-marker (widget-get widget :from) + (widget-get child :entry-from))) + (widget-specify-text (widget-get child :entry-from) + (widget-get child :entry-to)) (if (eq (car children) before) (widget-put widget :children (cons child children)) (while (not (eq (car (cdr children)) before)) @@ -1316,7 +1595,7 @@ (widget-setup) (widget-apply widget :notify widget)) -(defun widget-repeat-delete-at (widget child) +(defun widget-editable-list-delete-at (widget child) ;; Delete child from list of children. (save-excursion (let ((buttons (copy-list (widget-get widget :buttons))) @@ -1330,21 +1609,27 @@ (widget-put widget :buttons (delq button (widget-get widget :buttons))) (widget-delete button)))) - (widget-delete child) + (let ((entry-from (widget-get child :entry-from)) + (entry-to (widget-get child :entry-to)) + (inhibit-read-only t) + after-change-functions) + (widget-delete child) + (delete-region entry-from entry-to) + (set-marker entry-from nil) + (set-marker entry-to nil)) (widget-put widget :children (delq child (widget-get widget :children)))) (widget-setup) (widget-apply widget :notify widget)) -(defun widget-repeat-entry-create (widget value) +(defun widget-editable-list-entry-create (widget value conv) ;; Create a new entry to the list. (let ((type (nth 0 (widget-get widget :args))) - (indent (widget-get widget :indent)) child delete insert) (widget-specify-insert (save-excursion - (insert (widget-get widget :entry-format)) - (if indent - (insert-char ?\ indent))) + (and (widget-get widget :indent) + (insert-char ? (widget-get widget :indent))) + (insert (widget-get widget :entry-format))) ;; Parse % escapes in format. (while (re-search-forward "%\\(.\\)" nil t) (let ((escape (aref (match-string 1) 0))) @@ -1352,23 +1637,29 @@ (cond ((eq escape ?%) (insert "%")) ((eq escape ?i) - (setq insert (widget-create 'insert-button - :parent widget))) + (setq insert (widget-create-child-and-convert + widget 'insert-button))) ((eq escape ?d) - (setq delete (widget-create 'delete-button - :parent widget))) + (setq delete (widget-create-child-and-convert + widget 'delete-button))) ((eq escape ?v) - (setq child (widget-create type - :parent widget - :value value))) + (if conv + (setq child (widget-create-child-value + widget type value)) + (setq child (widget-create-child widget type)))) (t (error "Unknown escape `%c'" escape))))) (widget-put widget :buttons (cons delete (cons insert (widget-get widget :buttons)))) - (move-marker (widget-get child :from) (point-min)) - (move-marker (widget-get child :to) (point-max))) + (let ((entry-from (copy-marker (point-min))) + (entry-to (copy-marker (point-max)))) + (widget-specify-text entry-from entry-to) + (set-marker-insertion-type entry-from t) + (set-marker-insertion-type entry-to nil) + (widget-put child :entry-from entry-from) + (widget-put child :entry-to entry-to))) (widget-put insert :widget child) (widget-put delete :widget child) child)) @@ -1377,12 +1668,12 @@ (define-widget 'group 'default "A widget which group other widgets inside." - :convert-widget 'widget-choice-convert-widget + :convert-widget 'widget-types-convert-widget :format "%v" :value-create 'widget-group-value-create - :value-delete 'widget-radio-value-delete - :value-get 'widget-repeat-value-get - :validate 'widget-repeat-validate + :value-delete 'widget-children-value-delete + :value-get 'widget-editable-list-value-get + :validate 'widget-editable-list-validate :match 'widget-group-match :match-inline 'widget-group-match-inline) @@ -1390,127 +1681,230 @@ ;; Create each component. (let ((args (widget-get widget :args)) (value (widget-get widget :value)) - (indent (widget-get widget :indent)) arg answer children) (while args (setq arg (car args) args (cdr args) answer (widget-match-inline arg value) - value (cdr answer) - children (cons (cond ((null answer) - (widget-create arg :parent widget)) - ((widget-get arg :inline) - (widget-create arg - :parent widget - :value (car answer))) - (t - (widget-create arg - :parent widget - :value (car (car answer))))) - children)) - (and args indent (insert-char ?\ indent))) + value (cdr answer)) + (and (eq (preceding-char) ?\n) + (widget-get widget :indent) + (insert-char ? (widget-get widget :indent))) + (push (cond ((null answer) + (widget-create-child widget arg)) + ((widget-get arg :inline) + (widget-create-child-value widget arg (car answer))) + (t + (widget-create-child-value widget arg (car (car answer))))) + children)) (widget-put widget :children (nreverse children)))) (defun widget-group-match (widget values) ;; Match if the components match. (and (listp values) - (null (cdr (widget-group-match-inline widget values))))) + (let ((match (widget-group-match-inline widget values))) + (and match (null (cdr match)))))) -(defun widget-group-match-inline (widget values) +(defun widget-group-match-inline (widget vals) ;; Match if the components match. (let ((args (widget-get widget :args)) - (match t) - arg answer found) + argument answer found) (while args - (setq arg (car args) + (setq argument (car args) args (cdr args) - answer (widget-match-inline arg values)) + answer (widget-match-inline argument vals)) (if answer - (setq values (cdr answer) + (setq vals (cdr answer) found (append found (car answer))) - (setq values nil))) + (setq vals nil + args nil))) (if answer - (cons found values) + (cons found vals) nil))) +;;; The `widget-help' Widget. + +(define-widget 'widget-help 'push-button + "The widget documentation button." + :format "%[[%t]%] %d" + :help-echo "Push me to toggle the documentation." + :action 'widget-help-action) + +(defun widget-help-action (widget &optional event) + "Toggle documentation for WIDGET." + (let ((old (widget-get widget :doc)) + (new (widget-get widget :widget-doc))) + (widget-put widget :doc new) + (widget-put widget :widget-doc old)) + (widget-value-set widget (widget-value widget))) + ;;; The Sexp Widgets. (define-widget 'const 'item - nil - :format "%t\n") + "An immutable sexp." + :format "%t\n%d") + +(define-widget 'function-item 'item + "An immutable function name." + :format "%v\n%h" + :documentation-property (lambda (symbol) + (condition-case nil + (documentation symbol t) + (error nil)))) -(define-widget 'string 'field - nil) +(define-widget 'variable-item 'item + "An immutable variable name." + :format "%v\n%h" + :documentation-property 'variable-documentation) + +(define-widget 'string 'editable-field + "A string" + :tag "String" + :format "%[%t%]: %v") + +(define-widget 'regexp 'string + "A regular expression." + ;; Should do validation. + :tag "Regexp") (define-widget 'file 'string - nil - :format "%[%t%]:%v" + "A file widget. +It will read a file name from the minibuffer when activated." + :format "%[%t%]: %v" :tag "File" :action 'widget-file-action) (defun widget-file-action (widget &optional event) - nil ;; Read a file name from the minibuffer. - (widget-value-set widget - (read-file-name (widget-apply widget :menu-tag-get) - (widget-get widget :directory) - (widget-value widget) - (widget-get widget :must-match) - (widget-get widget :initial)))) + (let* ((value (widget-value widget)) + (dir (file-name-directory value)) + (file (file-name-nondirectory value)) + (menu-tag (widget-apply widget :menu-tag-get)) + (must-match (widget-get widget :must-match)) + (answer (read-file-name (concat menu-tag ": (defalt `" value "') ") + dir nil must-match file))) + (widget-value-set widget (abbreviate-file-name answer)) + (widget-apply widget :notify widget event) + (widget-setup))) (define-widget 'directory 'file - nil + "A directory widget. +It will read a directory name from the minibuffer when activated." :tag "Directory") (define-widget 'symbol 'string - nil + "A lisp symbol." + :value nil + :tag "Symbol" :match (lambda (widget value) (symbolp value)) - :value-to-internal (lambda (widget value) (symbol-name value)) - :value-to-external (lambda (widget value) (intern value))) + :value-to-internal (lambda (widget value) + (if (symbolp value) + (symbol-name value) + value)) + :value-to-external (lambda (widget value) + (if (stringp value) + (intern value) + value))) + +(define-widget 'function 'sexp + ;; Should complete on functions. + "A lisp function." + :tag "Function") + +(define-widget 'variable 'symbol + ;; Should complete on variables. + "A lisp variable." + :tag "Variable") (define-widget 'sexp 'string - nil + "An arbitrary lisp expression." + :tag "Lisp expression" + :value nil :validate 'widget-sexp-validate - :match (lambda (widget value) t) - :value-to-internal (lambda (widget value) (pp-to-string value)) + :match (lambda (widget value) t) + :value-to-internal 'widget-sexp-value-to-internal :value-to-external (lambda (widget value) (read value))) +(defun widget-sexp-value-to-internal (widget value) + ;; Use pp for printer representation. + (let ((pp (pp-to-string value))) + (while (string-match "\n\\'" pp) + (setq pp (substring pp 0 -1))) + (if (or (string-match "\n\\'" pp) + (> (length pp) 40)) + (concat "\n" pp) + pp))) + (defun widget-sexp-validate (widget) ;; Valid if we can read the string and there is no junk left after it. (save-excursion - (set-buffer (get-buffer-create " *Widget Scratch*")) - (erase-buffer) - (insert (widget-apply :value-get widget)) - (goto-char (point-min)) - (condition-case data - (let ((value (read (current-buffer)))) - (if (eobp) - (if (widget-apply widget :match value) - t - (widget-put widget :error (widget-get widget :type-error)) - nil) - (widget-put widget - :error (format "Junk at end of expression: %s" - (buffer-substring (point) (point-max)))) - nil)) - (error (widget-put widget :error (error-message-string data)) - nil)))) + (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*")))) + (erase-buffer) + (insert (widget-apply widget :value-get)) + (goto-char (point-min)) + (condition-case data + (let ((value (read buffer))) + (if (eobp) + (if (widget-apply widget :match value) + nil + (widget-put widget :error (widget-get widget :type-error)) + widget) + (widget-put widget + :error (format "Junk at end of expression: %s" + (buffer-substring (point) + (point-max)))) + widget)) + (error (widget-put widget :error (error-message-string data)) + widget))))) (define-widget 'integer 'sexp - nil + "An integer." + :tag "Integer" + :value 0 :type-error "This field should contain an integer" + :value-to-internal (lambda (widget value) + (if (integerp value) + (prin1-to-string value) + value)) + :match (lambda (widget value) (integerp value))) + +(define-widget 'character 'string + "An character." + :tag "Character" + :value 0 + :size 1 + :format "%t: %v\n" + :type-error "This field should contain a character" + :value-to-internal (lambda (widget value) + (if (integerp value) + (char-to-string value) + value)) + :value-to-external (lambda (widget value) + (if (stringp value) + (aref value 0) + value)) :match (lambda (widget value) (integerp value))) (define-widget 'number 'sexp - nil + "A floating point number." + :tag "Number" + :value 0.0 :type-error "This field should contain a number" + :value-to-internal (lambda (widget value) + (if (numberp value) + (prin1-to-string value) + value)) :match (lambda (widget value) (numberp value))) (define-widget 'list 'group - nil) + "A lisp list." + :tag "List" + :format "%t:\n%v") (define-widget 'vector 'group - nil + "A lisp vector." + :tag "Vector" + :format "%t:\n%v" :match 'widget-vector-match :value-to-internal (lambda (widget value) (append value nil)) :value-to-external (lambda (widget value) (apply 'vector value))) @@ -1521,7 +1915,9 @@ (widget-apply :value-to-internal widget value)))) (define-widget 'cons 'group - nil + "A cons-cell." + :tag "Cons-cell" + :format "%t:\n%v" :match 'widget-cons-match :value-to-internal (lambda (widget value) (list (car value) (cdr value))) @@ -1531,7 +1927,151 @@ (defun widget-cons-match (widget value) (and (consp value) (widget-group-match widget - (widget-apply :value-to-internal widget value)))) + (widget-apply widget :value-to-internal value)))) + +(define-widget 'choice 'menu-choice + "A union of several sexp types." + :tag "Choice" + :format "%[%t%]: %v") + +(define-widget 'radio 'radio-button-choice + "A union of several sexp types." + :tag "Choice" + :format "%t:\n%v") + +(define-widget 'repeat 'editable-list + "A variable length homogeneous list." + :tag "Repeat" + :format "%t:\n%v%i\n") + +(define-widget 'set 'checklist + "A list of members from a fixed set." + :tag "Set" + :format "%t:\n%v") + +(define-widget 'boolean 'toggle + "To be nil or non-nil, that is the question." + :tag "Boolean" + :format "%t: %v") + +;;; The `color' Widget. + +(define-widget 'color-item 'choice-item + "A color name (with sample)." + :format "%v (%[sample%])\n" + :button-face-get 'widget-color-item-button-face-get) + +(defun widget-color-item-button-face-get (widget) + ;; We create a face from the value. + (require 'facemenu) + (condition-case nil + (facemenu-get-face (intern (concat "fg:" (widget-value widget)))) + (error 'default))) + +(define-widget 'color 'push-button + "Choose a color name (with sample)." + :format "%[%t%]: %v" + :tag "Color" + :value "default" + :value-create 'widget-color-value-create + :value-delete 'widget-children-value-delete + :value-get 'widget-color-value-get + :value-set 'widget-color-value-set + :action 'widget-color-action + :match 'widget-field-match + :tag "Color") + +(defvar widget-color-choice-list nil) +;; Variable holding the possible colors. + +(defun widget-color-choice-list () + (unless widget-color-choice-list + (setq widget-color-choice-list + (mapcar '(lambda (color) (list color)) + (x-defined-colors)))) + widget-color-choice-list) + +(defun widget-color-value-create (widget) + (let ((child (widget-create-child-and-convert + widget 'color-item (widget-get widget :value)))) + (widget-put widget :children (list child)))) + +(defun widget-color-value-get (widget) + ;; Pass command to first child. + (widget-apply (car (widget-get widget :children)) :value-get)) + +(defun widget-color-value-set (widget value) + ;; Pass command to first child. + (widget-apply (car (widget-get widget :children)) :value-set value)) + +(defvar widget-color-history nil + "History of entered colors") + +(defun widget-color-action (widget &optional event) + ;; Prompt for a color. + (let* ((tag (widget-apply widget :menu-tag-get)) + (prompt (concat tag ": ")) + (answer (cond ((string-match "XEmacs" emacs-version) + (read-color prompt)) + ((fboundp 'x-defined-colors) + (completing-read (concat tag ": ") + (widget-color-choice-list) + nil nil nil 'widget-color-history)) + (t + (read-string prompt (widget-value widget)))))) + (unless (zerop (length answer)) + (widget-value-set widget answer) + (widget-apply widget :notify widget event) + (widget-setup)))) + +;;; The Help Echo + +(defun widget-echo-help-mouse () + "Display the help message for the widget under the mouse. +Enable with (run-with-idle-timer 1 t 'widget-echo-help-mouse)" + (let* ((pos (mouse-position)) + (frame (car pos)) + (x (car (cdr pos))) + (y (cdr (cdr pos))) + (win (window-at x y frame)) + (where (coordinates-in-window-p (cons x y) win))) + (when (consp where) + (save-window-excursion + (progn ; save-excursion + (select-window win) + (let* ((result (compute-motion (window-start win) + '(0 . 0) + (window-end win) + where + (window-width win) + (cons (window-hscroll) 0) + win))) + (when (and (eq (nth 1 result) x) + (eq (nth 2 result) y)) + (widget-echo-help (nth 0 result)))))))) + (unless track-mouse + (setq track-mouse t) + (add-hook 'post-command-hook 'widget-stop-mouse-tracking))) + +(defun widget-stop-mouse-tracking (&rest args) + "Stop the mouse tracking done while idle." + (remove-hook 'post-command-hook 'widget-stop-mouse-tracking) + (setq track-mouse nil)) + +(defun widget-at (pos) + "The button or field at POS." + (or (get-text-property pos 'button) + (get-text-property pos 'field))) + +(defun widget-echo-help (pos) + "Display the help echo for widget at POS." + (let* ((widget (widget-at pos)) + (help-echo (and widget (widget-get widget :help-echo)))) + (cond ((stringp help-echo) + (message "%s" help-echo)) + ((and (symbolp help-echo) (fboundp help-echo) + (stringp (setq help-echo (funcall help-echo widget)))) + (message "%s" help-echo))))) ;;; The End:
--- a/lisp/w3/widget.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/w3/widget.el Mon Aug 13 09:06:37 2007 +0200 @@ -4,12 +4,12 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 0.4 +;; Version: 1.13 +;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: ;; -;; The documentation for the unbundled version of this library is -;; available in `custom.texi'. +;; If you want to use this code, please visit the URL above. ;; ;; This file only contain the code needed to define new widget types. ;; Everything else is autoloaded from `widget-edit.el'. @@ -18,23 +18,33 @@ (eval-when-compile (require 'cl)) -(let ((keywords - '(:create :convert-widget :format :value-create :tag :doc :from :to - :args :value :value-from :value-to :action :value-set - :value-delete :match :parent :delete :menu-tag-get - :value-get :choice :void :menu-tag :on :off :on-type - :off-type :notify :entry-format :button :children - :buttons :insert-before :delete-at :format-handler - :widget :value-pos :value-to-internal :indent - :help-echo - :value-to-external :validate :error :directory :must-match - :initial :type-error :value-inline :inline :match-inline - :greedy :button-face :value-face :keymap :size))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords)))) +(defmacro define-widget-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))))))) +(define-widget-keywords :case-fold :widget-doc + :create :convert-widget :format :value-create :offset :extra-offset + :tag :doc :from :to :args :value :value-from :value-to :action + :value-set :value-delete :match :parent :delete :menu-tag-get + :value-get :choice :void :menu-tag :on :off :on-type :off-type + :notify :entry-format :button :children :buttons :insert-before + :delete-at :format-handler :widget :value-pos :value-to-internal + :indent :size :value-to-external :validate :error :directory + :must-match :type-error :value-inline :inline :match-inline :greedy + :button-face-get :button-face :value-face :keymap :entry-from + :entry-to :help-echo :documentation-property :hide-front-space + :hide-rear-space) + +;; These autoloads should be deleted when the file is added to Emacs. +(autoload 'widget-create "widget-edit") +(autoload 'widget-insert "widget-edit") + +;;;###autoload (defun define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. @@ -52,25 +62,6 @@ (put name 'widget-type (cons class args)) (put name 'widget-documentation doc)) -(autoload 'widget-create "widget-edit") -(autoload 'widget-insert "widget-edit") - -(defun define-widget-group (name class doc &rest args) - "Define a new widget group named NAME. - -CLASS should be nil, it is reserved for future use. - -MATCH should be a function taking a widget group and a list of match -types as an argument, and returning the remaining part of the list if -the widget group matches the beginning of the list, or throwing -`no-match' if not. - -CREATE should be a function taking a widget group and a list of values -as arguments, and returning a cons whose car is a list of widgets -representing the matches values and whose cdr is the remaining -unmatched values." - (put name 'widget-group (cons class args))) - ;;; The End. (provide 'widget)
--- a/lisp/x11/x-compose.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/x11/x-compose.el Mon Aug 13 09:06:37 2007 +0200 @@ -50,7 +50,7 @@ ;;; ;;; xmodmap -e "remove mod1 = Meta_R" -e "keysym Meta_R = Multi_key" ;;; -;;; Multi_key is the name that X (and emacs) know the "Compose" key by. +;;; Multi-key is the name that X (and emacs) know the "Compose" key by. ;;; The "remove..." command is necessary because the "Compose" key must not ;;; have any modifier bits associated with it. This exact command may not ;;; work, depending on what system and keyboard you are using. If it @@ -101,7 +101,7 @@ ;; (keysym is lower case because we downcase everything in the Symbol font...) ;; ;;;this doesn't work yet###autoload -(define-key global-map [multi_key] 'compose-key) +(define-key global-map [multi-key] 'compose-key) ;; The "Dead" keys: ;;
--- a/lisp/x11/x-menubar.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 09:06:37 2007 +0200 @@ -481,6 +481,15 @@ :style radio :selected (eq (default-toolbar-position) 'right)] ) ))) + ("Mouse" + ["Avoid-Text" + (if (equal (device-type) 'x) + (if mouse-avoidance-mode + (mouse-avoidance-mode 'none) + (mouse-avoidance-mode 'banish)) + (beep) + (message "This option requires a window system.")) + :style toggle :selected (and mouse-avoidance-mode window-system)]) ("Open URLs With" ["Emacs-W3" (setq browse-url-browser-function 'browse-url-w3) :style radio @@ -575,7 +584,11 @@ ["Sample" (find-file (expand-file-name "sample.Xdefaults" data-directory)) - t ".Xdefaults"]) + t ".Xdefaults"] + ["Sample" (find-file + (expand-file-name "enriched.doc" + data-directory)) + t "enriched"]) "-----" ("Lookup in Info" ["Key/Mouse Binding..." Info-goto-emacs-key-command-node t] @@ -1100,6 +1113,9 @@ ',(specifier-spec-list toolbar-buttons-captioned-p 'global))))) + ;; mouse + mouse-avoidance-mode + ;; Open URLs With browse-url-browser-function
--- a/lisp/x11/x-toolbar.el Mon Aug 13 09:05:44 2007 +0200 +++ b/lisp/x11/x-toolbar.el Mon Aug 13 09:06:37 2007 +0200 @@ -120,12 +120,15 @@ (defvar toolbar-news-frame nil "The frame in which news is displayed.") +(defvar toolbar-news-frame-properties nil + "The properties of the frame in which news is displayed.") + (defun toolbar-news () "Run Gnus in a separate frame." (interactive) (when (or (not toolbar-news-frame) (not (frame-live-p toolbar-news-frame))) - (setq toolbar-news-frame (make-frame)) + (setq toolbar-news-frame (make-frame toolbar-news-frame-properties)) (add-hook 'gnus-exit-gnus-hook (lambda () (when (frame-live-p toolbar-news-frame)
--- a/lwlib/Makefile.in.in Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/Makefile.in.in Mon Aug 13 09:06:37 2007 +0200 @@ -16,11 +16,11 @@ 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 +along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Some people use these in paths they define. We don't want their paths +/* Some people use these in paths they define. We do not want their paths getting changed on them. */ #undef sparc #undef sun @@ -55,14 +55,14 @@ in-place location, it will not get recompiled in the not-in-place location. - The GNU Make `vpath' directive continues this tradition, but at + The GNU Make "vpath" directive continues this tradition, but at least lets you restrict the classes of files that it applies to. This allows us to kludge around the problem. */ #ifdef USE_GNU_MAKE vpath %.c @srcdir@ vpath %.h @srcdir@ /* now list files that should NOT be searched in the srcdir. - This includes any .c or .h that's built from something else + This includes any .c or .h built from something else (e.g. a .in file). */ /* none here */ #else @@ -230,7 +230,7 @@ #ifdef ENERGIZE ez_dialog: - cd energize ; $(MAKE) $(MFLAGS) + cd energize && $(MAKE) $(MFLAGS) #endif FRC.mostlyclean: @@ -238,7 +238,7 @@ rm -f liblw.a liblw_pure_*.a *.o clean: mostlyclean #ifdef ENERGIZE - cd energize ; $(MAKE) $(MFLAGS) clean + cd energize && $(MAKE) $(MFLAGS) clean #endif distclean: clean rm -f Makefile Makefile.in .pure
--- a/lwlib/lwlib-Xaw.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/lwlib-Xaw.c Mon Aug 13 09:06:37 2007 +0200 @@ -14,12 +14,11 @@ 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 +along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include <stdio.h> -#include <stdlib.h> #include "lwlib-Xaw.h" @@ -285,9 +284,9 @@ override = XtParseTranslationTable (overrideTrans); ac = 0; - XtSetArg (av[ac], XtNtitle, shell_title); ac++; + XtSetArg (av[ac], XtNtitle, shell_title); ac++; XtSetArg (av[ac], XtNallowShellResize, True); ac++; - XtSetArg (av[ac], XtNtransientFor, parent); ac++; + XtSetArg (av[ac], XtNtransientFor, parent); ac++; shell = XtCreatePopupShell ("dialog", transientShellWidgetClass, parent, av, ac); XtOverrideTranslations (shell, override); @@ -300,12 +299,12 @@ for (i = 0; i < left_buttons; i++) { ac = 0; - XtSetArg (av [ac], XtNfromHoriz, button); ac++; - XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; - XtSetArg (av [ac], XtNright, XtChainLeft); ac++; - XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; + XtSetArg (av [ac], XtNfromHoriz, button); ac++; + XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; + XtSetArg (av [ac], XtNright, XtChainLeft); ac++; + XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; - XtSetArg (av [ac], XtNresizable, True); ac++; + XtSetArg (av [ac], XtNresizable, True); ac++; sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); @@ -320,11 +319,11 @@ window) but I can't seem to make it do it. */ ac = 0; - XtSetArg (av [ac], XtNfromHoriz, button); ac++; + XtSetArg (av [ac], XtNfromHoriz, button); ac++; /* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */ - XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; - XtSetArg (av [ac], XtNright, XtChainRight); ac++; - XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; + XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; + XtSetArg (av [ac], XtNright, XtChainRight); ac++; + XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNlabel, ""); ac++; XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */ @@ -342,12 +341,12 @@ for (i = 0; i < right_buttons; i++) { ac = 0; - XtSetArg (av [ac], XtNfromHoriz, button); ac++; - XtSetArg (av [ac], XtNleft, XtChainRight); ac++; - XtSetArg (av [ac], XtNright, XtChainRight); ac++; - XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; + XtSetArg (av [ac], XtNfromHoriz, button); ac++; + XtSetArg (av [ac], XtNleft, XtChainRight); ac++; + XtSetArg (av [ac], XtNright, XtChainRight); ac++; + XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; - XtSetArg (av [ac], XtNresizable, True); ac++; + XtSetArg (av [ac], XtNresizable, True); ac++; sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); @@ -558,7 +557,7 @@ { Arg av[10]; int ac = 0; - + static XtCallbackRec jumpCallbacks[2] = { {xaw_scrollbar_jump, NULL}, {NULL, NULL} }; @@ -573,28 +572,13 @@ few people use the Athena scrollbar now that it really isn't worth the effort, at least not at the moment. */ XtSetArg (av [ac], XtNborderWidth, 0); ac++; - if (vertical) - { - XtSetArg (av [ac], XtNorientation, XtorientVertical); ac++; - } - else - { - XtSetArg (av [ac], XtNorientation, XtorientHorizontal); ac++; - } + XtSetArg (av [ac], XtNorientation, + vertical ? XtorientVertical : XtorientHorizontal); ac++; + XtSetArg (av [ac], "jumpProc", jumpCallbacks); ac++; + XtSetArg (av [ac], "scrollProc", scrollCallbacks); ac++; - scrollbar = - XtCreateWidget (instance->info->name, scrollbarWidgetClass, - instance->parent, av, ac); - - XtRemoveAllCallbacks (scrollbar, "jumpProc"); - XtRemoveAllCallbacks (scrollbar, "scrollProc"); - - XtAddCallback (scrollbar, "jumpProc", xaw_scrollbar_jump, - (XtPointer) instance); - XtAddCallback (scrollbar, "scrollProc", xaw_scrollbar_scroll, - (XtPointer) instance); - - return scrollbar; + return XtCreateWidget (instance->info->name, scrollbarWidgetClass, + instance->parent, av, ac); } static Widget
--- a/lwlib/lwlib-Xlw.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/lwlib-Xlw.c Mon Aug 13 09:06:37 2007 +0200 @@ -14,7 +14,7 @@ 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 +along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ @@ -108,7 +108,7 @@ instance->parent, XtNmenu, instance->info->val, 0); - XtAddCallback (widget, XtNopen, pre_hook, (XtPointer)instance); + XtAddCallback (widget, XtNopen, pre_hook, (XtPointer)instance); XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); return widget; } @@ -155,10 +155,10 @@ event_data.slider_value = (int) (percent * (double) (val->maximum - val->minimum)) + val->minimum; - if (event_data.slider_value > (val->maximum - val->slider_size)) - event_data.slider_value = val->maximum - val->slider_size; + if (event_data.slider_value > val->maximum - val->slider_size) + event_data.slider_value = val->maximum - val->slider_size; else if (event_data.slider_value < val->minimum) - event_data.slider_value = val->minimum; + event_data.slider_value = val->minimum; if (data->event) { @@ -189,33 +189,15 @@ switch (data->reason) { - case XmCR_DECREMENT: - event_data.action = SCROLLBAR_LINE_UP; - break; - case XmCR_INCREMENT: - event_data.action = SCROLLBAR_LINE_DOWN; - break; - case XmCR_PAGE_DECREMENT: - event_data.action = SCROLLBAR_PAGE_UP; - break; - case XmCR_PAGE_INCREMENT: - event_data.action = SCROLLBAR_PAGE_DOWN; - break; - case XmCR_TO_TOP: - event_data.action = SCROLLBAR_TOP; - break; - case XmCR_TO_BOTTOM: - event_data.action = SCROLLBAR_BOTTOM; - break; - case XmCR_DRAG: - event_data.action = SCROLLBAR_DRAG; - break; - case XmCR_VALUE_CHANGED: - event_data.action = SCROLLBAR_CHANGE; - break; - default: - event_data.action = SCROLLBAR_CHANGE; - break; + case XmCR_DECREMENT: event_data.action = SCROLLBAR_LINE_UP; break; + case XmCR_INCREMENT: event_data.action = SCROLLBAR_LINE_DOWN; break; + case XmCR_PAGE_DECREMENT: event_data.action = SCROLLBAR_PAGE_UP; break; + case XmCR_PAGE_INCREMENT: event_data.action = SCROLLBAR_PAGE_DOWN; break; + case XmCR_TO_TOP: event_data.action = SCROLLBAR_TOP; break; + case XmCR_TO_BOTTOM: event_data.action = SCROLLBAR_BOTTOM; break; + case XmCR_DRAG: event_data.action = SCROLLBAR_DRAG; break; + case XmCR_VALUE_CHANGED: event_data.action = SCROLLBAR_CHANGE; break; + default: event_data.action = SCROLLBAR_CHANGE; break; } if (instance->info->pre_activate_cb) @@ -286,11 +268,10 @@ XtNheight, data->scrollbar_height, 0); - /* Now the size the scrollbar's slider. */ - + /* Now size the scrollbar's slider. */ XtVaGetValues (widget, XmNsliderSize, &widget_sliderSize, - XmNvalue, &widget_val, + XmNvalue, &widget_val, 0); percent = (double) data->slider_size / @@ -303,15 +284,15 @@ percent = (percent > 1.0 ? 1.0 : percent); new_value = (int) ((double) (INT_MAX - 1) * percent); - if (new_sliderSize > (INT_MAX - 1)) - new_sliderSize = INT_MAX - 1; + if (new_sliderSize > INT_MAX - 1) + new_sliderSize = INT_MAX - 1; if (new_sliderSize < 1) - new_sliderSize = 1; + new_sliderSize = 1; if (new_value > (INT_MAX - new_sliderSize)) - new_value = INT_MAX - new_sliderSize; + new_value = INT_MAX - new_sliderSize; else if (new_value < 1) - new_value = 1; + new_value = 1; if (new_sliderSize != widget_sliderSize || new_value != widget_val) XlwScrollBarSetValues (widget, new_value, new_sliderSize, 1, 1, False); @@ -422,4 +403,3 @@ if (instance->widget) XtDestroyWidget (instance->widget); } -
--- a/lwlib/lwlib-Xm.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/lwlib-Xm.c Mon Aug 13 09:06:37 2007 +0200 @@ -15,7 +15,7 @@ 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 +along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ @@ -111,8 +111,8 @@ make_destroyed_instance (char* name, char* type, Widget widget, Widget parent, Boolean pop_up_p) { - destroyed_instance *instance = - (destroyed_instance *) malloc (sizeof (destroyed_instance)); + destroyed_instance* instance = + (destroyed_instance*) malloc (sizeof (destroyed_instance)); instance->name = safe_strdup (name); instance->type = safe_strdup (type); instance->widget = widget; @@ -153,7 +153,7 @@ XtResource resource; char *result = NULL; - resource.resource_name = "labelString"; + resource.resource_name = "labelString"; resource.resource_class = "LabelString"; /* #### should be Xmsomething... */ resource.resource_type = XtRString; resource.resource_size = sizeof (String); @@ -280,7 +280,7 @@ } XtSetArg (al [ac], XmNlabelString, built_string); ac++; - XtSetArg (al [ac], XmNlabelType, XmSTRING); ac++; + XtSetArg (al [ac], XmNlabelType, XmSTRING); ac++; } if (val->key) @@ -459,9 +459,9 @@ { ac = 0; button = 0; - XtSetArg (al [ac], XmNsensitive, cur->enabled); ac++; - XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; - XtSetArg (al [ac], XmNuserData, cur->call_data); ac++; + XtSetArg (al [ac], XmNsensitive, cur->enabled); ac++; + XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; + XtSetArg (al [ac], XmNuserData, cur->call_data); ac++; switch (cur->type) { @@ -668,7 +668,7 @@ static void xm_update_text (widget_instance* instance, Widget widget, widget_value* val) { - XmTextSetString (widget, val->value ? val->value : (char *) ""); + XmTextSetString (widget, val->value ? val->value : ""); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); @@ -680,7 +680,7 @@ xm_update_text_field (widget_instance* instance, Widget widget, widget_value* val) { - XmTextFieldSetString (widget, val->value ? val->value : (char *) ""); + XmTextFieldSetString (widget, val->value ? val->value : ""); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); @@ -784,7 +784,7 @@ /* Common to all widget types */ XtVaSetValues (widget, XmNsensitive, val->enabled, - XmNuserData, val->call_data, + XmNuserData, val->call_data, 0); #if defined (DIALOGS_MOTIF) || defined (MENUBARS_MOTIF) @@ -1041,12 +1041,12 @@ if (pop_up_p) { ac = 0; - XtSetArg(al[ac], XmNtitle, shell_title); ac++; - XtSetArg(al[ac], XtNallowShellResize, True); ac++; - XtSetArg(al[ac], XmNdeleteResponse, XmUNMAP); ac++; - result = XmCreateDialogShell (parent, (char *) "dialog", al, ac); + XtSetArg(al[ac], XmNtitle, shell_title); ac++; + XtSetArg(al[ac], XtNallowShellResize, True); ac++; + XtSetArg(al[ac], XmNdeleteResponse, XmUNMAP); ac++; + result = XmCreateDialogShell (parent, "dialog", al, ac); - XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; + XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; /* XtSetArg(al[ac], XmNautoUnmanage, TRUE); ac++; */ /* ####is this ok? */ XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; form = XmCreateForm (result, (char *) shell_title, al, ac); @@ -1054,30 +1054,30 @@ else { ac = 0; - XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; + XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; form = XmCreateForm (parent, (char *) shell_title, al, ac); result = form; } ac = 0; - XtSetArg(al[ac], XmNpacking, XmPACK_COLUMN); ac++; - XtSetArg(al[ac], XmNorientation, XmVERTICAL); ac++; + XtSetArg(al[ac], XmNpacking, XmPACK_COLUMN); ac++; + XtSetArg(al[ac], XmNorientation, XmVERTICAL); ac++; XtSetArg(al[ac], XmNnumColumns, left_buttons + right_buttons + 1); ac++; - XtSetArg(al[ac], XmNmarginWidth, 0); ac++; - XtSetArg(al[ac], XmNmarginHeight, 0); ac++; - XtSetArg(al[ac], XmNspacing, 13); ac++; - XtSetArg(al[ac], XmNadjustLast, False); ac++; - XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; - XtSetArg(al[ac], XmNisAligned, True); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - row = XmCreateRowColumn (form, (char *) "row", al, ac); + XtSetArg(al[ac], XmNmarginWidth, 0); ac++; + XtSetArg(al[ac], XmNmarginHeight, 0); ac++; + XtSetArg(al[ac], XmNspacing, 13); ac++; + XtSetArg(al[ac], XmNadjustLast, False); ac++; + XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; + XtSetArg(al[ac], XmNisAligned, True); ac++; + XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNbottomOffset, 13); ac++; + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNleftOffset, 13); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNrightOffset, 13); ac++; + row = XmCreateRowColumn (form, "row", al, ac); n_children = 0; for (i = 0; i < left_buttons; i++) @@ -1088,7 +1088,7 @@ if (i == 0) { XtSetArg(al[ac], XmNhighlightThickness, 1); ac++; - XtSetArg(al[ac], XmNshowAsDefault, TRUE); ac++; + XtSetArg(al[ac], XmNshowAsDefault, TRUE); ac++; } XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; children [n_children] = XmCreatePushButton (row, button_name, al, ac); @@ -1136,101 +1136,98 @@ XtManageChildren (children, n_children); ac = 0; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, row); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNleftOffset, 0); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 0); ac++; - separator = XmCreateSeparator (form, (char *) "", al, ac); + XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNbottomOffset, 13); ac++; + XtSetArg(al[ac], XmNbottomWidget, row); ac++; + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNleftOffset, 0); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNrightOffset, 0); ac++; + separator = XmCreateSeparator (form, "", al, ac); ac = 0; - XtSetArg(al[ac], XmNlabelType, XmPIXMAP); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNtopOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; + XtSetArg(al[ac], XmNlabelType, XmPIXMAP); ac++; + XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNtopOffset, 13); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_NONE); ac++; + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNleftOffset, 13); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; icon = XmCreateLabel (form, (char *) icon_name, al, ac); DO_DND_KLUDGE (icon); ac = 0; - XtSetArg(al[ac], XmNmappedWhenManaged, FALSE); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNtopOffset, 6); ac++; - XtSetArg(al[ac], XmNtopWidget, icon); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 6); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; - icon_separator = XmCreateLabel (form, (char *) "", al, ac); + XtSetArg(al[ac], XmNmappedWhenManaged, FALSE); ac++; + XtSetArg(al[ac], XmNtopAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNtopOffset, 6); ac++; + XtSetArg(al[ac], XmNtopWidget, icon); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNbottomOffset, 6); ac++; + XtSetArg(al[ac], XmNbottomWidget, separator); ac++; + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_NONE); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; + icon_separator = XmCreateLabel (form, "", al, ac); DO_DND_KLUDGE (icon_separator); if (text_input_slot) { ac = 0; - XtSetArg(al[ac], XmNcolumns, 50); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - value = XmCreateTextField (form, (char *) "value", al, ac); + XtSetArg(al[ac], XmNcolumns, 50); ac++; + XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNbottomOffset, 13); ac++; + XtSetArg(al[ac], XmNbottomWidget, separator); ac++; + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNleftOffset, 13); ac++; + XtSetArg(al[ac], XmNleftWidget, icon); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNrightOffset, 13); ac++; + value = XmCreateTextField (form, "value", al, ac); DO_DND_KLUDGE (value); } else if (radio_box) { Widget radio_butt; ac = 0; - XtSetArg(al[ac], XmNmarginWidth, 0); ac++; - XtSetArg(al[ac], XmNmarginHeight, 0); ac++; - XtSetArg(al[ac], XmNspacing, 13); ac++; - XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; - XtSetArg(al[ac], XmNorientation, XmHORIZONTAL); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - value = XmCreateRadioBox (form, (char *) "radiobutton1", al, ac); + XtSetArg(al[ac], XmNmarginWidth, 0); ac++; + XtSetArg(al[ac], XmNmarginHeight, 0); ac++; + XtSetArg(al[ac], XmNspacing, 13); ac++; + XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; + XtSetArg(al[ac], XmNorientation, XmHORIZONTAL); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNbottomOffset, 13); ac++; + XtSetArg(al[ac], XmNbottomWidget, separator); ac++; + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNleftOffset, 13); ac++; + XtSetArg(al[ac], XmNleftWidget, icon); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNrightOffset, 13); ac++; + value = XmCreateRadioBox (form, "radiobutton1", al, ac); ac = 0; i = 0; - radio_butt = XmCreateToggleButtonGadget (value, (char *) "radio1", - al, ac); + radio_butt = XmCreateToggleButtonGadget (value, "radio1", al, ac); children [i++] = radio_butt; - radio_butt = XmCreateToggleButtonGadget (value, (char *) "radio2", - al, ac); + radio_butt = XmCreateToggleButtonGadget (value, "radio2", al, ac); children [i++] = radio_butt; - radio_butt = XmCreateToggleButtonGadget (value, (char *) "radio3", - al, ac); + radio_butt = XmCreateToggleButtonGadget (value, "radio3", al, ac); children [i++] = radio_butt; XtManageChildren (children, i); } else if (list) { ac = 0; - XtSetArg(al[ac], XmNvisibleItemCount, 5); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - value = XmCreateScrolledList (form, (char *) "list", al, ac); + XtSetArg(al[ac], XmNvisibleItemCount, 5); ac++; + XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNbottomOffset, 13); ac++; + XtSetArg(al[ac], XmNbottomWidget, separator); ac++; + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNleftOffset, 13); ac++; + XtSetArg(al[ac], XmNleftWidget, icon); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNrightOffset, 13); ac++; + value = XmCreateScrolledList (form, "list", al, ac); /* this is the easiest way I found to have the dble click in the list activate the default button */ @@ -1238,19 +1235,19 @@ } ac = 0; - XtSetArg(al[ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNtopOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; + XtSetArg(al[ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; + XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNtopOffset, 13); ac++; + XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNbottomOffset, 13); ac++; XtSetArg(al[ac], XmNbottomWidget, text_input_slot || radio_box || list ? value : separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - message = XmCreateLabel (form, (char *) "message", al, ac); + XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; + XtSetArg(al[ac], XmNleftOffset, 13); ac++; + XtSetArg(al[ac], XmNleftWidget, icon); ac++; + XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; + XtSetArg(al[ac], XmNrightOffset, 13); ac++; + message = XmCreateLabel (form, "message", al, ac); DO_DND_KLUDGE (message); if (list) @@ -1489,7 +1486,7 @@ Arg al[10]; int ac = 0; - XtSetArg(al[ac], XmNmarginHeight, 0); ac++; + XtSetArg(al[ac], XmNmarginHeight, 0); ac++; XtSetArg(al[ac], XmNshadowThickness, 3); ac++; return XmCreateMenuBar (instance->parent, instance->info->name, al, ac); @@ -1525,52 +1522,28 @@ { Arg al[20]; int ac = 0; - Widget scrollbar; - - XtSetArg (al[ac], XmNminimum, 1); ac++; - XtSetArg (al[ac], XmNmaximum, INT_MAX); ac++; - XtSetArg (al[ac], XmNincrement, 1); ac++; - XtSetArg (al[ac], XmNpageIncrement, 1); ac++; - XtSetArg (al[ac], XmNborderWidth, 0); ac++; - if (vertical) - { - XtSetArg (al[ac], XmNorientation, XmVERTICAL); ac++; - } - else - { - XtSetArg (al[ac], XmNorientation, XmHORIZONTAL); ac++; - } - - scrollbar = - XmCreateScrollBar (instance->parent, instance->info->name, al, ac); + static XtCallbackRec callbacks[2] = + { {xm_scrollbar_callback, NULL}, {NULL, NULL} }; - XtRemoveAllCallbacks (scrollbar, XmNdecrementCallback); - XtRemoveAllCallbacks (scrollbar, XmNdragCallback); - XtRemoveAllCallbacks (scrollbar, XmNincrementCallback); - XtRemoveAllCallbacks (scrollbar, XmNpageDecrementCallback); - XtRemoveAllCallbacks (scrollbar, XmNpageIncrementCallback); - XtRemoveAllCallbacks (scrollbar, XmNtoBottomCallback); - XtRemoveAllCallbacks (scrollbar, XmNtoTopCallback); - XtRemoveAllCallbacks (scrollbar, XmNvalueChangedCallback); + callbacks[0].closure = (XtPointer) instance; + + XtSetArg (al[ac], XmNminimum, 1); ac++; + XtSetArg (al[ac], XmNmaximum, INT_MAX); ac++; + XtSetArg (al[ac], XmNincrement, 1); ac++; + XtSetArg (al[ac], XmNpageIncrement, 1); ac++; + XtSetArg (al[ac], XmNborderWidth, 0); ac++; + XtSetArg (al[ac], XmNorientation, vertical ? XmVERTICAL : XmHORIZONTAL); ac++; - XtAddCallback(scrollbar, XmNdecrementCallback, xm_scrollbar_callback, - (XtPointer) instance); - XtAddCallback(scrollbar, XmNdragCallback, xm_scrollbar_callback, - (XtPointer) instance); - XtAddCallback(scrollbar, XmNincrementCallback, xm_scrollbar_callback, - (XtPointer) instance); - XtAddCallback(scrollbar, XmNpageDecrementCallback, xm_scrollbar_callback, - (XtPointer) instance); - XtAddCallback(scrollbar, XmNpageIncrementCallback, xm_scrollbar_callback, - (XtPointer) instance); - XtAddCallback(scrollbar, XmNtoBottomCallback, xm_scrollbar_callback, - (XtPointer) instance); - XtAddCallback(scrollbar, XmNtoTopCallback, xm_scrollbar_callback, - (XtPointer) instance); - XtAddCallback(scrollbar, XmNvalueChangedCallback, xm_scrollbar_callback, - (XtPointer) instance); + XtSetArg (al[ac], XmNdecrementCallback, callbacks); ac++; + XtSetArg (al[ac], XmNdragCallback, callbacks); ac++; + XtSetArg (al[ac], XmNincrementCallback, callbacks); ac++; + XtSetArg (al[ac], XmNpageDecrementCallback, callbacks); ac++; + XtSetArg (al[ac], XmNpageIncrementCallback, callbacks); ac++; + XtSetArg (al[ac], XmNtoBottomCallback, callbacks); ac++; + XtSetArg (al[ac], XmNtoTopCallback, callbacks); ac++; + XtSetArg (al[ac], XmNvalueChangedCallback, callbacks); ac++; - return scrollbar; + return XmCreateScrollBar (instance->parent, instance->info->name, al, ac); } static Widget
--- a/lwlib/lwlib-config.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/lwlib-config.c Mon Aug 13 09:06:37 2007 +0200 @@ -14,18 +14,16 @@ 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 +along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - /* This is a kludge to make sure emacs can only link against a version of lwlib that was compiled in the right way. Emacs references symbols which correspond to the way it thinks lwlib was compiled, and if lwlib wasn't compiled in that way, then somewhat meaningful link errors will result. The alternatives to this range from obscure link errors, to obscure - runtime errors that look a lot like bugs. - */ + runtime errors that look a lot like bugs. */ #include "lwlib.h"
--- a/lwlib/lwlib-utils.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/lwlib-utils.c Mon Aug 13 09:06:37 2007 +0200 @@ -14,9 +14,9 @@ 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 +along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -+Boston, MA 02111-1307, USA. */ +Boston, MA 02111-1307, USA. */ #include <stdlib.h> #include <unistd.h>
--- a/lwlib/lwlib.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/lwlib.c Mon Aug 13 09:06:37 2007 +0200 @@ -15,8 +15,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ #ifdef NeXT #undef __STRICT_BSD__ /* ick */
--- a/lwlib/xlwmenu.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/xlwmenu.c Mon Aug 13 09:06:37 2007 +0200 @@ -105,7 +105,7 @@ {XtNmenu, XtCMenu, XtRPointer, sizeof(XtPointer), offset(menu.contents), XtRImmediate, (XtPointer)NULL}, {XtNcursor, XtCCursor, XtRCursor, sizeof(Cursor), - offset(menu.cursor_shape), XtRString, (XtPointer)"right_ptr"}, + offset(menu.cursor_shape), XtRString, (XtPointer) "right_ptr"}, {XtNhorizontal, XtCHorizontal, XtRInt, sizeof(int), offset(menu.horizontal), XtRImmediate, (XtPointer)True}, {XtNuseBackingStore, XtCUseBackingStore, XtRBoolean, sizeof (Boolean), @@ -128,9 +128,8 @@ static void XlwMenuDestroy (Widget w); static void XlwMenuClassInitialize (void); static void Start (Widget w, XEvent *ev, String *params, Cardinal *num_params); -static void Drag (Widget w, XEvent *ev, String *params, Cardinal *num_params); -static void Select (Widget w, XEvent *ev, String *params, - Cardinal *num_params); +static void Drag (Widget w, XEvent *ev, String *params, Cardinal *num_params); +static void Select(Widget w, XEvent *ev, String *params, Cardinal *num_params); #ifdef NEED_MOTIF static XFontStruct *default_font_of_font_list (XmFontList); @@ -174,8 +173,7 @@ NULL, /* set_values_hook */ XtInheritSetValuesAlmost, /* set_values_almost */ NULL, /* get_values_hook */ - NULL, /* #### - should this be set for */ - /* grabs? accept_focus */ + NULL, /* #### - should this be set for grabs? accept_focus */ XtVersion, /* version */ NULL, /* callback_private */ xlwMenuTranslations, /* tm_table */ @@ -220,7 +218,7 @@ { /* If we got to this point, the colormap is full, so we're - going to try and get the next closest color. + going to try to get the next closest color. The algorithm used is a least-squares matching, which is what X uses for closest color matching with StaticColor visuals. */ @@ -250,10 +248,9 @@ nearest_delta = delta; } } - color_def->red = cells[nearest].red; + color_def->red = cells[nearest].red; color_def->green = cells[nearest].green; - color_def->blue = cells[nearest].blue; - + color_def->blue = cells[nearest].blue; free (cells); return XAllocColor (display, screen_colormap, color_def); } @@ -273,7 +270,7 @@ { mw->menu.new_stack_length *= 2; mw->menu.new_stack = - (widget_value**)XtRealloc ((char*)mw->menu.new_stack, + (widget_value**)XtRealloc ((char *)mw->menu.new_stack, mw->menu.new_stack_length * sizeof (widget_value*)); } @@ -283,13 +280,9 @@ static void pop_new_stack_if_no_contents (XlwMenuWidget mw) { - if (mw->menu.new_depth) - { - if (!mw->menu.new_stack [mw->menu.new_depth - 1]->contents) - { - mw->menu.new_depth -= 1; - } - } + if (mw->menu.new_depth && + !mw->menu.new_stack [mw->menu.new_depth - 1]->contents) + mw->menu.new_depth -= 1; } static void @@ -306,7 +299,7 @@ { mw->menu.old_stack_length *= 2; mw->menu.old_stack = - (widget_value**)XtRealloc ((char*)mw->menu.old_stack, + (widget_value**)XtRealloc ((char *)mw->menu.old_stack, mw->menu.old_stack_length * sizeof (widget_value*)); } @@ -315,9 +308,9 @@ static Boolean close_to_reference_time(Widget w, Time reference_time, XEvent *ev) { - return (reference_time && - (ev->xbutton.time - reference_time - < XtGetMultiClickTime (XtDisplay (w)))); + return + reference_time && + (ev->xbutton.time - reference_time < XtGetMultiClickTime (XtDisplay (w))); } /* Size code */ @@ -446,7 +439,7 @@ ntimes++) result = &percent[1]; - result = XtMalloc((ntimes * strlen(value)) + strlen(string) + 4); + result = XtMalloc ((ntimes * strlen(value)) + strlen(string) + 4); result[0] = '\0'; while ((percent = strchr(string, '%'))) @@ -583,7 +576,7 @@ val->toolkit_data = complete_name; val->free_toolkit_data = True; } - return ((XmString) val->toolkit_data); + return (XmString) val->toolkit_data; } /* Unused */ @@ -608,8 +601,7 @@ name, name, nameResource, 1, - NULL, 0 - ); + NULL, 0); if (!string) string = name; @@ -664,7 +656,7 @@ } val->free_toolkit_data = True; } - return (char*)val->toolkit_data; + return (char *) val->toolkit_data; } #endif /* !Motif */ @@ -673,8 +665,7 @@ * Code for drawing strings. */ static void -string_draw( - XlwMenuWidget mw, +string_draw(XlwMenuWidget mw, Window window, int x, int y, GC gc, @@ -683,7 +674,8 @@ #else char *string #endif -) { +) +{ #ifdef NEED_MOTIF XmStringDraw (XtDisplay (mw), window, mw->menu.font_list, @@ -716,14 +708,12 @@ * Low level code for drawing 3-D edges. */ static void -shadow_rectangle_draw ( - Display *dpy, +shadow_rectangle_draw (Display *dpy, Window window, GC top_gc, GC bottom_gc, int x, int y, unsigned width, unsigned height, - unsigned thickness - ) + unsigned thickness) { XPoint points [4]; @@ -794,8 +784,7 @@ shadow_draw (XlwMenuWidget mw, Window window, int x, int y, unsigned width, unsigned height, - shadow_type type - ) + shadow_type type) { Display *dpy = XtDisplay (mw); GC top_gc; @@ -835,47 +824,39 @@ if (etched) { unsigned half = thickness/2; - shadow_rectangle_draw ( - dpy, + shadow_rectangle_draw (dpy, window, top_gc, top_gc, x, y, width - half, height - half, - thickness - half - ); - shadow_rectangle_draw ( - dpy, + thickness - half); + shadow_rectangle_draw (dpy, window, bottom_gc, bottom_gc, x + half, y + half, width - half , height - half, - half - ); + half); } else { - shadow_rectangle_draw ( - dpy, + shadow_rectangle_draw (dpy, window, top_gc, bottom_gc, x, y, width, height, - thickness - ); + thickness); } } static void -arrow_decoration_draw ( - XlwMenuWidget mw, +arrow_decoration_draw (XlwMenuWidget mw, Window window, int x, int y, unsigned width, - Boolean raised - ) + Boolean raised) { Display *dpy = XtDisplay (mw); GC top_gc; @@ -896,12 +877,12 @@ if (raised) { - top_gc = mw->menu.shadow_bottom_gc; + top_gc = mw->menu.shadow_bottom_gc; bottom_gc = mw->menu.shadow_top_gc; } else { - top_gc = mw->menu.shadow_top_gc; + top_gc = mw->menu.shadow_top_gc; bottom_gc = mw->menu.shadow_bottom_gc; } @@ -918,15 +899,13 @@ points [3].x = x + thickness; points [3].y = y + width - thickness; - XFillPolygon ( - dpy, + XFillPolygon (dpy, window, select_gc, points, 4, Convex, - CoordModeOrigin - ); + CoordModeOrigin); /* left border */ points [0].x = x; @@ -966,13 +945,11 @@ } static void -toggle_decoration_draw ( - XlwMenuWidget mw, +toggle_decoration_draw (XlwMenuWidget mw, Window window, int x, int y, unsigned width, - Boolean set - ) + Boolean set) { Display *dpy = XtDisplay (mw); int thickness = mw->menu.shadow_thickness; @@ -988,27 +965,23 @@ * Fill internal area. */ if (set) - XFillRectangle ( - dpy, + XFillRectangle (dpy, window, select_gc, x + thickness, y + thickness, width - (2*thickness), - width - (2*thickness) - ); + width - (2*thickness)); shadow_draw(mw, window, x, y, width, width, type); } static void -radio_decoration_draw ( - XlwMenuWidget mw, +radio_decoration_draw (XlwMenuWidget mw, Window window, int x, int y, unsigned width, - Boolean enabled - ) + Boolean enabled) { Display *dpy = XtDisplay (mw); GC top_gc; @@ -1028,12 +1001,12 @@ if (enabled) { - top_gc = mw->menu.shadow_bottom_gc; + top_gc = mw->menu.shadow_bottom_gc; bottom_gc = mw->menu.shadow_top_gc; } else { - top_gc = mw->menu.shadow_top_gc; + top_gc = mw->menu.shadow_top_gc; bottom_gc = mw->menu.shadow_bottom_gc; } @@ -1146,20 +1119,17 @@ points, 4, Convex, - CoordModeOrigin - ); + CoordModeOrigin); } } static void -separator_decoration_draw ( - XlwMenuWidget mw, +separator_decoration_draw (XlwMenuWidget mw, Window window, int x, int y, unsigned width, Boolean vertical, - shadow_type type - ) + shadow_type type) { Display *dpy = XtDisplay (mw); GC top_gc; @@ -1241,11 +1211,9 @@ XDrawLine (dpy, window, top_gc, x, y + i, x + width, y + i); for (i = 0; i < bottom_line_thickness; i++) - XDrawLine ( - dpy, window, bottom_gc, + XDrawLine (dpy, window, bottom_gc, x, y + top_line_thickness + offset + i, - x + width, y + top_line_thickness + offset + i - ); + x + width, y + top_line_thickness + offset + i); y += (top_line_thickness + offset + bottom_line_thickness + 1); } @@ -1350,15 +1318,13 @@ } static void -label_button_size ( - XlwMenuWidget mw, +label_button_size (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, unsigned *toggle_width, unsigned *label_width, unsigned *bindings_width, - unsigned *height - ) + unsigned *height) { *height = (mw->menu.font_ascent + mw->menu.font_descent + 2 * mw->menu.vertical_margin + @@ -1371,8 +1337,7 @@ } static void -label_button_draw ( - XlwMenuWidget mw, +label_button_draw (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, Boolean highlighted, @@ -1381,8 +1346,7 @@ unsigned width, unsigned height, unsigned label_offset, - unsigned binding_tab - ) + unsigned binding_tab) { int y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; @@ -1392,32 +1356,26 @@ /* * Draw the label string. */ - string_draw ( - mw, + string_draw (mw, window, x + label_offset, y + y_offset, mw->menu.foreground_gc, - resource_widget_value (mw, val) - ); + resource_widget_value (mw, val)); } static void -push_button_size ( - XlwMenuWidget mw, +push_button_size (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, unsigned *toggle_width, unsigned *label_width, unsigned *bindings_width, - unsigned *height - ) + unsigned *height) { /* inherit */ - label_button_size ( - mw, val, in_menubar, + label_button_size (mw, val, in_menubar, toggle_width, label_width, bindings_width, - height - ); + height); /* key bindings to display? */ if (!in_menubar && val->key) @@ -1436,8 +1394,7 @@ } static void -push_button_draw ( - XlwMenuWidget mw, +push_button_draw (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, Boolean highlighted, @@ -1445,8 +1402,7 @@ int x, int y, unsigned width, unsigned height, unsigned label_offset, - unsigned binding_offset - ) + unsigned binding_offset) { int y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; GC gc; @@ -1474,13 +1430,11 @@ gc = mw->menu.inactive_gc; } - string_draw ( - mw, + string_draw (mw, window, x + label_offset, y + y_offset, gc, - resource_widget_value(mw, val) - ); + resource_widget_value(mw, val)); /* * Draw the keybindings @@ -1533,22 +1487,18 @@ } static void -cascade_button_size ( - XlwMenuWidget mw, +cascade_button_size (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, unsigned *toggle_width, unsigned *label_width, unsigned *arrow_width, - unsigned *height - ) + unsigned *height) { /* inherit */ - label_button_size ( - mw, val, in_menubar, + label_button_size (mw, val, in_menubar, toggle_width, label_width, arrow_width, - height - ); + height); /* we have a pull aside arrow */ if (!in_menubar) { @@ -1557,8 +1507,7 @@ } static void -cascade_button_draw ( - XlwMenuWidget mw, +cascade_button_draw (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, Boolean highlighted, @@ -1566,8 +1515,7 @@ int x, int y, unsigned width, unsigned height, unsigned label_offset, - unsigned binding_offset - ) + unsigned binding_offset) { shadow_type type; @@ -1600,14 +1548,12 @@ binding_offset = label_offset + s_width + mw->menu.shadow_thickness; } - arrow_decoration_draw ( - mw, + arrow_decoration_draw (mw, window, x + binding_offset + mw->menu.column_spacing, y + y_offset, arrow_height, - highlighted - ); + highlighted); } /* @@ -1637,29 +1583,24 @@ } static void -toggle_button_size ( - XlwMenuWidget mw, +toggle_button_size (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, unsigned *toggle_width, unsigned *label_width, unsigned *bindings_width, - unsigned *height - ) + unsigned *height) { /* inherit */ - push_button_size ( - mw, val, in_menubar, + push_button_size (mw, val, in_menubar, toggle_width, label_width, bindings_width, - height - ); + height); /* we have a toggle */ *toggle_width += toggle_decoration_height(mw) + mw->menu.column_spacing; } static void -toggle_button_draw ( - XlwMenuWidget mw, +toggle_button_draw (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, Boolean highlighted, @@ -1667,8 +1608,7 @@ int x, int y, unsigned width, unsigned height, unsigned label_tab, - unsigned binding_tab - ) + unsigned binding_tab) { int x_offset; int y_offset; @@ -1698,8 +1638,7 @@ } static void -radio_button_draw ( - XlwMenuWidget mw, +radio_button_draw (XlwMenuWidget mw, widget_value *val, Boolean in_menubar, Boolean highlighted, @@ -1707,8 +1646,7 @@ int x, int y, unsigned width, unsigned height, unsigned label_tab, - unsigned binding_tab - ) + unsigned binding_tab) { int x_offset; int y_offset; @@ -1802,8 +1740,7 @@ unsigned *toggle_width, unsigned *label_width, unsigned *rest_width, - unsigned *height - ) + unsigned *height) { *height = separator_decoration_height (mw, val); *label_width = 1; @@ -1819,8 +1756,7 @@ int x, int y, unsigned width, unsigned height, unsigned label_tab, - unsigned binding_tab - ) + unsigned binding_tab) { unsigned sep_width; @@ -1835,8 +1771,7 @@ y, sep_width, in_menubar, - separator_type(val->value) - ); + separator_type(val->value)); } static void @@ -1862,16 +1797,14 @@ unsigned *height ) { - - void (*function_ptr) ( - XlwMenuWidget _mw, + void (*function_ptr) (XlwMenuWidget _mw, widget_value *_val, Boolean _in_menubar, unsigned *_toggle_width, unsigned *_label_width, unsigned *_rest_width, - unsigned *_height - ); + unsigned *_height); + switch (menu_item_type (val)) { case TOGGLE_TYPE: @@ -1897,27 +1830,23 @@ break; } - (*function_ptr) ( - mw, + (*function_ptr) (mw, val, horizontal, toggle_width, label_width, rest_width, - height - ); + height); } static void -display_menu_item ( - XlwMenuWidget mw, +display_menu_item (XlwMenuWidget mw, widget_value *val, window_state *ws, XPoint *where, Boolean highlighted, Boolean horizontal, - Boolean just_compute - ) + Boolean just_compute) { int x = where->x /* + mw->menu.shadow_thickness */ ; @@ -1929,8 +1858,7 @@ unsigned height; unsigned label_tab; unsigned binding_tab; - void (*function_ptr) ( - XlwMenuWidget _mw, + void (*function_ptr) (XlwMenuWidget _mw, widget_value *_val, Boolean _in_menubar, Boolean _highlighted, @@ -1938,13 +1866,10 @@ int _x, int _y, unsigned _width, unsigned _height, unsigned _label_tab, - unsigned _binding_tab - ); + unsigned _binding_tab); - size_menu_item ( - mw, val, horizontal, - &toggle_width, &label_width, &binding_width, &height - ); + size_menu_item (mw, val, horizontal, + &toggle_width, &label_width, &binding_width, &height); if (horizontal) { @@ -1992,8 +1917,7 @@ return; } - (*function_ptr) ( - mw, + (*function_ptr) (mw, val, horizontal, highlighted, @@ -2001,8 +1925,7 @@ x, y, width, height, label_tab, - binding_tab - ); + binding_tab); } static void @@ -2013,8 +1936,8 @@ unsigned rest_width; unsigned height; unsigned max_toggle_width = 0; - unsigned max_label_width = 0; - unsigned max_rest_width = 0; + unsigned max_label_width = 0; + unsigned max_rest_width = 0; unsigned max_height = 0; int horizontal_p = mw->menu.horizontal && (level == 0); widget_value* val; @@ -2027,15 +1950,13 @@ for (val = mw->menu.old_stack [level]->contents; val; val = val->next) { - size_menu_item ( - mw, + size_menu_item (mw, val, horizontal_p, &toggle_width, &label_width, &rest_width, - &height - ); + &height); if (horizontal_p) { max_label_width += toggle_width + label_width + rest_width; @@ -2044,12 +1965,12 @@ } else { - if (toggle_width > max_toggle_width) - max_toggle_width = toggle_width; - if (label_width > max_label_width) - max_label_width = label_width; - if (rest_width > max_rest_width) - max_rest_width = rest_width; + if (max_toggle_width < toggle_width) + max_toggle_width = toggle_width; + if (max_label_width < label_width) + max_label_width = label_width; + if (max_rest_width < rest_width) + max_rest_width = rest_width; max_height += height; } } @@ -2057,9 +1978,9 @@ ws->height = max_height; ws->width = max_label_width + max_rest_width + max_toggle_width; ws->toggle_width = max_toggle_width; - ws->label_width = max_label_width; + ws->label_width = max_label_width; - ws->width += 2 * mw->menu.shadow_thickness; + ws->width += 2 * mw->menu.shadow_thickness; ws->height += 2 * mw->menu.shadow_thickness; } @@ -2235,7 +2156,7 @@ else { mw->menu.windows = - (window_state *) XtRealloc ((char*)mw->menu.windows, + (window_state *) XtRealloc ((char *) mw->menu.windows, n * sizeof (window_state)); start_at = mw->menu.windows_length; } @@ -2400,8 +2321,8 @@ int y = level == 0 ? ws->y : ws->y + mw->menu.shadow_thickness; relative_pos->x = ev->x_root - x; relative_pos->y = ev->y_root - y; - return (x < ev->x_root && ev->x_root < (int) (x + ws->width) - && y < ev->y_root && ev->y_root < (int) (y + ws->height)); + return (x < ev->x_root && ev->x_root < (int) (x + ws->width) && + y < ev->y_root && ev->y_root < (int) (y + ws->height)); } static Boolean @@ -2509,7 +2430,7 @@ xgcv.fill_style = FillStippled; xgcv.stipple = mw->menu.gray_pixmap; mw->menu.inactive_button_gc = XtGetGC ((Widget)mw, - (flags | GCFillStyle | GCStipple), + (flags | GCFillStyle | GCStipple), &xgcv); } @@ -2523,12 +2444,12 @@ XtReleaseGC ((Widget) mw, mw->menu.background_gc); XtReleaseGC ((Widget) mw, mw->menu.select_gc); /* let's get some segvs if we try to use these... */ - mw->menu.foreground_gc = (GC) -1; - mw->menu.button_gc = (GC) -1; - mw->menu.inactive_gc = (GC) -1; + mw->menu.foreground_gc = (GC) -1; + mw->menu.button_gc = (GC) -1; + mw->menu.inactive_gc = (GC) -1; mw->menu.inactive_button_gc = (GC) -1; - mw->menu.background_gc = (GC) -1; - mw->menu.select_gc = (GC) -1; + mw->menu.background_gc = (GC) -1; + mw->menu.select_gc = (GC) -1; } #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ @@ -2545,9 +2466,9 @@ int top_frobbed = 0, bottom_frobbed = 0; if (mw->menu.top_shadow_color == -1) - mw->menu.top_shadow_color = mw->core.background_pixel; + mw->menu.top_shadow_color = mw->core.background_pixel; if (mw->menu.bottom_shadow_color == -1) - mw->menu.bottom_shadow_color = mw->menu.foreground; + mw->menu.bottom_shadow_color = mw->menu.foreground; if (mw->menu.top_shadow_color == mw->core.background_pixel || mw->menu.top_shadow_color == mw->menu.foreground) @@ -2810,10 +2731,9 @@ /* mw->menu.cursor = XCreateFontCursor (display, mw->menu.cursor_shape); */ mw->menu.cursor = mw->menu.cursor_shape; - mw->menu.gray_pixmap = XCreatePixmapFromBitmapData (display, window, - (char *) gray_bits, - gray_width, - gray_height, 1, 0, 1); + mw->menu.gray_pixmap = + XCreatePixmapFromBitmapData (display, window, (char *) gray_bits, + gray_width, gray_height, 1, 0, 1); #ifdef NEED_MOTIF /* The menu.font_list slot came from the *fontList resource (Motif standard.) @@ -2932,7 +2852,7 @@ } release_drawing_gcs (mw); - release_shadow_gcs (mw); + release_shadow_gcs (mw); /* this doesn't come from the resource db but is created explicitly so we must free it ourselves. */ @@ -2982,8 +2902,8 @@ || newmw->menu.foreground != oldmw->menu.foreground /* For the XEditResource protocol, which may want to change the font. */ #ifdef NEED_MOTIF - || newmw->menu.font_list != oldmw->menu.font_list - || newmw->menu.font_list_2 != oldmw->menu.font_list_2 + || newmw->menu.font_list != oldmw->menu.font_list + || newmw->menu.font_list_2 != oldmw->menu.font_list_2 || newmw->menu.fallback_font_list != oldmw->menu.fallback_font_list #else || newmw->menu.font != oldmw->menu.font @@ -3013,7 +2933,7 @@ { XlwMenuWidget mw = (XlwMenuWidget)w; - mw->menu.windows [0].width = mw->core.width; + mw->menu.windows [0].width = mw->core.width; mw->menu.windows [0].height = mw->core.height; } @@ -3175,7 +3095,7 @@ } /* callback */ - XtCallCallbackList ((Widget)mw, mw->menu.select, (XtPointer)selected_item); + XtCallCallbackList ((Widget) mw, mw->menu.select, (XtPointer) selected_item); } @@ -3195,7 +3115,7 @@ mw->menu.next_release_must_exit = True; mw->menu.last_selected_val = NULL; - XtCallCallbackList ((Widget)mw, mw->menu.open, NULL); + XtCallCallbackList ((Widget) mw, mw->menu.open, NULL); size_menu (mw, 0); @@ -3204,14 +3124,18 @@ x -= borderwidth; y -= borderwidth; + if (x < borderwidth) - x = borderwidth; - if (x + w + 2 * borderwidth > WidthOfScreen (screen)) - x = WidthOfScreen (screen) - w - 2 * borderwidth; + x = borderwidth; + + if (x > WidthOfScreen (screen) - w - 2 * borderwidth) + x = WidthOfScreen (screen) - w - 2 * borderwidth; + if (y < borderwidth) - y = borderwidth; - if (y + h + 2 * borderwidth> HeightOfScreen (screen)) - y = HeightOfScreen (screen) - h - 2 * borderwidth; + y = borderwidth; + + if (y > HeightOfScreen (screen) - h - 2 * borderwidth) + y = HeightOfScreen (screen) - h - 2 * borderwidth; mw->menu.popped_up = True; XtConfigureWidget (XtParent (mw), x, y, w, h, @@ -3245,7 +3169,7 @@ xlw_unmunge_class_resize (Widget w) { if (w->core.widget_class->core_class.resize != XlwMenuResize) - w->core.widget_class->core_class.resize = XlwMenuResize; + w->core.widget_class->core_class.resize = XlwMenuResize; } #endif /* 0 */
--- a/lwlib/xlwmenu.h Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/xlwmenu.h Mon Aug 13 09:06:37 2007 +0200 @@ -10,35 +10,35 @@ #include "lwlib.h" /* Resource names used by the XlwMenu widget */ -#define XtNbuttonForeground (String) "buttonForeground" -#define XtCButtonForeground (String) "ButtonForeground" -#define XtNmargin (String) "margin" -#define XtNhorizontalSpacing (String) "horizontalSpacing" -#define XtNverticalSpacing (String) "verticalSpacing" -#define XtNarrowSpacing (String) "arrowSpacing" -#define XtNmenu (String) "menu" -#define XtCMenu (String) "Menu" -#define XtNopen (String) "open" -#define XtNselect (String) "select" -#define XtNmenuBorderWidth (String) "menuBorderWidth" -#define XtNhorizontal (String) "horizontal" -#define XtCHorizontal (String) "Horizontal" +#define XtNbuttonForeground "buttonForeground" +#define XtCButtonForeground "ButtonForeground" +#define XtNmargin "margin" +#define XtNhorizontalSpacing "horizontalSpacing" +#define XtNverticalSpacing "verticalSpacing" +#define XtNarrowSpacing "arrowSpacing" +#define XtNmenu "menu" +#define XtCMenu "Menu" +#define XtNopen "open" +#define XtNselect "select" +#define XtNmenuBorderWidth "menuBorderWidth" +#define XtNhorizontal "horizontal" +#define XtCHorizontal "Horizontal" #ifndef XtNcursor -#define XtNcursor (String) "cursor" +#define XtNcursor "cursor" #endif #ifndef XtCCursor -#define XtCCursor (String) "Cursor" +#define XtCCursor "Cursor" #endif #ifndef XtNuseBackingStore -#define XtNuseBackingStore (String) "useBackingStore" +#define XtNuseBackingStore "useBackingStore" #endif #ifndef XtCUseBackingStore -#define XtCUseBackingStore (String) "UseBackingStore" +#define XtCUseBackingStore "UseBackingStore" #endif -#define XtNbounceDown (String) "bounceDown" -#define XtCBounceDown (String) "BounceDown" -#define XtNresourceLabels (String) "resourceLabels" -#define XtCResourceLabels (String) "ResourceLabels" +#define XtNbounceDown "bounceDown" +#define XtCBounceDown "BounceDown" +#define XtNresourceLabels "resourceLabels" +#define XtCResourceLabels "ResourceLabels" /* Motif-compatible resource names */ #ifndef XmNshadowThickness
--- a/lwlib/xlwscrollbar.c Mon Aug 13 09:05:44 2007 +0200 +++ b/lwlib/xlwscrollbar.c Mon Aug 13 09:06:37 2007 +0200 @@ -116,83 +116,83 @@ #define offset(field) XtOffset(XlwScrollBarWidget, field) static XtResource resources[] = { - { (String) XmNforeground, (String) XmCForeground, XtRPixel, sizeof(Pixel), + { XmNforeground, XmCForeground, XtRPixel, sizeof(Pixel), offset(sb.foreground), XtRImmediate, (XtPointer) XtDefaultForeground }, - { (String) XmNtopShadowColor, (String) XmCTopShadowColor, XtRPixel, + { XmNtopShadowColor, XmCTopShadowColor, XtRPixel, sizeof(Pixel), offset(sb.topShadowColor), XtRImmediate, (XtPointer) ~0 }, - { (String) XmNbottomShadowColor, (String) XmCBottomShadowColor, XtRPixel, + { XmNbottomShadowColor, XmCBottomShadowColor, XtRPixel, sizeof(Pixel), offset(sb.bottomShadowColor), XtRImmediate, (XtPointer)~0 }, - { (String) XmNtopShadowPixmap, (String) XmCTopShadowPixmap, XtRPixmap, + { XmNtopShadowPixmap, XmCTopShadowPixmap, XtRPixmap, sizeof (Pixmap), offset(sb.topShadowPixmap), XtRImmediate, (XtPointer)None}, - { (String) XmNbottomShadowPixmap, (String) XmCBottomShadowPixmap, + { XmNbottomShadowPixmap, XmCBottomShadowPixmap, XtRPixmap, sizeof (Pixmap), offset(sb.bottomShadowPixmap), XtRImmediate, (XtPointer)None}, - { (String)XmNtroughColor, (String)XmCTroughColor, XtRPixel, sizeof(Pixel), + { XmNtroughColor, XmCTroughColor, XtRPixel, sizeof(Pixel), offset(sb.troughColor), XtRImmediate, (XtPointer)~0 }, - { (String)XmNshadowThickness, (String)XmCShadowThickness, XtRInt, + { XmNshadowThickness, XmCShadowThickness, XtRInt, sizeof(int), offset(sb.shadowThickness), XtRImmediate, (XtPointer)2 }, - { (String) XmNborderWidth, (String) XmCBorderWidth, XtRDimension, + { XmNborderWidth, XmCBorderWidth, XtRDimension, sizeof(Dimension), offset(core.border_width), XtRImmediate, (XtPointer)0 }, - { (String) XmNshowArrows, (String) XmCShowArrows, XtRBoolean, + { XmNshowArrows, XmCShowArrows, XtRBoolean, sizeof(Boolean), offset(sb.showArrows), XtRImmediate, (XtPointer)True }, - { (String) XmNinitialDelay, (String) XmCInitialDelay, XtRInt, sizeof(int), + { XmNinitialDelay, XmCInitialDelay, XtRInt, sizeof(int), offset(sb.initialDelay), XtRImmediate, (XtPointer) 250 }, - { (String) XmNrepeatDelay, (String) XmCRepeatDelay, XtRInt, sizeof(int), + { XmNrepeatDelay, XmCRepeatDelay, XtRInt, sizeof(int), offset(sb.repeatDelay), XtRImmediate, (XtPointer) 50 }, - { (String) XmNorientation, (String) XmCOrientation, XtROrientation, + { XmNorientation, XmCOrientation, XtROrientation, sizeof(unsigned char), offset(sb.orientation), XtRImmediate, (XtPointer) XmVERTICAL }, - { (String) XmNminimum, (String) XmCMinimum, XtRInt, sizeof(int), + { XmNminimum, XmCMinimum, XtRInt, sizeof(int), offset(sb.minimum), XtRImmediate, (XtPointer) 0}, - { (String) XmNmaximum, (String) XmCMaximum, XtRInt, sizeof(int), + { XmNmaximum, XmCMaximum, XtRInt, sizeof(int), offset(sb.maximum), XtRImmediate, (XtPointer) 100}, - { (String) XmNvalue, (String) XmCValue, XtRInt, sizeof(int), + { XmNvalue, XmCValue, XtRInt, sizeof(int), offset(sb.value), XtRImmediate, (XtPointer) 0}, - { (String) XmNsliderSize, (String) XmCSliderSize, XtRInt, sizeof(int), + { XmNsliderSize, XmCSliderSize, XtRInt, sizeof(int), offset(sb.sliderSize), XtRImmediate, (XtPointer) 10}, - { (String) XmNincrement, (String) XmCIncrement, XtRInt, sizeof(int), + { XmNincrement, XmCIncrement, XtRInt, sizeof(int), offset(sb.increment), XtRImmediate, (XtPointer) 1}, - { (String)XmNpageIncrement, (String)XmCPageIncrement, XtRInt, sizeof(int), + { XmNpageIncrement, XmCPageIncrement, XtRInt, sizeof(int), offset(sb.pageIncrement), XtRImmediate, (XtPointer) 10}, - { (String) XmNvalueChangedCallback, (String) XmCValueChangedCallback, + { XmNvalueChangedCallback, XmCValueChangedCallback, XtRCallback, sizeof(XtPointer), offset(sb.valueChangedCBL), XtRCallback, NULL}, - { (String) XmNincrementCallback, (String) XmCIncrementCallback, + { XmNincrementCallback, XmCIncrementCallback, XtRCallback, sizeof(XtPointer), offset(sb.incrementCBL), XtRCallback, NULL}, - { (String) XmNdecrementCallback, (String) XmCDecrementCallback, + { XmNdecrementCallback, XmCDecrementCallback, XtRCallback, sizeof(XtPointer), offset(sb.decrementCBL), XtRCallback, NULL}, - { (String) XmNpageIncrementCallback, (String) XmCPageIncrementCallback, + { XmNpageIncrementCallback, XmCPageIncrementCallback, XtRCallback, sizeof(XtPointer), offset(sb.pageIncrementCBL), XtRCallback, NULL}, - { (String) XmNpageDecrementCallback, (String) XmCPageDecrementCallback, + { XmNpageDecrementCallback, XmCPageDecrementCallback, XtRCallback, sizeof(XtPointer), offset(sb.pageDecrementCBL), XtRCallback, NULL}, - { (String) XmNtoTopCallback, (String) XmCToTopCallback, XtRCallback, + { XmNtoTopCallback, XmCToTopCallback, XtRCallback, sizeof(XtPointer), offset(sb.toTopCBL), XtRCallback, NULL}, - { (String) XmNtoBottomCallback, (String) XmCToBottomCallback, XtRCallback, + { XmNtoBottomCallback, XmCToBottomCallback, XtRCallback, sizeof(XtPointer), offset(sb.toBottomCBL), XtRCallback, NULL}, - { (String) XmNdragCallback, (String) XmCDragCallback, XtRCallback, + { XmNdragCallback, XmCDragCallback, XtRCallback, sizeof(XtPointer), offset(sb.dragCBL), XtRCallback, NULL}, - { (String) XmNknobStyle, (String) XmCKnobStyle, XtRString, sizeof(char *), + { XmNknobStyle, XmCKnobStyle, XtRString, sizeof(char *), offset(sb.knobStyle), XtRImmediate, NULL}, - { (String) XmNarrowPosition, (String) XmCArrowPosition, XtRString, + { XmNarrowPosition, XmCArrowPosition, XtRString, sizeof(char *), offset(sb.arrowPosition), XtRImmediate, NULL}, }; @@ -234,13 +234,13 @@ ** */ static XtActionsRec actions[] = { - {(String) "Select", Select}, - {(String) "PageDownOrRight",PageDownOrRight}, - {(String) "PageUpOrLeft", PageUpOrLeft}, - {(String) "Drag", Drag}, - {(String) "Release", Release}, - {(String) "Jump", Jump}, - {(String) "Abort", Abort}, + {"Select", Select}, + {"PageDownOrRight", PageDownOrRight}, + {"PageUpOrLeft", PageUpOrLeft}, + {"Drag", Drag}, + {"Release", Release}, + {"Jump", Jump}, + {"Abort", Abort}, }; /************************************************************************ @@ -267,7 +267,7 @@ /* core_class fields */ { /* superclass */ (WidgetClass) &coreClassRec, - /* class_name */ (String) "XlwScrollBar", + /* class_name */ "XlwScrollBar", /* widget_size */ sizeof(XlwScrollBarRec), /* class_initialize */ NULL, /* class_part_init */ NULL, @@ -582,7 +582,7 @@ what X uses for closest color matching with StaticColor visuals. */ int nearest, x; - unsigned long nearest_delta, trial_delta; + unsigned long nearest_delta = ULONG_MAX; int no_cells = XDisplayCells (display, XDefaultScreen (display)); /* Don't use alloca here because lwlib doesn't have the @@ -594,17 +594,17 @@ XQueryColors (display, screen_colormap, cells, no_cells); - for (x = 0; x < no_cells; x++) + for (nearest = 0, x = 0; x < no_cells; x++) { long dred = (color_def->red >> 8) - (cells[x].red >> 8); long dgreen = (color_def->green >> 8) - (cells[x].green >> 8); long dblue = (color_def->blue >> 8) - (cells[x].blue >> 8); - trial_delta = dred * dred + dgreen * dgreen + dblue * dblue; + unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue; - if (x == 0 || trial_delta < nearest_delta) + if (delta < nearest_delta) { nearest = x; - nearest_delta = trial_delta; + nearest_delta = delta; } } color_def->red = cells[nearest].red; @@ -1073,7 +1073,6 @@ if (w->sb.value > w->sb.maximum - w->sb.sliderSize) w->sb.value = w->sb.maximum - w->sb.sliderSize; - } static int
--- a/man/ediff.texi Mon Aug 13 09:05:44 2007 +0200 +++ b/man/ediff.texi Mon Aug 13 09:06:37 2007 +0200 @@ -790,17 +790,16 @@ @code{ediff-window-setup-function} for details on how to make either of these modes the default one. -This function can also be invoked from Ediff menus. However, in this case, -it will affect only @emph{new} Ediff sessions, not the currently running -ones. +This function can also be invoked from the Menubar. However, in some +cases, the change will take place only after you execute one of the Ediff +commands, such as going to the next difference or redisplaying. @item ediff-toggle-use-toolbar @findex ediff-toggle-use-toolbar -Available in XEmacs only. The Ediff toolbar provides quick access to some -of the common Ediff functions. This function toggles the display of the -toolbar. If invoked from the menu, the function will not have immediate -effect---you will have to perform an action that changes Ediff window -configuration to see the effect (e.g., you could try to change the window -split). +Available in XEmacs only (in a forthcoming version). The Ediff toolbar +provides quick access to some of the common Ediff functions. This function +toggles the display of the toolbar. If invoked from the menubar, the function +may take sometimes effect only after you execute an Ediff command, such as +going to the next difference. @item ediff-use-toolbar-p @vindex ediff-use-toolbar-p @@ -1287,7 +1286,8 @@ in one frame, is done by @code{ediff-setup-windows-plain}, which is the default on a non-windowing display (or in an xterm window). In fact, under Emacs, you can switch freely between these two setups by executing -the command @code{ediff-toggle-multiframe} using the Minibuffer. +the command @code{ediff-toggle-multiframe} using the Minibuffer of the +Menubar. @findex ediff-setup-windows-multiframe @findex ediff-setup-windows-plain @findex ediff-toggle-multiframe
--- a/man/lispref/sequences.texi Mon Aug 13 09:05:44 2007 +0200 +++ b/man/lispref/sequences.texi Mon Aug 13 09:06:37 2007 +0200 @@ -400,6 +400,7 @@ a @result{} [0 0 0 0 0 0 0] @end group + @group (setq s "When in the course") @result{} "When in the course"
--- a/man/tm/tm-vm-en.texi Mon Aug 13 09:05:44 2007 +0200 +++ b/man/tm/tm-vm-en.texi Mon Aug 13 09:06:37 2007 +0200 @@ -26,7 +26,7 @@ @titlepage @title tm-vm Manual (English Version) @author by Oscar Figueiredo -@code{$Id: tm-vm-en.texi,v 1.2 1997/01/04 23:05:28 steve Exp $} +@code{$Id: tm-vm-en.texi,v 1.3 1997/01/11 20:14:34 steve Exp $} @page tm-vm is part of the TM Package. @@ -69,8 +69,8 @@ @node Overview, Install, Top, Top @chapter Overview -tm-vm is an interface between TM (@xref{Top,TM,,tm-en,TM Manual}.) and the VM -mail user agent (@xref{Top,VM,,vm,VM Manual}.). +tm-vm is an interface between TM (@pxref{Top,TM,,tm-en,TM Manual}.) and the VM +mail user agent (@pxref{Top,VM,,vm,VM Manual}.). In its current version VM does not provide functionality to support the MIME standard. tm-vm integrates the TM package into VM so as to give you @@ -79,8 +79,8 @@ @section Mail Reading Features -tm-vm tries to integrate as transparently as possible within VM so that -MIME messages appear to you the same as plain messages. +tm-vm tries to integrate as transparently as possible with VM so that +MIME messages appear to you just like plain messages. tm-vm detects MIME messages when you try to view them and, if automatic MIME previewing is enabled (the default), then it automatically parses @@ -102,16 +102,16 @@ @item Insert another message @item -Insert a voice sample recorded from a micro attached to the computer +Insert a voice sample recorded from a microphone attached to the computer @item Enclose message sections as PGP encrypted @end itemize -and much more. For details @xref{tm-edit,,MIME Editor,tm-en,TM Manual}. +and much more. For details, @pxref{tm-edit,,MIME Editor,tm-en,TM Manual}. When you reply to a message citing the original and tm-vm is active, tm-vm will insert the contents of the MIME-Preview buffer in the reply -buffer. You can also insert the raw message if you want @pxref{Usage}. +buffer. You can also insert the raw message if you want (@pxref{Usage}). @@ -123,19 +123,19 @@ To take advantage of the benefits of tm-vm, you need to have VM and tm already installed. -VM is part of XEmacs distributions and if you're running XEmacs you +VM is part of XEmacs distributions and so if you're running XEmacs you don't need to install it. If you're running Emacs, you will need to -install VM. Official distribution site is -@file{ftp://ftp.uu.net/networking/mail/vm/} +install VM. The official VM distribution site is +@file{ftp://ftp.uu.net/networking/mail/vm/}. If you're reading this manual then there is a pretty good chance you -already retrieved a recent version of tm. Official distribution site is -@file{ftp://ftp.jaist.ac.jp/pub/GNU/mime/}Follow the installation procedure -for tm as it is described in the documentation. +already have a recent version of tm. The official tm distribution site +is @file{ftp://ftp.jaist.ac.jp/pub/GNU/mime/}. Follow the installation +procedure for tm as described in the documentation. -Once these steps are completed, tm-vm installation is very simple you +Once these steps are completed, tm-vm installation is very simple. You just need to insert the following lines in your VM configuration file -(generally .vm): +(generally @file{.vm}): @lisp (require 'mime-setup) @@ -143,9 +143,9 @@ @end lisp That's it. You are ready to read and send multimedia mail! You may also -want to customize some aspects of tm-vm behaviour @pxref{Customization} +want to customize some aspects of tm-vm behaviour (@pxref{Customization}). -If you use BBDB you must load tm-vm @strong{after} BBDB. Please be sure +If you use BBDB, you must load tm-vm @strong{after} BBDB. Please be sure to respect the following sequence in your initialization file: @lisp @@ -196,14 +196,14 @@ @item @cindex MIME Preview buffer @emph{the MIME Preview buffer}: displays a MIME parsed version of the -message. It is generally what you want to see as it is more readable +message. It is generally what you want to see as it is more readable. @end itemize -The reasons why there are two different buffers are due to current VM -implementation that turns tm integration difficult. However we try hard -to make the MIME Preview buffer act as if it were the real VM message -buffer by making all bindings act the same in Preview buffer as in -folder buffer. +There are two different buffers due to the current VM implementation +that makes TM/VM integration difficult. However, we try hard to make the +MIME Preview buffer act as if it were the real VM message buffer by +making all bindings act the same in the Preview buffer as in the folder +buffer. @code{tm-vm/toggle-preview-mode} (bound to @kbd{M-t}) lets you toggle @@ -213,24 +213,24 @@ @node Composing MIME mail, Printing, Reading MIME mail, Usage @section Composing MIME mail -Regardless of current preview mode tm-vm activates the mime-editor mode -each time you compose a mail message (new message, reply or -forward). Functionalities provided by the mime-editor are described in -@xref{tm-edit,,MIME Editor,tm-en,TM Manual}. +Regardless of the current preview mode, tm-vm activates the mime-editor +mode each time you compose a mail message (new message, reply or +forward). @xref{tm-edit,,MIME Editor,tm-en,TM Manual}, for details on +mime-editor mode. -When you reply to a message tm-vm will insert the contents of the +When you reply to a message, tm-vm will insert the contents of the @strong{decoded} message if there exists a MIME Preview buffer. This is -generally what you want for quoted-printable text for instance. Inline +generally what you want for quoted-printable text, for instance. Inline images are removed from the reply. If for some reason you want the @strong{raw} message to be inserted instead of the decoded one you have to kill the MIME Preview buffer first. You do this with @code{kill-buffer} (bound to @kbd{C-x k}) in the MIME Preview -buffer. You can also toggle automatic preview off if it was on with +buffer. You can also toggle automatic preview off, if it was on, with @kbd{M-t}. -Forwarding a message inserts always inserts the raw message with its own -MIME headers. The recipient will thus receive exactly the same message -as you did. +Forwarding a message always inserts the raw message with its own MIME +headers. The recipient will thus receive exactly the same message as you +did. @@ -247,7 +247,7 @@ @section Notes about BBDB Usage BBDB, the Big Brother's Database, should operate normally with -VM/tm-vm. You must ensure however that tm-vm is loaded @strong{after} +VM/tm-vm. You must ensure, however, that tm-vm is loaded @strong{after} BBDB has installed its hooks. Therefore be sure to respect the following sequence in your initialization file: @lisp @@ -262,31 +262,33 @@ @chapter Customization Several variables let you adapt the behavior of tm-vm to your needs. You -can set this variables to the appropriate value in your initialization +can set these variables to the appropriate value in your initialization file prior to loading tm. @defopt tm-vm/automatic-mime-preview -If non-nil then tm-vm will start in automatic mime preview mode -(@pxref{Usage}). Default t. +If non-@code{nil} then tm-vm will start in automatic mime preview mode +(@pxref{Usage}). Default @code{t}. @end defopt @defopt tm-vm/strict-mime -If non-nil tm-vm will automatically decode MIME messages only. MIME -messages have a MIME-Version header. If nil then all messages will be -decoded and viewed in the MIME Preview buffer regardless of the -existence of a MIME-Version header. Default t. +If non-@code{nil} tm-vm will automatically decode MIME messages +only. MIME messages have a @code{MIME-Version} header. If @code{nil} +then all messages will be decoded and viewed in the MIME Preview buffer +regardless of the existence of a @code{MIME-Version} header. Default +@code{t}. @end defopt @defopt tm-vm/use-xemacs-popup-menu -If this is non nil and you're running XEmacs, tm-vm will install a +If this is non-@code{nil} and you're running XEmacs, tm-vm will install a menu of MIME commands as a mode popup (@key{Button 3}) in message -composition buffers. Default t. +composition buffers. Default @code{t}. @end defopt @defopt tm-vm/use-ps-print -If this is non-nil then MIME messages will be printed in Postscript -using the ps-print package. By default it is t for non MULE-Emacses. +If this is non-@code{nil} then MIME messages will be printed in +Postscript using the ps-print package. By default it is @code{t} for +non-MULE Emacses. @end defopt @defvar tm-vm/select-message-hook @@ -305,7 +307,7 @@ tm-vm runs the hooks in this list after a Mail mode buffer has been created to send a digest in multipart/digest type format. If @code{vm-digest-send-type} is @samp{rfc1521}, tm-vm runs this hook -instead of @code{vm-send-digest-hook}." +instead of @code{vm-send-digest-hook}. @end defvar @section X-Faces
--- a/man/viper.texi Mon Aug 13 09:05:44 2007 +0200 +++ b/man/viper.texi Mon Aug 13 09:06:37 2007 +0200 @@ -1666,9 +1666,10 @@ @item vip-search-wrap-around t @itemx :se ws (:se wrapscan) If not @code{nil}, search wraps around the end/beginning of buffer. -@item vip-adjust-window-after-search t -If not @code{nil}, window will be pulled up or down, as appropriate, if -search lands near the first (or last) line of the window. +@item vip-search-scroll-threshold 2 +In search lands within this many lines of the window top or bottom, the +window will be scrolled up or down by about 1/7-th of its size, to reveal +the context. If the value is negative---don't scroll. @item vip-tags-file-name "TAGS" The name of the file used as the tag table. @item vip-re-query-replace nil @@ -1878,7 +1879,7 @@ @vindex @code{vip-shift-width} @vindex @code{buffer-read-only} @vindex @code{vip-search-wrap-around} -@vindex @code{vip-adjust-window-after-search} +@vindex @code{vip-search-scroll-threshold} @vindex @code{vip-search-face} @vindex @code{vip-tags-file-name} @vindex @code{vip-re-query-replace}
--- a/man/w3.texi Mon Aug 13 09:05:44 2007 +0200 +++ b/man/w3.texi Mon Aug 13 09:06:37 2007 +0200 @@ -1,5 +1,5 @@ \input texinfo -@setfilename ../info/w3.info +@setfilename w3.info @settitle Emacs-W3 User's Manual @iftex @finalout @@ -38,7 +38,7 @@ @sp 4 @center Third Edition, Emacs-W3 Version 3.0 @sp 1 -@center August 1996 +@center December 1996 @sp 5 @center William M. Perry @center @i{wmperry@@cs.indiana.edu} @@ -61,7 +61,7 @@ @menu * Introduction:: Overview of Emacs-W3. -* Starting Up:: What happens when you start Emacs-W3 +* Getting Started:: Getting up and running with Emacs-W3 * Basic Usage:: Basic movement and usage of Emacs-W3. * Compatibility:: Explanation of compatibility with other web browsers. @@ -88,102 +88,22 @@ @end menu @end ifinfo -@node Introduction, Starting Up, Top, Top +@node Introduction, Getting Started, Top, Top @chapter Introduction @cindex World Wide Web -Emacs-W3 is an Emacs subsystem that allows the user to browse the wonderful -World Wide Web (WWW). -The World Wide Web was begun at the CERN physics institute in -Switzerland in 1991. The project was initiated by Tim Berners-Lee -(@i{timbl@@w3.org}) for distributing data between different research -groups effectively. - - -The Web has since grown into the most advanced information system -currently on the internet. It is now a global hypertext system with -servers and @dfn{browsers} (programs written to interpret the hypertext -language and display it correctly, and allow the user to follow links) -exist for all major platforms (VMS, Windows, DOS, Unix, VM, NeXTstep, -Amiga, and Macintosh). - -The basic concepts used in the Web are @b{hypertext} and @b{hypermedia}. -Hypertext is the same as regular text, with one exception---it can -contain links (cross-references) to other textual documents. Hypermedia -is slightly different---it can contain links to other forms of media -(movies, sounds, interactive programs, etc.). - -WWW also allows searches of indices that are located anywhere on the -network; in this respect, it mirrors certain capabilities found in both -WAIS and Gopher. -@iftex -@section Client Side View of WWW -@end iftex -@ifinfo -@center ---------------- -@center CLIENT SIDE VIEW -@center ---------------- -@end ifinfo -The WWW consists of documents and links. Indexes are special documents -which, rather than being read, may be searched. The result of such a -search is another @i{virtual} document containing links to the documents -found. A simple protocol, Hypertext Transfer Protocol or @i{HTTP}, is -used to allow a browser program to request a keyword search by a remote -information server. - - -The web contains documents in many formats. Those documents which are -hypertext, (real or virtual) contain links to other documents, or places -within documents. All documents, whether real, virtual or indexes, look -similar to the reader and are contained within the same addressing -scheme. -@iftex -@section Information Provider View of WWW -@end iftex -@ifinfo -@center ------------------------- -@center INFORMATION PROVIDER VIEW -@center ------------------------- -@end ifinfo -WWW browsers can access many existing data systems via existing -protocols (FTP, NNTP) or via HTTP and a gateway. In this way, the -critical mass of data is quickly exceeded, and the increasing use of the -system by readers and information suppliers encourage each other. - -Providing information is as simple as running a WWW server and pointing -it at an existing directory structure. The server automatically -generates a hypertext view of the files to guide the user around. - - -To personalize it, a few @b{SGML} hypertext files can be written to give -an even more friendly view. Also, any file available by anonymous FTP, -or any internet newsgroup can be immediately linked into the web. The -small start-up effort is designed to allow open contributions. At the -other end of the scale, large information providers may provide an HTTP -server with full text or keyword indexing. This may allow access to a -large existing database without changing the way that database is -managed. Such gateways have already been made into Oracle(tm), WAIS, -and Digital's VMS/Help systems, to name but a few. - - -The WWW model gets over the frustrating incompatibilities of data format -between suppliers and reader by allowing negotiation of format between a -smart browser and a smart server. This provides a basis for extension -into multimedia, and allow those who share application standards to make -full use of them across the web. - +:: WORK :: Basic info on what Emacs-W3 is, including copyrights, etc. @ifinfo -Here is some more specific information about what Emacs-W3 does and does -not understand: +Here is some more specific information about what languages and +protocols Emacs-W3 supports. @menu -* Markup Languages Supported:: The different markup languages that - Emacs-W3 understands natively. -* Supported Protocols:: The different network protocols that - Emacs-W3 speaks to. +* Markup Languages Supported:: Markup languages supported by Emacs-W3 +* Stylesheets:: Stylesheet languages supported by Emacs-W3 +* Supported Protocols:: Network protocols supported by Emacs-W3 @end menu @end ifinfo -@node Markup Languages Supported, Supported Protocols, Introduction, Introduction +@node Markup Languages Supported, Stylesheets, Introduction, Introduction @chapter Supported Markup Languages Several different markup languages, and various extensions to those languages, are supported by Emacs-W3. @@ -195,31 +115,14 @@ @iftex @section HTML 2.0 @end iftex -The Hypertext Markup Language, or HTML, is composed of a set of elements -that define a document and guide its display. An HTML element may -include a name, some attributes and some text or hypertext, and appears -in an HTML document as <tag_name>text</tag_name>, <tag_name -attribute_name=argument>text</tag_name>, or just <tag_name>. - - -For example: @samp{<title>My Useful Document</title>}, and @samp{<pre -width=60> A lot of text here. </pre>}. +@cindex HTML 2.0 -An HTML document is composed of a single element: <html>...</html>, that -is, in turn, composed of head and body elements: <head>...</head>, and -<body>...</body>. To allow older HTML documents to remain readable, -<html>, <head>, and <body> are actually optional within HTML -documents. - -All the tags and attributes of HTML are fully supported in Emacs-W3. - -The full HTML 2.0 specification is available at any RFC -archive@footnote{ftp://ds.internic.net/}. It is RFC 1866. - +:: WORK :: Reference to the HTML 2.0 RFC +:: WORK :: Basic explanation of HTML, tag structure, etc. @ifinfo @center ---------- -@center HTML 3.0 +@center HTML 3.2 @center ---------- @end ifinfo @iftex @@ -232,28 +135,6 @@ @ifinfo @center ---------- -@center Netscape-HTML -@center ---------- -@end ifinfo -@iftex -@section Netscape-HTML -@end iftex -I hate to say it, but I broke down and actually included some of the -Netscape extensions into Emacs-W3. The thing I hate to say even more, -is that most of the uglier things in Netscape-HTML are now in the HTML -3.2 specification. All hail the W3Cs lack of backbone. - -@table @b -@item <center>...</center> -This ugly, ill-thought-out alternative to the HTML 3.0 align attribute on -headers and paragraphs was included for compatibility, and as an example -of how @b{not} to do things. -@item <isindex> -The isindex tag can now take a prompt attribute, to get rid of the -default 'This is a searchable index' label. -@end table -@ifinfo -@center ---------- @center SGML Features @center ---------- @end ifinfo @@ -263,7 +144,9 @@ @cindex SGML Features @cindex Entity Definitions @cindex Marked Sections + :: WORK :: Document marked sections, SGML features + @ifinfo @center ---------- @center Extras @@ -276,29 +159,12 @@ @cindex Fluff @cindex Pomp & Circumstance There are several different markup elements that are not officially part -of HTML or HTML 3.0 that Emacs-W3 supports. These are either items that -were dropped from HTML 3.0 after I had implemented them, or experimental -parts of HTML that should not be counted as "official" or long -lived. +of HTML or HTML 3.2 that Emacs-W3 supports. These are either items that +were dropped from HTML 3.@var{x} after I had implemented them, things I +find just completely hilarious, or experimental parts of HTML that +should not be counted as "official" or long lived. @itemize @bullet @item -More <HR> improvements. Text can be added into a horizontal rule by -using the LABEL and TEXTALIGN attributes. - -@example -<hr label="testing" textalign="right"> -yields -----------------------------------------------------------testing- - -<hr label="testing" textalign="center"> -yields ------------------------------testing------------------------------ - -<hr label="testing" textalign="left"> -yields --Testing---------------------------------------------------------- -@end example -@item FLAME support. For truly interesting dynamic documents. This is replaced with a random quote from Mr. Angry (see @kbd{M-x flame} for a sample). @@ -333,12 +199,12 @@ @item <peek>....</peek> @item <poke>...</poke> Need more control over screen layout in HTML? Well, here ya go. - +n Actually, <peek> could almost be considered useful. The VARIABLE attribute can be used to insert the value of an emacs variable into the current document. Things like 'Welcome to my page, <peek -variable=user-mail-address>' can be useful in freaking people -out. +variable=user-mail-address>' can be useful in spreading fear, +uncertainty, and doubt among users. @item <yogsothoth> @cindex Gates Bill @cindex Yogsothoth @@ -350,7 +216,17 @@ Causes the enclosed text to .... ooops that one made it in. @end table @end itemize -@node Supported Protocols, , Markup Languages Supported, Introduction + +@node Stylesheets, Supported Protocols, Markup Languages Supported,Introduction +@chapter Stylesheets +@cindex Stylesheets +@cindex Cascading Style Sheets +@cindex CSS +@cindex DSSSL +:: WORK :: Document CSS support +:: WORK :: Document DSSSL support + +@node Supported Protocols, , Stylesheets, Introduction @chapter Supported Protocols @cindex Network Protocols @cindex Protocols Supported @@ -359,19 +235,20 @@ @table @b @item Usenet News Can either display an entire newsgroup or specific articles by -Message-ID: header. This supports a unix-style .newsrc file, so the -user does not see articles they have read using another newsreader, but -due to how news URLs work, the .newsrc file cannot be updated -reliably. +Message-ID: header. Instead of rewriting a newsreader, this integrates +with the Gnus newsreader. It requires at least Gnus 5.0, but it is +always safest to use the latest version. Gnus supports some very +advanced features, including virtual newsgroups, mail and news +integration, and reading news from multiple servers. @inforef{Gnus, +Top,gnus}, for more info. To be more in line with the other URL schemes, the hostname and port of an NNTP server can be specified. URLs of the form -news://hostname:port/messageID work, but will not work in most other +news://hostname:port/messageID work, but might not work in some other browsers. @item HTTP -Supports the HTTP/0.9, HTTP/1.0, and HTTP/1.1 protocols. Fully -MIME-compliant with regards to HTTP/1.0. +Supports the HTTP/0.9, HTTP/1.0, and parts of the HTTP/1.1 protocols. @item Gopher Support for all gopher types, including CSO queries. @item Gopher+ @@ -379,63 +256,85 @@ HTML 3.0 FORMS and submitting them back to the server. @item FTP FTP is handled by either ange-ftp or efs. +@inforef{Ange-FTP,Top,ange-ftp}, for more information on Ange-FTP, or +@inforef{EFS, Top,efs}, for information on EFS. @item Local files -Local files are handled, and MIME content-types are derived from the -file extensions. -@item Telnet -Telnet is handled by running the Emacs Lisp function @code{telnet}, or -spawning an xterm running telnet. -@item TN3270 -TN3270 is handled by running a tn3270 program in an Emacs buffer, or -spawning an xterm running tn3270. +Local files are of course handled, and MIME content-types are derived +from the file extensions. +@item Telnet, tn3270, rlogin +Telnet, tn3270, and rogin are handled by running the appropriate program +in an emacs buffer, or running an external process. @item Mailto -Causes a mail message to be started to a specific address. +Causes a mail message to be started to a specific address. Supports the +Netscape @i{extensions} to specify arbitrary headers on the message. @item mailserver A more powerful version of mailto, which allows the author to specify the subject and body text of the mail message. This type of link is never fully executed without user confirmation, because it is possible to insert insulting or threatening (and possibly illegal) data into the -message. The mail message is displayed, and the user must type 'yes' to -send it. +message. The mail message is displayed, and the user must confirm the +message before it is sent. @item X-exec A URL can cause a local executable to be run, and its output interpreted as if it had come from an HTTP server. This is very useful, but is -still an experimental protocol, hence the X- prefix. +still an experimental protocol, hence the X- prefix. This URL protocol +is deprecated, but might be useful in the future. +@item NFS +Retrieves information over NFS. This requires that your operating +system support auto-mounting of NFS volumes. +@item Finger +Retrieves information about a user via the 'finger' protocol, as defined +in RFC ????? :: WORK :: +@item Info +Creates a link to an GNU-style info file. @inforef{Info,Top,info}, for more +information on the Info format. @item SSL SSL requires a set of patches to the Emacs C code and SSLRef 2.0, or an external program to run in a subprocess (similar to the @file{tcp.el} package that comes with GNUS. @xref{Installing SSL} -@item Secure HTTP -Work is in progress to add support for the Secure HTTP specification -from Enterprise Information Technologies. The specification for SHTTP -can be found on EIT's web server at -http://www.commerce.net/information/standards/drafts/shttp.txt. @end table -@node Starting Up, Basic Setup, Introduction, Top -@comment node-name, next, previous, up -@chapter Starting Up -@cindex Starting Up Emacs-W3 +@node Getting Started, Getting Emacs, Introduction, Top +@chapter Getting Started +@cindex Clueless in Seattle +@cindex Getting Started This section of the manual deals with getting, compiling, and configuring @i{Emacs-W3}. +:: WORK :: Introduction to 'Getting Started' + @ifinfo @menu -* Basic Setup:: Basic setup that everyone needs to do -* Firewalls:: How to set Emacs-W3 up to use a particular - firewall setup. +* Getting Emacs:: Where to get Emacs +* Getting Emacs-W3:: Where to get Emacs-W3 +* Basic Setup:: Basic setup that most people want to do +* Firewalls:: Integrating Emacs-W3 with a firewall setup. * Proxy Gateways:: Using a proxy server @end menu @end ifinfo -@node Basic Setup, Firewalls, Starting Up, Starting Up -@comment node-name, next, previous, up +@node Getting Emacs, Getting Emacs-W3, Getting Started, Getting Started +@section Getting Emacs +@cindex Getting Emacs +@cindex Source code availability +:: WORK :: Explanation of Emacs, XEmacs, and where to get both + +@node Getting Emacs-W3, Basic Setup, Getting Emacs, Getting Started +@section Getting Emacs-W3 +@cindex FTP'in the distribution +@cindex Source code availability +:: WORK :: Explanation of Emacs, XEmacs, and where to get both + +@node Basic Setup, Firewalls, Getting Emacs-W3, Getting Started @section Basic Setup -There are a few variables that almost all people need to change. +For most people, Emacs-W3 will be ready to run straight out of the box. +Once the user is more familiar with the web and how it integrates with +Emacs, there are a few basic configuration variables that most people +will want to personalize. @table @code @item w3-default-homepage @vindex w3-default-homepage -The url to open at startup. This defaults to the environment variable +The URL to open at startup. This defaults to the environment variable WWW_HOME if it is not set it in the users @file{.emacs} file. If WWW_HOME is undefined, then it defaults to the hypertext documentation for Emacs-W3. @@ -500,6 +399,8 @@ Displays the URL (ie: @samp{http://www.cs.indiana.edu/}). @item text Displays the text of the link (ie: @samp{A link to Indiana University}). +@item title +Displays the title of the link, if any, otherwise behaves the same as @code{url}. @item nil Show nothing. @end table @@ -526,8 +427,7 @@ port number. The default is for xterm, which is very UNIX and XWindows-centric. @end table -@node Firewalls, Proxy Gateways, Basic Setup, Starting Up -@comment node-name, next, previous, up +@node Firewalls, Proxy Gateways, Basic Setup, Getting Started @section Firewalls @cindex Gateways There are several different reasons why the gateway support might be @@ -598,9 +498,6 @@ of interactive programs (like telnet) very easily. It is available from gatekeeper.dec.com:/pub/GNU/expect-3.24.0.tar.gz} script, etc.). -@item host -Log into another local computer that has access to the internet, and run -a telnet-like program from there. @item tcp Masanobu UMEDA (@i{umerin@@mse.kyutech.ac.jp}) has written a very nice replacement for the standard networking in Emacs. This does basically @@ -611,7 +508,7 @@ 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 -Two of these need a bit more explanation than that: +One of these needs a bit more explanation than that: @vindex url-gateway-telnet-ready-regexp @vindex url-gateway-telnet-program When running a program in a subprocess to emulate a network connection, @@ -628,62 +525,6 @@ signifies the end of the setup of @code{url-gateway-telnet-program}. The default should work fine for telnet. -@cindex Host-based gateways -@cindex Hair-pulling gateway-headaches -@vindex url-gateway-host -When using the @code{host}-based gatway method, things get a bit more -complicated. This is basically my attempt to do some of the basic stuff -of @i{expect} within elisp. First off, set the variable -@code{url-gateway-host} to be the name of the gateway machine. - - -@vindex url-gateway-connect-program -The variable @code{url-gateway-connect-program} controls how the host is -reached. The easiest way is to have a program that does not require a -username and password to login. The most common of these is the -@dfn{rsh} command. - -@vindex url-gateway-program-interactive -@vindex url-gateway-handholding-password-regexp -@vindex url-gateway-handholding-login-regexp -@vindex url-gateway-host-username -@vindex url-gateway-host-password -If @i{rsh} is not available, then things get very ugly. First, set the -variable @code{url-gateway-program-interactive} to non-@code{nil}. Then -set the variables @code{url-gateway-host-username} and -@code{url-gateway-host-password} to be the username and password -necessary to log into the gateway machine. The regular expressions in -the variables @code{url-gateway-handholding-login-regexp} and -@code{url-gateway-handholding-password-regexp} should match the login -and password prompts on the gateway system respectively. For example: - -@example -(setq url-gateway-connect-program "telnet" - url-gateway-host-program "telnet" - url-gateway-program-interactive t - url-gateway-host-username "wmperry" - url-gateway-host-password "yeahrightkeepdreaming" - url-gateway-host "moose.cs.indiana.edu" - url-gateway-host-program-ready-regexp "Escape character is .*" - url-gateway-handholding-login-regexp "ogin:" - url-gateway-handholding-password-regexp "ord:") -@end example - -@vindex url-gateway-host-prompt-pattern -This should take care of logging in to the remote system. The variable -@code{url-gateway-host-prompt-pattern} should contain a regular -expression that matches the shell prompt on the remote machine. This -should appear @b{no where} in the login banner/setup, or things could -get very confused. - -@vindex url-gateway-host-program-ready-regexp -@vindex url-gateway-host-program -The variable @code{url-gateway-host-program-ready-regexp} should contain -a regular expression that matches the end of the setup of -@code{url-gateway-host-program} when it tries to make a connection to an -off-firewall machine. (Basically the same as -@code{url-gateway-telnet-ready-regexp}. - 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 @@ -692,8 +533,7 @@ helpful/knowledgeable about the local setup than I would be. But feel free to mail me as a last resort. -@node Proxy Gateways, Basic Usage, Firewalls, Starting Up -@comment node-name, next, previous, up +@node Proxy Gateways, Basic Usage, Firewalls, Getting Started @section Proxy Gateways @vindex url-proxy-services @cindex Proxy Servers @@ -743,7 +583,6 @@ @end example @node Basic Usage, , Proxy Gateways, Top -@comment node-name, next, previous, up @chapter Basic Usage 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 @@ -754,12 +593,11 @@ @b{NOTE:} To enter data into a form entry area, select it using @kbd{return} or the middle mouse button, just like a hypertext link. - -On non-graphic terminals (VT100, DOS, etc.), hypertext links are -surrounded by '[[' and ']]' by default. On a graphics terminal, the -links are in bold print. @xref{Controlling Formatting} for information -on how to change this, or for help on getting the highlighting to work -on graphics terminals. +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{Controlling +Formatting} for information on how to change this, or for help on +getting the highlighting to work on graphics terminals. There are approximately 50 keys bound to special Emacs-W3 functions. The basic rule of thumb regarding keybindings in Emacs-W3 is that a @@ -1047,22 +885,40 @@ When the HTML source is printed, then an appropriate <base> tag is inserted at the beginning of the document. -@vindex w3-use-html2latex -@vindex w3-html2latex-prog -@vindex w3-html2latex-args @vindex w3-print-commnad @vindex w3-latex-docstyle When postscript is printed, then the HTML source of the document is -converted into LaTeX source. If the variable @code{w3-use-html2latex} -is non-@code{nil}, then the program specified by -@code{w3-html2latex-prog} is run in a subprocess with the arguments in -@code{w3-html2latex-args}. The @code{w3-html2latex-prog} must accept -HTML source on its standard input and send the LaTeX output to standard -output. If @code{w3-use-html2latex} is @code{nil}, then an Emacs Lisp -function uses regular expressions to replace the HTML code with LaTeX -markup. The variable @code{w3-latex-docstyle} controls how the document -is laid out in this case, and postscript figures are printed as -well. +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 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 URLs of hypertext links as endnotes at the +end of the document. If set to @code{footnote}, prints the URL's as +footnotes on each page. +@end table + @kindex P @findex w3-print-url-under-point @item P @@ -1097,7 +953,6 @@ @end table @node Compatibility, , , Top -@comment node-name, next, previous, up @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 @@ -1123,8 +978,6 @@ @end ifinfo @node Emulation, Hotlist Handling, Compatibility, Compatibility @section Emulation -:: WORK :: Document lynx emulation -:: WORK :: Document netscape emulation @cindex Browser emulation @cindex Emulation of other browsers @cindex Netscape emulation @@ -1134,6 +987,8 @@ @findex w3-netscape-emulation-minor-mode @findex w3-lynx-emulation-minor-mode @vindex w3-mode-hook +:: WORK :: Document lynx emulation +:: WORK :: Document netscape emulation @node Hotlist Handling, Session History, Emulation, Compatibility @section Hotlist Handling @@ -1315,15 +1170,14 @@ Editing personal annotations is not yet supported. @node Controlling Formatting, General Formatting, Top, Top -@comment node-name, next, previous, up @chapter Controlling Formatting @cindex Customizing formatting @cindex Specifying Fonts @cindex Fonts @cindex Colors -How Emacs-W3 formats a document is very customizable. How a document is -displayed depends on whether the user is on a terminal -capable of graphics and a few variables. +How Emacs-W3 formats a document is very customizable. All control over +formatting is now controlled by a default stylesheet set by the user +with the @code{w3-default-sheet} variable. The following sections describe in more detail how to change the formatting of a document. @@ -1351,73 +1205,18 @@ @end iftex @ifinfo @center -------------------- -@center Setting the fill column +@center Setting the right margin @center -------------------- @end ifinfo +@cindex Margins @vindex fill-column @vindex w3-right-border -Each time a document is parsed, the @code{fill-column} is recalculated -using @code{window-width} and @code{w3-right-border}. +Each time a document is parsed, the right margin is recalculated +using the width of the current window and @code{w3-right-border}. @code{w3-right-border} is an integer specifying how much room at the right edge of the screen to leave blank. The @code{fill-column} is set to @code{(- (window-width) @code{w3-right-border})}. @iftex -@heading Formatting of hypertext links -@end iftex -@ifinfo -@center -------------------- -@center Formatting of hypertext links -@center -------------------- -@end ifinfo -@vindex w3-delimit-links -@vindex w3-link-start-delimiter -@vindex w3-link-end-delimiter -If the variable @code{w3-delimit-links} is non-@code{nil} (the default -for text-terminals), then hypertext links are surrounded by text -specified by the user. The variables @code{w3-link-start-delimiter} and -@code{w3-link-end-delimiter} control what text is at the start and end -of a hypertext link. These variables are cons-pairs of two -strings. - -If a link has never been visited before (it is not in the @i{global -history}), then the @code{car} of these variables is inserted at the -start and end of the link. If the link has been visited before, then -the @code{cdr} is inserted. So, links look like: - -@example -[[This is a hypertext link]] that has never been visited. -@{@{This one, however@}@} has been seen before at some point in time. -@end example - -@iftex -@heading Formatting of lists -@end iftex -@ifinfo -@center -------------------- -@center Formatting of lists -@center -------------------- -@end ifinfo -@cindex Indentation -@vindex w3-indent-level -There are several different ways to control the formatting of lists. -The most obvious is how deeply they are indented relative to the rest of -the paragraphs in the document. To control this, set the -variable @code{w3-indent-level}. This is the number of spaces to -indent lists and other items requiring special margins. - -@vindex w3-list-chars-assoc -Another thing that is easy to change about lists is the bullet character -put at the front of each list item. This is controlled by the variable -@code{w3-list-chars-assoc}, which is an assoc list. This is a list of -lists, each sublist describing what to put at the start of each -particular list type. The @code{car} of this list should be a symbol -(@b{not} a string) representing the type of list (e.g., @samp{ul}). -The rest of the list should consist of strings to insert at certain -levels of lists. The @code{n}th element of this list is used when the -list is nested @code{n + 1} levels. If the list is not long enough to -define a string for a certain nesting level, then it defaults to either -a '*' or a '.'. -@iftex @heading Formatting of directory listings @end iftex @ifinfo @@ -1440,19 +1239,6 @@ of Emacs-W3, and the users is unable to load documents in the directory directly into Emacs-W3 by clicking with the mouse, etc. -@ignore -@cindex Downloading multiple files -@cindex FTP'ing multiple files -@vindex url-forms-based-ftp -A new option in the 2.2 series is @code{url-forms-based-ftp} - this is -still in the experimental stages, but can be useful. If -@code{url-forms-based-ftp} is @code{t}, then all automatically generated -directory listings will have a form mixed in with the file listing. -Each file will have a checkbox next to it, and a row of buttons at the -bottom of the screen. Selecting one of the buttons at the bottom of the -screen will take the designated action on all the marked files. -Currently, only deleting and copying marked files is supported. -@end ignore @iftex @heading Formatting of gopher directories @end iftex @@ -1495,10 +1281,11 @@ Horizontal rules (@b{<HR>} tags in HTML[+]) are used to separate chunks of a document, and is meant to be rendered as a solid line across the page. Some terminals display characters differently, so the variable -@code{w3-horizontal-rule-char} controls which character is used to draw a -horizontal bar. This variable must be the ASCII value of the character, -@b{not a string}. The variable is passed through make-string whenever a -horizontal rule of a certain width is necessary. +@code{w3-horizontal-rule-char} controls which character is used to draw +a horizontal bar. This variable must be the ASCII value of the +character, @b{not a string}. The variable is passed through +@code{make-string} whenever a horizontal rule of a certain width is +necessary. @node Character based terminals, Graphics workstations, General Formatting, Controlling Formatting @section On character based terminals @@ -1871,7 +1658,6 @@ :: WORK :: Amiga specific instructions @node Advanced Features, Style Sheets, Amiga, Top -@comment node-name, next, previous, up @chapter Advanced Features @ifinfo
--- a/src/ChangeLog Mon Aug 13 09:05:44 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:06:37 2007 +0200 @@ -1,3 +1,25 @@ +Fri Jan 10 20:21:47 1997 Ben Wing <ben@666.com> + + * minibuf.c (Ftry_completion): Don't crash if not given a proper + obarray. + +Fri Jan 10 09:49:44 1997 Ted Phelps <phelps@dstc.edu.au> + + * objects-x.c (x_initialize_font_instance): Hardcode 'n' for + default font width. + +Mon Jan 6 15:16:46 1997 Carsten Leonhardt <leo@arioch.tng.oche.de> + + * Makefile.in.in: Linking with canna requires -lRKC. + +Mon Jan 6 12:22:57 1997 Frederic Poncin <fp@info.ucl.ac.be> + + * gmalloc.c: Don't declare __sbrk on SparcLinux. + +Sun Jan 5 18:04:47 1997 Soren Dayton <csdayton@cs.uchicago.edu> + + * Makefile.in.in: IRIX6 can use sgiplay.c too. + Sat Jan 4 12:15:16 1997 Steven L Baur <steve@altair.xemacs.org> * toolbar.c (specifier_vars_of_toolbar): Clean up fallback
--- a/src/EmacsFrame.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/EmacsFrame.c Mon Aug 13 09:06:37 2007 +0200 @@ -495,6 +495,8 @@ XrmValuePtr fromVal, XrmValuePtr toVal) { +#if 0 + /* Martin, this is broken. Please fix it. */ XrmQuark q; char *lowerName = (char *) alloca (strlen ( (char *) fromVal->addr) + 1); @@ -516,6 +518,41 @@ toVal->addr = NULL; toVal->size = 0; XtStringConversionWarning (fromVal->addr, "scrollBarPlacement"); +#endif +#define done(address, type) \ +toVal->size = sizeof(type); \ +toVal->addr = (XtPointer) address; \ +return /* `;' supplied by caller */ + + XrmQuark q; + char lowerName[1000]; + + XmuCopyISOLatin1Lowered (lowerName, (char*)fromVal->addr); + q = XrmStringToQuark(lowerName); + if (q == XrmStringToQuark ("top_left")) + { + cvt_string_scrollbar_placement = XtTOP_LEFT; + done (&cvt_string_scrollbar_placement, unsigned char); + } + if (q == XrmStringToQuark ("bottom_left")) + { + cvt_string_scrollbar_placement = XtBOTTOM_LEFT; + done (&cvt_string_scrollbar_placement, unsigned char); + } + if (q == XrmStringToQuark ("top_right")) + { + cvt_string_scrollbar_placement = XtTOP_RIGHT; + done (&cvt_string_scrollbar_placement, unsigned char); + } + if (q == XrmStringToQuark ("bottom_right")) + { + cvt_string_scrollbar_placement = XtBOTTOM_RIGHT; + done (&cvt_string_scrollbar_placement, unsigned char); + } + XtStringConversionWarning (fromVal->addr, "scrollBarPlacement"); + toVal->addr = NULL; + toVal->size = 0; +#undef done } static void
--- a/src/Makefile.in.in Mon Aug 13 09:05:44 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:06:37 2007 +0200 @@ -310,7 +310,7 @@ # elif defined (SPARC) # define SOUND_CFLAGS C_SWITCH_SITE -I/usr/demo/SOUND # define SOUND_OBJS sunplay.o -# elif defined (IRIX4) || defined (IRIX5) +# elif defined (IRIX4) || defined (IRIX5) || defined (IRIX6) # define SOUND_CFLAGS # define SOUND_OBJS sgiplay.o # elif defined (hp9000s800) @@ -553,7 +553,7 @@ # ifdef HAVE_CANNA # define CANNA_OBJS mule-canna.o # define CANNA_OBJ_SRC ${muledirfromsrc}/mule-canna.c -# define LIB_CANNA -lcanna +# define LIB_CANNA -lcanna -lRKC # else # define CANNA_OBJS # define CANNA_OBJ_SRC @@ -1175,18 +1175,22 @@ ${lispdir}eos/sun-eos-browser.elc \ ${lispdir}eos/sun-eos-debugger.elc \ ${lispdir}eos/sun-eos-debugger-extra.elc \ - ${lispdir}comint/comint.elc \ - ${lispdir}utils/ring.elc \ ${lispdir}eos/sun-eos-toolbar.elc \ ${lispdir}eos/sun-eos-menubar.elc \ - ${lispdir}utils/annotations.elc + ${lispdir}comint/comint.elc \ + ${lispdir}utils/ring.elc \ + ${lispdir}utils/annotations.elc \ + ${lispdir}modes/cc-mode.elc \ + ${lispdir}modes/imenu.elc \ + ${lispdir}utils/reporter.elc #else -#define SUNPRO_LISP ${lispdir}prim/loaddefs.elc +#define SUNPRO_LISP #endif #ifdef TOOLTALK /* Lisp files preloaded if compiled with support for Tooltalk */ #define TOOLTALK_LISP \ + ${lispdir}tooltalk/tooltalk-load.elc \ ${lispdir}tooltalk/tooltalk-macros.elc \ ${lispdir}tooltalk/tooltalk-util.elc \ ${lispdir}tooltalk/tooltalk-init.elc @@ -1324,12 +1328,12 @@ #else #ifdef HAVE_SHM -if [ -w ${srcdir}/../lisp ]; then \ - w=`pwd`; cd ${srcdir}; $${w}/temacs -nl -batch -l inc-vers; \ + w=`pwd`; cd ${srcdir} && $${w}/temacs -nl -batch -l inc-vers; \ else true; fi $(DUMPENV) ./temacs -nl -batch -l loadup.el dump #else /* ! defined (HAVE_SHM) */ -if [ -w ${srcdir}/../lisp ]; then \ - w=`pwd`; cd ${srcdir}; $${w}/temacs -batch -l inc-vers; \ + w=`pwd`; cd ${srcdir} && $${w}/temacs -batch -l inc-vers; \ else true; fi $(DUMPENV) ./temacs -batch -l loadup.el dump #endif /* ! defined (HAVE_SHM) */ @@ -1364,6 +1368,9 @@ dump-elcs: temacs $(LOADPATH) ./temacs -batch -l ../prim/update-elc.el $(lisp) $(otherlisp) +all-elc all-elcs: + cd .. && $(MAKE) all-elc $(MFLAGS) + #ifdef I18N3 # if defined(SPARC) && !defined(USG) @@ -1378,23 +1385,23 @@ ${modir}emacs.po: ${libsrc}make-msgfile ${libsrc}make-po ${objs} ${mule_objs} ${lisp} ${libsrc}make-msgfile -o ${libsrc}messages ${objs} ${mule_objs} ${lisp} ${otherlisp} - cd ${libsrc}; ${xgettext} ${xgettext_args} + cd ${libsrc} && ${xgettext} ${xgettext_args} rm -f ${modir}emacs.po - cd ${libsrc}; ${libsrc}make-po -a ${modir}emacs.po DOC + cd ${libsrc} && ${libsrc}make-po -a ${modir}emacs.po DOC ${modir}emacs.mo: ${modir}emacs.po - cd ${modir}; ${msgfmt} -o emacs.mo emacs.po + cd ${modir} && ${msgfmt} -o emacs.mo emacs.po ${libsrc}make-msgfile: - cd ${libsrc}; ${MAKE} ${MFLAGS} make-msgfile + cd ${libsrc} && ${MAKE} ${MFLAGS} make-msgfile ${libsrc}make-po: - cd ${libsrc}; ${MAKE} ${MFLAGS} make-po + cd ${libsrc} && ${MAKE} ${MFLAGS} make-po #endif /* I18N3 */ ${libsrc}make-docfile: - cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile + cd ${libsrc} && ${MAKE} ${MFLAGS} make-docfile /* Lint Section */ LINT.c=$(LINT) $(LINTFLAGS) $(LINTINCLUDES) @@ -1411,7 +1418,7 @@ force: $(LWLIBBUILDDIR)/liblw.a: force - cd ${LWLIBBUILDDIR}; ${MAKE} ${MFLAGS} + cd ${LWLIBBUILDDIR} && ${MAKE} ${MFLAGS} /* Some systems define this to cause parallel Make-ing. */ #ifndef MAKE_PARALLEL @@ -1563,7 +1570,7 @@ #ifdef NEED_CPP CPP = ./localcpp localcpp: - cd ${cppdir}; ${MAKE} ${MFLAGS} EMACS=-DEMACS + cd ${cppdir} && ${MAKE} ${MFLAGS} EMACS=-DEMACS ln ${cppdir}cpp localcpp /* Name where ALL_CFLAGS will refer to it */ /* cc appears to be cretinous and require all of these to exist if -B is specified -- we cannot use one local pass and let the @@ -1580,7 +1587,7 @@ #ifdef SHORTNAMES shortnames: - cd ${shortnamesdir}; ${MAKE} ${MFLAGS} + cd ${shortnamesdir} && ${MAKE} ${MFLAGS} #endif config.h: ${srcdir}/config.h.in @@ -1697,7 +1704,7 @@ select which of these should be compiled. */ ${libsrc}emacstool: ${libsrc}emacstool.c - cd ${libsrc}; ${MAKE} ${MFLAGS} emacstool + cd ${libsrc} && ${MAKE} ${MFLAGS} emacstool mostlyclean: rm -f temacs puremacs quantmacs prefix-args xmakefile* core depend.* \#* *.o rm -f ${libsrc}DOC
--- a/src/alloc.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/alloc.c Mon Aug 13 09:06:37 2007 +0200 @@ -2228,7 +2228,7 @@ #ifdef ERROR_CHECK_GC CONST struct lrecord_implementation *implementation = lheader->implementation; - + /* There should be no other pointers to the free list. */ assert (!MARKED_RECORD_HEADER_P (lheader)); /* Only lcrecords should be here. */ @@ -2241,7 +2241,7 @@ assert (implementation->static_size == 0 || implementation->static_size == list->size); #endif /* ERROR_CHECK_GC */ - + MARK_RECORD_HEADER (lheader); chain = free_header->chain; }
--- a/src/bitmaps.h Mon Aug 13 09:05:44 2007 +0200 +++ b/src/bitmaps.h Mon Aug 13 09:06:37 2007 +0200 @@ -105,16 +105,16 @@ #endif /* A Right pointing Arrow */ -#define truncator_width 6 +#define truncator_width 8 #define truncator_height 10 static unsigned char truncator_bits[] = { - 0xc0,0xc4,0xc8,0xd0,0xff,0xd0,0xc8,0xc4,0xc0,0xc0}; + 0x00, 0x18, 0x30, 0x60, 0xff, 0xff, 0x60, 0x30, 0x18, 0x00}; /* A Left pointing Arrow */ -#define hscroll_width 6 +#define hscroll_width 8 #define hscroll_height 10 static unsigned char hscroll_bits[] = { - 0xc0,0xc8,0xc4,0xc2,0xff,0xc2,0xc4,0xc8,0xc0,0xc0}; + 0x00, 0x18, 0x0c, 0x06, 0xff, 0xff, 0x06, 0x0c, 0x18, 0x00}; #if 0 #define rarrow_width 12
--- a/src/callproc.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/callproc.c Mon Aug 13 09:06:37 2007 +0200 @@ -202,7 +202,7 @@ error_file = Qt; -#ifdef NO_SUBPROCESSES +#if defined (NO_SUBPROCESSES) /* Without asynchronous processes we cannot have BUFFER == 0. */ if (nargs >= 3 && !INTP (args[2])) error ("Operating system cannot handle asynchronous subprocesses"); @@ -501,7 +501,7 @@ { if (fd[0] >= 0) close (fd[0]); -#ifdef NO_SUBPROCESSES +#if defined (NO_SUBPROCESSES) /* If Emacs has been built with asynchronous subprocess support, we don't need to do this, I think because it will then have the facilities for handling SIGCHLD. */ @@ -659,7 +659,7 @@ nice (- emacs_priority); #endif -#ifndef NO_SUBPROCESSES +#if !defined (NO_SUBPROCESSES) /* Close Emacs's descriptors that this process should not have. */ close_process_descs (); #endif /* not NO_SUBPROCESSES */ @@ -871,7 +871,7 @@ if (STRINGP (entry) && XSTRING_LENGTH (entry) > varlen - && string_byte (XSTRING (entry), varlen) == '=' + && XSTRING_BYTE (entry, varlen) == '=' #ifdef WINDOWSNT /* NT environment variables are case insensitive. */ && ! memicmp (XSTRING_DATA (entry), var, varlen)
--- a/src/console-tty.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/console-tty.c Mon Aug 13 09:06:37 2007 +0200 @@ -206,6 +206,8 @@ return CONSOLE_TTY_DATA (decode_tty_console (console))->terminal_type; } +extern Lisp_Object stream_semi_canonicalize_console_connection(Lisp_Object, + Error_behavior); Lisp_Object tty_semi_canonicalize_console_connection (Lisp_Object connection, Error_behavior errb) @@ -213,6 +215,8 @@ return stream_semi_canonicalize_console_connection (connection, errb); } +extern Lisp_Object stream_canonicalize_console_connection(Lisp_Object, + Error_behavior); Lisp_Object tty_canonicalize_console_connection (Lisp_Object connection, Error_behavior errb)
--- a/src/dired.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/dired.c Mon Aug 13 09:06:37 2007 +0200 @@ -134,7 +134,7 @@ dirname_length = XSTRING_LENGTH (dirname); #ifndef VMS if (dirname_length == 0 - || !IS_ANY_SEP (string_byte (XSTRING (dirname), dirname_length - 1))) + || !IS_ANY_SEP (XSTRING_BYTE (dirname, dirname_length - 1))) { *filename++ = DIRECTORY_SEP; dirname_length++;
--- a/src/doc.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/doc.c Mon Aug 13 09:06:37 2007 +0200 @@ -155,7 +155,7 @@ case '_': *to++ = '\037'; break; default: return_me = list2 (build_string - ("Invalid data in documentation file -- ^A followed by weird code"), + ("Invalid data in documentation file -- ^A followed by weird code"), make_int (c)); goto done; } @@ -255,7 +255,7 @@ fd = open (name_nonreloc, O_RDONLY, 0); } -#endif /* CANNOT DUMP */ +#endif /* CANNOT_DUMP */ if (fd < 0) error ("Cannot open doc string file \"%s\"",
--- a/src/emacs.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/emacs.c Mon Aug 13 09:06:37 2007 +0200 @@ -1433,7 +1433,7 @@ { /* Handle -l loadup-and-dump, args passed by Makefile. */ if (argc > 2 + skip_args && !strcmp (argv[1 + skip_args], "-l")) - load_me = build_string (argv[2 + skip_args]); + load_me = build_string (argv[2 + skip_args]); #ifdef CANNOT_DUMP /* Unless next switch is -nl, load "loadup.el" first thing. */ if (!(argc > 1 + skip_args && !strcmp (argv[1 + skip_args], "-nl"))) @@ -1796,8 +1796,8 @@ environ=_environ; } #endif /* _SCO_DS */ - vol_envp = environ; - } + vol_envp = environ; + } run_temacs_argc = -1; main_1 (vol_argc, vol_argv, vol_envp);
--- a/src/energize.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/energize.c Mon Aug 13 09:06:37 2007 +0200 @@ -722,7 +722,7 @@ XSETSTRING (type, XSYMBOL (type)->name); if (STRINGP (type)) - type_string = (char *)XSTRING_DATA (type); + type_string = (char *) XSTRING_DATA (type); type_string = copy_string (type_string); @@ -1665,9 +1665,8 @@ if (!NILP (buffer_name)) { if (modifying_p - && strcmp ((char*)XSTRING_DATA (buffer_name), - (char*) - string_data (XSTRING (XBUFFER (binfo->emacs_buffer)->name)))) + && strcmp ((char*) XSTRING_DATA (buffer_name), + (char*) xSTRING_DATA (XBUFFER (binfo->emacs_buffer)->name)))) rename_the_buffer (buffer_name); } @@ -2135,8 +2134,7 @@ BUF_BEG (current_buffer), BUF_Z (current_buffer)); CNeedOutputSize (conn, XSTRING_LENGTH (string) + 9); - CWriteVstringLen (conn, XSTRING_DATA (string), - XSTRING_LENGTH (string)); + CWriteVstringLen (conn, XSTRING_DATA (string), XSTRING_LENGTH (string)); } /* write the extents */ @@ -2528,7 +2526,7 @@ /* ignore the flags for now */ execute_energize_menu (buffer, extent_to_data (extent_obj), - (char*)XSTRING_DATA (v->contents [0]), + (char*) XSTRING_DATA (v->contents [0]), lisp_to_word (v->contents [1]), XINT (v->contents [3]), selection,
--- a/src/event-Xt.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 09:06:37 2007 +0200 @@ -539,9 +539,9 @@ struct x_device *xd = DEVICE_X_DATA (d); xd->need_to_add_mask = 0; - xd->last_downkey = 0; - xd->release_time = 0; - xd->down_mask = 0; + xd->last_downkey = 0; + xd->release_time = 0; + xd->down_mask = 0; } static int @@ -735,7 +735,8 @@ return KEYSYM (buf); } /* If it's got a one-character name, that's good enough. */ - if (!name[1]) return make_char (name[0]); + if (!name[1]) + return make_char (name[0]); /* If it's in the "Keyboard" character set, downcase it. The case of those keysyms is too totally random for us to
--- a/src/event-stream.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:06:37 2007 +0200 @@ -2791,14 +2791,12 @@ #endif ) { - /* Currently, we rely on SIGCHLD to indicate that - the process has terminated. Unfortunately, it - appears that on some systems the SIGCHLD gets - missed some of the time. So, we put in am - additional check in status_notify() to see - whether a process has terminated. We have to - tell status_notify() to enable that check, and - we do so now. */ + /* Currently, we rely on SIGCHLD to indicate that the + process has terminated. Unfortunately, on some systems + the SIGCHLD gets missed some of the time. So we put an + additional check in status_notify() to see whether a + process has terminated. We must tell status_notify() + to enable that check, and we do so now. */ kick_status_notify (); } else
--- a/src/extents.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/extents.c Mon Aug 13 09:06:37 2007 +0200 @@ -1968,8 +1968,10 @@ assert (!extent_detached_p (after)); } - if (!buffer_or_string_extent_list (obj)) + el = buffer_or_string_extent_list (obj); + if (!el || !extent_list_num_els(el)) return; + el = 0; st = buffer_or_string_bytind_to_memind (obj, from); en = buffer_or_string_bytind_to_memind (obj, to); @@ -2315,8 +2317,9 @@ #endif el = buffer_or_string_extent_list (obj); - if (!el) + if (!el || !extent_list_num_els(el)) return; + /* IMPORTANT! Compute the starting positions of the extents to modify BEFORE doing any modification! Otherwise the starting position for the second time through the loop might get @@ -2516,7 +2519,7 @@ buffer_or_string_absolute_end_byte (obj) : buffer_or_string_accessible_end_byte (obj); - if (!bel) + if (!bel || !extent_list_num_els(bel)) return limit; sel = buffer_or_string_stack_of_extents_force (obj)->extents; @@ -2556,7 +2559,7 @@ buffer_or_string_absolute_begin_byte (obj) : buffer_or_string_accessible_begin_byte (obj); - if (!bel) + if (!bel || !extent_list_num_els(bel)) return limit; sel = buffer_or_string_stack_of_extents_force (obj)->extents;
--- a/src/filelock.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/filelock.c Mon Aug 13 09:06:37 2007 +0200 @@ -69,9 +69,8 @@ #ifndef HAVE_LONG_FILE_NAMES -#define MAKE_LOCK_NAME(lock, file) \ - (lock = (char *) alloca (14 + XSTRING_LENGTH (Vlock_directory) + \ - 1), \ +#define MAKE_LOCK_NAME(lock, file) \ + (lock = (char *) alloca (14 + XSTRING_LENGTH (Vlock_directory) + 1), \ fill_in_lock_short_file_name (lock, (file))) static void @@ -107,7 +106,7 @@ int need_slash = 0; /* in case lock-directory doesn't end in / */ - if (string_byte (XSTRING (Vlock_directory), + if (XSTRING_BYTE (Vlock_directory, XSTRING_LENGTH (Vlock_directory) - 1) != '/') need_slash = 1; @@ -122,9 +121,9 @@ #else /* defined HAVE_LONG_FILE_NAMES */ /* +2 for terminating null and possible extra slash */ -#define MAKE_LOCK_NAME(lock, file) \ - (lock = (char *) alloca (XSTRING_LENGTH (file) + \ - XSTRING_LENGTH (Vlock_directory) + 2),\ +#define MAKE_LOCK_NAME(lock, file) \ + (lock = (char *) alloca (XSTRING_LENGTH (file) + \ + XSTRING_LENGTH (Vlock_directory) + 2), \ fill_in_lock_file_name (lock, (file))) static void
--- a/src/glyphs-x.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 09:06:37 2007 +0200 @@ -276,11 +276,11 @@ /* Check non-absolute pathnames with a directory component relative to the search path; that's the way Xt does it. */ /* #### Unix-specific */ - if (string_byte (XSTRING (name), 0) == '/' || - (string_byte (XSTRING (name), 0) == '.' && - (string_byte (XSTRING (name), 1) == '/' || - (string_byte (XSTRING (name), 1) == '.' && - (string_byte (XSTRING (name), 2) == '/'))))) + if (XSTRING_BYTE (name, 0) == '/' || + (XSTRING_BYTE (name, 0) == '.' && + (XSTRING_BYTE (name, 1) == '/' || + (XSTRING_BYTE (name, 1) == '.' && + (XSTRING_BYTE (name, 2) == '/'))))) { if (!NILP (Ffile_readable_p (name))) return name;
--- a/src/gmalloc.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/gmalloc.c Mon Aug 13 09:06:37 2007 +0200 @@ -1297,9 +1297,11 @@ #ifdef __GNU_LIBRARY__ /* It is best not to declare this and cast its result on foreign operating systems with potentially hostile include files. */ +#if !(defined(linux) && defined(sparc)) extern __ptr_t __sbrk __P ((int increment)); #endif #endif +#endif #ifndef NULL #define NULL 0
--- a/src/lisp.h Mon Aug 13 09:05:44 2007 +0200 +++ b/src/lisp.h Mon Aug 13 09:06:37 2007 +0200 @@ -169,30 +169,30 @@ macro will realloc BASEVAR as necessary so that it can hold at least NEEDED_SIZE objects. The reallocing is done by doubling, which ensures constant amortized time per element. */ -#define DO_REALLOC(basevar, sizevar, needed_size, type) do \ -{ \ - /* Avoid side-effectualness. */ \ - /* Dammit! Macros suffer from dynamic scope! */ \ - /* We demand inline functions! */ \ - int do_realloc_needed_size = (needed_size); \ - int newsize = 0; \ - while ((sizevar) < (do_realloc_needed_size)) { \ - newsize = 2*(sizevar); \ - if (newsize < 32) \ - newsize = 32; \ - (sizevar) = newsize; \ - } \ - if (newsize) \ - (basevar) = (type *) xrealloc (basevar, \ - (newsize)*sizeof(type)); \ +#define DO_REALLOC(basevar, sizevar, needed_size, type) do \ +{ \ + /* Avoid side-effectualness. */ \ + /* Dammit! Macros suffer from dynamic scope! */ \ + /* We demand inline functions! */ \ + int do_realloc_needed_size = (needed_size); \ + int newsize = 0; \ + while ((sizevar) < (do_realloc_needed_size)) { \ + newsize = 2*(sizevar); \ + if (newsize < 32) \ + newsize = 32; \ + (sizevar) = newsize; \ + } \ + if (newsize) \ + (basevar) = (type *) xrealloc (basevar, \ + (newsize)*sizeof(type)); \ } while (0) #ifdef ERROR_CHECK_MALLOC -#define xfree(lvalue) do \ -{ \ - void **ptr = (void **) &(lvalue); \ - xfree_1 (*ptr); \ - *ptr = (void *) 0xDEADBEEF; \ +#define xfree(lvalue) do \ +{ \ + void **ptr = (void **) &(lvalue); \ + xfree_1 (*ptr); \ + *ptr = (void *) 0xDEADBEEF; \ } while (0) #else #define xfree_1 xfree @@ -251,12 +251,15 @@ ((((len) + (unit) - 1) / (unit)) * (unit)) /* #### Yuck, this is kind of evil */ -#define ALIGN_PTR(ptr, unit) ((void *) ALIGN_SIZE ((long) (ptr), unit)) +#define ALIGN_PTR(ptr, unit) \ + ((void *) ALIGN_SIZE ((long) (ptr), unit)) #ifdef QUANTIFY #include "quantify.h" -#define QUANTIFY_START_RECORDING quantify_start_recording_data () -#define QUANTIFY_STOP_RECORDING quantify_stop_recording_data () +#define QUANTIFY_START_RECORDING \ + do { quantify_start_recording_data (); } while (0) +#define QUANTIFY_STOP_RECORDING \ + do { quantify_stop_recording_data (); } while (0) #else /* !QUANTIFY */ #define QUANTIFY_START_RECORDING #define QUANTIFY_STOP_RECORDING
--- a/src/lread.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/lread.c Mon Aug 13 09:06:37 2007 +0200 @@ -788,7 +788,7 @@ if (EQ (last_file_loaded, file)) message_append (" (%d)", purespace_usage() - pure_usage); else - message ("Loading %s...done (%d)", XSTRING_DATA (file), + message ("Loading %s ...done (%d)", XSTRING_DATA (file), purespace_usage() - pure_usage); } #endif /* DEBUG_XEMACS */ @@ -2736,10 +2736,10 @@ { if (NILP (Vdoc_file_name)) /* We have not yet called Snarf-documentation, so - assume this file is described in the DOC - file and Snarf-documentation will fill in the - right value later. For now, replace the whole - list with 0. */ + assume this file is described in the DOC file + and Snarf-documentation will fill in the right + value later. For now, replace the whole list + with 0. */ XCAR (holding_cons) = Qzero; else /* We have already called Snarf-documentation, so
--- a/src/minibuf.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/minibuf.c Mon Aug 13 09:06:37 2007 +0200 @@ -348,7 +348,12 @@ { if (!ZEROP (bucket)) { - struct Lisp_Symbol *next = symbol_next (XSYMBOL (bucket)); + struct Lisp_Symbol *next; + if (!SYMBOLP (bucket)) { + signal_simple_error("Bad obarry passed to try-completions", + bucket); + } + next = symbol_next (XSYMBOL (bucket)); elt = bucket; eltstring = Fsymbol_name (elt); if (next)
--- a/src/mule-canna.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/mule-canna.c Mon Aug 13 09:06:37 2007 +0200 @@ -785,7 +785,7 @@ for (i = 0 ; i < len ; i++) { slen = strlen (p); - if (res == Qnil) + if (NILP(res)) { endp = res = Fcons (make_string (p, slen), Qnil); }
--- a/src/mule-wnnfns.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/mule-wnnfns.c Mon Aug 13 09:06:37 2007 +0200 @@ -340,7 +340,7 @@ break; } strncpy (envname, XSTRING (lname)->data, 32); - if (hname == Qnil) strcpy (hostname, ""); + if (NILP(hname)) strcpy (hostname, ""); else { CHECK_STRING (hname); @@ -379,13 +379,13 @@ if (!wnnfns_buf[snum]) return Qnil; if (wnnfns_env_norm[snum]) { - if (Vwnnenv_sticky == Qnil) jl_env_un_sticky_e (wnnfns_env_norm[snum]); + if (NILP(Vwnnenv_sticky)) jl_env_un_sticky_e (wnnfns_env_norm[snum]); else jl_env_sticky_e (wnnfns_env_norm[snum]); jl_disconnect (wnnfns_env_norm[snum]); } if (wnnfns_env_rev[snum]) { - if (Vwnnenv_sticky == Qnil) jl_env_un_sticky_e (wnnfns_env_rev[snum]); + if (NILP(Vwnnenv_sticky)) jl_env_un_sticky_e (wnnfns_env_rev[snum]); else jl_env_sticky_e (wnnfns_env_rev[snum]); jl_disconnect (wnnfns_env_rev[snum]); } @@ -410,8 +410,8 @@ CHECK_STRING (args[0]); CHECK_STRING (args[1]); CHECK_INT (args[2]); - if (args[5] != Qnil) CHECK_STRING (args[5]); - if (args[6] != Qnil) CHECK_STRING (args[6]); + if (! NILP(args[5])) CHECK_STRING (args[5]); + if (! NILP(args[6])) CHECK_STRING (args[6]); if ((snum = check_wnn_server_type ()) == -1) return Qnil; if (!wnnfns_buf[snum]) return Qnil; GCPRO1 (*args); @@ -421,10 +421,10 @@ XSTRING (args[1])->data, wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, XINT (args[2]), - (args[3] == Qnil) ? WNN_DIC_RDONLY : WNN_DIC_RW, - (args[4] == Qnil) ? WNN_DIC_RDONLY : WNN_DIC_RW, - (args[5] == Qnil) ? 0 : XSTRING (args[5])->data, - (args[6] == Qnil) ? 0 : XSTRING (args[6])->data, + (NILP(args[3])) ? WNN_DIC_RDONLY : WNN_DIC_RW, + (NILP(args[4])) ? WNN_DIC_RDONLY : WNN_DIC_RW, + (NILP(args[5])) ? 0 : XSTRING (args[5])->data, + (NILP(args[6])) ? 0 : XSTRING (args[6])->data, yes_or_no, puts2 ) < 0) { @@ -512,7 +512,7 @@ { int snum; if ((snum = check_wnn_server_type ()) == -1) return Qnil; - if (rev == Qnil) + if (NILP(rev)) { if ((!wnnfns_buf[snum]) || (!wnnfns_env_norm[snum])) return; jl_env_set (wnnfns_buf[snum], wnnfns_env_norm[snum]); @@ -566,7 +566,7 @@ if (Vwnn_uniq_level == Qwnn_no_uniq) uniq_level = WNN_NO_UNIQ; else if (Vwnn_uniq_level == Qwnn_uniq) uniq_level = WNN_UNIQ; else uniq_level = WNN_UNIQ_KNJ; - if (dai == Qnil) + if (NILP(dai)) { if (offset = jl_zenkouho (wnnfns_buf[snum],no,WNN_USE_MAE, uniq_level) < 0) return Qnil; @@ -653,7 +653,7 @@ CHECK_INT (offset); if ((snum = check_wnn_server_type ()) == -1) return Qnil; if (!wnnfns_buf[snum]) return Qnil; - if (dai == Qnil) + if (NILP(dai)) { if (jl_set_jikouho (wnnfns_buf[snum], XINT (offset)) < 0) return Qnil; } @@ -680,11 +680,11 @@ no = XINT (bunNo); #ifdef WNN6 if ((cnt = jl_fi_nobi_conv (wnnfns_buf[snum], no, XINT(len), -1, WNN_USE_MAE, - (dai == Qnil) ? WNN_SHO : WNN_DAI)) < 0) + (NILP(dai)) ? WNN_SHO : WNN_DAI)) < 0) return Qnil; #else if ((cnt = jl_nobi_conv (wnnfns_buf[snum], no, XINT(len), -1, WNN_USE_MAE, - (dai == Qnil) ? WNN_SHO : WNN_DAI)) < 0) + (NILP(dai)) ? WNN_SHO : WNN_DAI)) < 0) return Qnil; #endif return make_int (cnt); @@ -804,7 +804,7 @@ Lisp_Object val; int snum; if ((snum = check_wnn_server_type ()) == -1) return Qnil; - if (bunNo == Qnil) no = -1; + if (NILP(bunNo)) no = -1; else { CHECK_INT (bunNo); @@ -1214,7 +1214,7 @@ int snum; CHECK_STRING (args[0]); CHECK_STRING (args[1]); - if (args[3] != Qnil) CHECK_STRING (args[3]); + if (! NILP(args[3])) CHECK_STRING (args[3]); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; GCPRO1 (*args); @@ -1224,9 +1224,9 @@ XSTRING(args[1])->data, WNN_FI_SYSTEM_DICT, WNN_DIC_RDONLY, - (args[2] == Qnil) ? WNN_DIC_RDONLY : WNN_DIC_RW, + (NILP(args[2])) ? WNN_DIC_RDONLY : WNN_DIC_RW, 0, - (args[3] == Qnil) ? 0 : XSTRING(args[3])->data, + (NILP(args[3])) ? 0 : XSTRING(args[3])->data, yes_or_no, puts2 ) < 0) { UNGCPRO; @@ -1249,8 +1249,8 @@ int snum; CHECK_STRING (args[0]); CHECK_STRING (args[1]); - if (args[4] != Qnil) CHECK_STRING (args[4]); - if (args[5] != Qnil) CHECK_STRING (args[5]); + if (! NILP(args[4])) CHECK_STRING (args[4]); + if (! NILP(args[5])) CHECK_STRING (args[5]); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; GCPRO1 (*args); @@ -1259,10 +1259,10 @@ XSTRING(args[0])->data, XSTRING(args[1])->data, WNN_FI_USER_DICT, - (args[2] == Qnil) ? WNN_DIC_RDONLY : WNN_DIC_RW, - (args[3] == Qnil) ? WNN_DIC_RDONLY : WNN_DIC_RW, - (args[4] == Qnil) ? 0 : XSTRING(args[4])->data, - (args[5] == Qnil) ? 0 : XSTRING(args[5])->data, + (NILP(args[2])) ? WNN_DIC_RDONLY : WNN_DIC_RW, + (NILP(args[3])) ? WNN_DIC_RDONLY : WNN_DIC_RW, + (NILP(args[4])) ? 0 : XSTRING(args[4])->data, + (NILP(args[5])) ? 0 : XSTRING(args[5])->data, yes_or_no, puts2 ) < 0) { UNGCPRO; @@ -1288,7 +1288,7 @@ struct wnn_henkan_env henv; CHECK_STRING (args[0]); CHECK_INT (args[1]); - if (args[3] != Qnil) CHECK_STRING (args[3]); + if (! NILP(args[3])) CHECK_STRING (args[3]); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; GCPRO1 (*args); @@ -1305,7 +1305,7 @@ wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, XINT(args[1]), WNN_DIC_RW, WNN_DIC_RW, - (args[3] == Qnil) ? 0 : XSTRING(args[3])->data, + (NILP(args[3])) ? 0 : XSTRING(args[3])->data, 0, yes_or_no, puts2)) < 0) { @@ -1322,7 +1322,7 @@ } } vmask |= WNN_ENV_MUHENKAN_LEARN_MASK; - henv.muhenkan_flag = (args[2] == Qnil) ? WNN_DIC_RDONLY : WNN_DIC_RW; + henv.muhenkan_flag = (NILP(args[2])) ? WNN_DIC_RDONLY : WNN_DIC_RW; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) { @@ -1349,7 +1349,7 @@ struct wnn_henkan_env henv; CHECK_STRING (args[0]); CHECK_INT (args[1]); - if (args[3] != Qnil) CHECK_STRING (args[3]); + if (! NILP(args[3])) CHECK_STRING (args[3]); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; GCPRO1 (*args); @@ -1366,7 +1366,7 @@ wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, XINT(args[1]), WNN_DIC_RW, WNN_DIC_RW, - (args[3] == Qnil) ? 0 : XSTRING(args[3])->data, + (NILP(args[3])) ? 0 : XSTRING(args[3])->data, 0, yes_or_no, puts2)) < 0) { @@ -1383,7 +1383,7 @@ } } vmask |= WNN_ENV_BUNSETSUGIRI_LEARN_MASK; - henv.bunsetsugiri_flag = (args[2] == Qnil) ? WNN_DIC_RDONLY : WNN_DIC_RW; + henv.bunsetsugiri_flag = (NILP(args[2])) ? WNN_DIC_RDONLY : WNN_DIC_RW; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) { @@ -1405,7 +1405,7 @@ if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; vmask |= WNN_ENV_LAST_IS_FIRST_MASK; - henv.last_is_first_flag = (mode == Qnil) ? False : True; + henv.last_is_first_flag = (NILP(mode)) ? False : True; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) return Qnil; @@ -1423,7 +1423,7 @@ if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; vmask |= WNN_ENV_COMPLEX_CONV_MASK; - henv.complex_flag = (mode == Qnil) ? False : True; + henv.complex_flag = (NILP(mode)) ? False : True; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) return Qnil; @@ -1441,7 +1441,7 @@ if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; vmask |= WNN_ENV_OKURI_LEARN_MASK; - henv.okuri_learn_flag = (mode == Qnil) ? False : True; + henv.okuri_learn_flag = (NILP(mode)) ? False : True; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) return Qnil; @@ -1483,7 +1483,7 @@ if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; vmask |= WNN_ENV_PREFIX_LEARN_MASK; - henv.prefix_learn_flag = (mode == Qnil) ? False : True; + henv.prefix_learn_flag = (NILP(mode)) ? False : True; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) return Qnil; @@ -1523,7 +1523,7 @@ if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; vmask |= WNN_ENV_SUFFIX_LEARN_MASK; - henv.suffix_learn_flag = (mode == Qnil) ? False : True; + henv.suffix_learn_flag = (NILP(mode)) ? False : True; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) return Qnil; @@ -1541,7 +1541,7 @@ if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; vmask |= WNN_ENV_COMMON_LAERN_MASK; - henv.common_learn_flag = (mode == Qnil) ? False : True; + henv.common_learn_flag = (NILP(mode)) ? False : True; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) return Qnil; @@ -1653,7 +1653,7 @@ if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; vmask |= WNN_ENV_YURAGI_MASK; - henv.yuragi_flag = (mode == Qnil) ? False : True; + henv.yuragi_flag = (NILP(mode)) ? False : True; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) return Qnil; @@ -1832,7 +1832,7 @@ if (Vwnn_server_type == Qcserver) { len = cwnn_yincod_pzy (pzy, wc, - (Vcwnn_zhuyin == Qnil) + (NILP(Vcwnn_zhuyin)) ? CWNN_PINYIN : CWNN_ZHUYIN); for (i = 0; i < len; i++) @@ -1944,7 +1944,7 @@ w++; pin++; } len = cwnn_pzy_yincod (ybuf, pbuf, - (Vcwnn_zhuyin == Qnil) ? CWNN_PINYIN : CWNN_ZHUYIN); + (NILP(Vcwnn_zhuyin)) ? CWNN_PINYIN : CWNN_ZHUYIN); if (len <= 0) return; @@ -1999,7 +1999,7 @@ /* truncate "(Y/N)" */ for (len = 0; (mbuf[len]) && (len < 512); len++); for (; (mbuf[len] != '(') && (len > 0); len--); - if (Fy_or_n_p (make_string (mbuf, len)) == Qnil) return 0; + if (NILP(Fy_or_n_p (make_string (mbuf, len)))) return 0; else return (1); }
--- a/src/objects-x.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/objects-x.c Mon Aug 13 09:06:37 2007 +0200 @@ -287,7 +287,8 @@ f->descent = xf->descent; f->height = xf->ascent + xf->descent; { - unsigned int def_char = xf->default_char; + /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */ + unsigned int def_char = 'n'; /*xf->default_char;*/ int byte1, byte2; once_more: @@ -315,11 +316,11 @@ 0 width too (unlikely) then just use the max width. */ if (f->width == 0) { - if (def_char == 'n') + if (def_char == xf->default_char) f->width = xf->max_bounds.width; else { - def_char = 'n'; + def_char = xf->default_char; goto once_more; } }
--- a/src/symbols.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/symbols.c Mon Aug 13 09:06:37 2007 +0200 @@ -476,26 +476,22 @@ type and make nil, t, and all keywords have that same magic constant_symbol value. This test is awfully specific about what is constant and what isn't. --Stig */ - return (NILP (sym) || EQ (sym, Qt) - || (SYMBOL_VALUE_MAGIC_P (val) - && (XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_CONST_OBJECT_FORWARD || - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_CONST_SPECIFIER_FORWARD || - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_CONST_FIXNUM_FORWARD || - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_CONST_BOOLEAN_FORWARD || - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_CONST_CURRENT_BUFFER_FORWARD || - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_CONST_SELECTED_CONSOLE_FORWARD)) + return + NILP (sym) || + EQ (sym, Qt) || + (SYMBOL_VALUE_MAGIC_P (val) && + (XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_OBJECT_FORWARD || + XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD || + XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_FIXNUM_FORWARD || + XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_BOOLEAN_FORWARD || + XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_CURRENT_BUFFER_FORWARD || + XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SELECTED_CONSOLE_FORWARD)) #if 0 - /* #### - This is disabled until a new magic symbol_value for - constants is added */ - || SYMBOL_IS_KEYWORD (sym) + /* #### - This is disabled until a new magic symbol_value for + constants is added */ + || SYMBOL_IS_KEYWORD (sym) #endif - ); + ; } /* We are setting SYM's value slot (or function slot, if FUNCTION_P is @@ -513,18 +509,13 @@ : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic)); if (SYMBOL_VALUE_MAGIC_P (val) && - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_CONST_SPECIFIER_FORWARD) + XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD) signal_simple_error ("Use `set-specifier' to change a specifier's value", sym); if (symbol_is_constant (sym, val)) - { - signal_error (Qsetting_constant, - ((UNBOUNDP (newval)) - ? list1 (sym) - : list2 (sym, newval))); - } + signal_error (Qsetting_constant, + UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval)); } /* Verify that it's ok to make SYM buffer-local. This rejects
--- a/src/toolbar.c Mon Aug 13 09:05:44 2007 +0200 +++ b/src/toolbar.c Mon Aug 13 09:06:37 2007 +0200 @@ -1675,18 +1675,18 @@ elt = list1 (Fcons (list1 (Qtty), Qzero)); #endif #ifdef HAVE_X_WINDOWS - if (elt != Qnil) + if (!EQ(elt, Qnil)) elt = Fcons (Fcons (list1 (Qx), make_int (DEFAULT_TOOLBAR_HEIGHT)), elt); else elt = list1 (Fcons (list1 (Qx), make_int (DEFAULT_TOOLBAR_HEIGHT))); #endif #ifdef HAVE_NEXTSTEP - if (elt != Qnil) + if (!EQ(elt, Qnil)) elt = Fcons (Fcons (list1 (Qns), make_int (DEFAULT_TOOLBAR_HEIGHT)), elt); else elt = list1 (Fcons (list1 (Qns), make_int (DEFAULT_TOOLBAR_HEIGHT))); #endif - if (elt != Qnil) + if (!EQ(elt, Qnil)) set_specifier_fallback (Vdefault_toolbar_height, elt); elt = Qnil; @@ -1694,18 +1694,18 @@ elt = list1 (Fcons (list1 (Qtty), Qzero)); #endif #ifdef HAVE_X_WINDOWS - if (elt != Qnil) + if (!EQ(elt, Qnil)) elt = Fcons (Fcons (list1 (Qx), make_int (DEFAULT_TOOLBAR_WIDTH)), elt); else elt = list1 (Fcons (list1 (Qx), make_int (DEFAULT_TOOLBAR_WIDTH))); #endif #ifdef HAVE_NEXTSTEP - if (elt != Qnil) + if (!EQ(elt, Qnil)) elt = Fcons (Fcons (list1 (Qns), make_int (DEFAULT_TOOLBAR_WIDTH)), elt); else elt = list1 (Fcons (list1 (Qns), make_int (DEFAULT_TOOLBAR_WIDTH))); #endif - if (elt != Qnil) + if (!EQ(elt, Qnil)) set_specifier_fallback (Vdefault_toolbar_width, elt); set_specifier_fallback (Vtoolbar_size[TOP_TOOLBAR], Vdefault_toolbar_height);