Mercurial > emacs
changeset 90016:ff0e824afa37
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-57
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-594
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-598
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-599
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-600
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-602
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-603
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-604
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-609
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-610
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-611
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-614
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-615
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-42
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-43
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-44
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-46
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-47
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-48
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-49
Add {arch}/=commit-merge-make-log
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-50
{arch}/=commit-merge-make-log: Don't die if there are no ChangeLog changes
line wrap: on
line diff
--- a/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,18 @@ +2004-10-08 Steven Tamm <steventamm@mac.com> + + * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h + * configure: Rebuild + +2004-10-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * configure.in (HAVE_RANDOM_HEAPSTART): Change AC_MSG_ERROR to + AC_MSG_WARN. Move output of warning message to end of configure run. + +2004-10-05 Jan Dj,Ad(Brv. <jan.h.d@swipnet.se> + + * configure.in (HAVE_RANDOM_HEAPSTART): Renamed HAVE_EXECSHIELD. + Run test to see if heap start address is random. + 2004-09-29 Miles Bader <miles@gnu.org> * configure.in (HAVE_EXECSHIELD): Test correct env variable to see
--- a/admin/FOR-RELEASE Wed Oct 13 02:40:50 2004 +0000 +++ b/admin/FOR-RELEASE Thu Oct 14 08:50:09 2004 +0000 @@ -28,8 +28,6 @@ ** Finish updating the Emacs Lisp manual. -*** New display properties (KFS to provide input). - ** Update the Emacs manual. *** Update man/info.texi. @@ -88,7 +86,7 @@ man/screen.texi "Luc Teirlinck" man/search.texi "Luc Teirlinck" man/sending.texi -man/text.texi +man/text.texi "Luc Teirlinck" man/trouble.texi man/windows.texi "Luc Teirlinck" man/xresources.texi
--- a/configure Wed Oct 13 02:40:50 2004 +0000 +++ b/configure Thu Oct 14 08:50:09 2004 +0000 @@ -310,7 +310,7 @@ # include <unistd.h> #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT build build_cpu build_vendor build_os host host_cpu host_vendor host_os CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT LN_S CPP INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA RANLIB ac_ct_RANLIB INSTALL_INFO EGREP SETARCH LIBSOUND SET_MAKE PKG_CONFIG GTK_CFLAGS GTK_LIBS ALLOCA liblockfile LIBOBJS NEED_SETGID KMEM_GROUP GETLOADAVG_LIBS version configuration canonical srcdir lispdir locallisppath lisppath x_default_search_path etcdir archlibdir docdir bitmapdir gamedir gameuser c_switch_system c_switch_machine LD_SWITCH_X_SITE LD_SWITCH_X_SITE_AUX C_SWITCH_X_SITE X_TOOLKIT_TYPE machfile opsysfile carbon_appdir LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT build build_cpu build_vendor build_os host host_cpu host_vendor host_os CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT LN_S CPP INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA RANLIB ac_ct_RANLIB INSTALL_INFO EGREP LIBSOUND SETARCH SET_MAKE PKG_CONFIG GTK_CFLAGS GTK_LIBS ALLOCA liblockfile LIBOBJS NEED_SETGID KMEM_GROUP GETLOADAVG_LIBS version configuration canonical srcdir lispdir locallisppath lisppath x_default_search_path etcdir archlibdir docdir bitmapdir gamedir gameuser c_switch_system c_switch_machine LD_SWITCH_X_SITE LD_SWITCH_X_SITE_AUX C_SWITCH_X_SITE X_TOOLKIT_TYPE machfile opsysfile carbon_appdir LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -984,7 +984,7 @@ else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi - cd "$ac_popdir" + cd $ac_popdir done fi @@ -3250,7 +3250,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -3308,7 +3309,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -3424,7 +3426,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -3478,7 +3481,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -3523,7 +3527,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -3567,7 +3572,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4200,7 +4206,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4271,91 +4278,6 @@ -echo "$as_me:$LINENO: checking for /proc/sys/kernel/exec-shield" >&5 -echo $ECHO_N "checking for /proc/sys/kernel/exec-shield... $ECHO_C" >&6 -if test "${ac_cv_file__proc_sys_kernel_exec_shield+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - test "$cross_compiling" = yes && - { { echo "$as_me:$LINENO: error: cannot check for file existence when cross compiling" >&5 -echo "$as_me: error: cannot check for file existence when cross compiling" >&2;} - { (exit 1); exit 1; }; } -if test -r "/proc/sys/kernel/exec-shield"; then - ac_cv_file__proc_sys_kernel_exec_shield=yes -else - ac_cv_file__proc_sys_kernel_exec_shield=no -fi -fi -echo "$as_me:$LINENO: result: $ac_cv_file__proc_sys_kernel_exec_shield" >&5 -echo "${ECHO_T}$ac_cv_file__proc_sys_kernel_exec_shield" >&6 -if test $ac_cv_file__proc_sys_kernel_exec_shield = yes; then - emacs_cv_execshield=1 -else - emacs_cv_execshield=0 -fi - -if test "$emacs_cv_execshield" = 1; then - # Extract the first word of "setarch", so it can be a program name with args. -set dummy setarch; ac_word=$2 -echo "$as_me:$LINENO: checking for $ac_word" >&5 -echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 -if test "${ac_cv_path_SETARCH+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - case $SETARCH in - [\\/]* | ?:[\\/]*) - ac_cv_path_SETARCH="$SETARCH" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_path_SETARCH="$as_dir/$ac_word$ac_exec_ext" - echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done -done - - test -z "$ac_cv_path_SETARCH" && ac_cv_path_SETARCH="no" - ;; -esac -fi -SETARCH=$ac_cv_path_SETARCH - -if test -n "$SETARCH"; then - echo "$as_me:$LINENO: result: $SETARCH" >&5 -echo "${ECHO_T}$SETARCH" >&6 -else - echo "$as_me:$LINENO: result: no" >&5 -echo "${ECHO_T}no" >&6 -fi - - - if test "$SETARCH" != no && test "$machine" = "intel386"; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_EXECSHIELD 1 -_ACEOF - - else - case "`cat /proc/sys/kernel/exec-shield`" in - 0) ;; - *) - { { echo "$as_me:$LINENO: error: Exec-shield is turned on. -Emacs can not dump itself if exec-shield is turned on. -See \`etc/PROBLEMS' for further information." >&5 -echo "$as_me: error: Exec-shield is turned on. -Emacs can not dump itself if exec-shield is turned on. -See \`etc/PROBLEMS' for further information." >&2;} - { (exit 1); exit 1; }; } - esac - fi -fi #### Extract some information from the operating system and machine files. @@ -4561,7 +4483,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4590,7 +4513,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4660,7 +4584,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4712,7 +4637,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4783,7 +4709,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4835,7 +4762,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -4905,7 +4833,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5075,7 +5004,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5144,7 +5074,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5298,7 +5229,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5391,7 +5323,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5594,7 +5527,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5759,7 +5693,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5822,7 +5757,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5895,7 +5831,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -5981,7 +5918,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6054,7 +5992,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6124,7 +6063,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6183,7 +6123,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6252,7 +6193,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6313,7 +6255,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6379,7 +6322,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6525,7 +6469,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6589,7 +6534,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6654,7 +6600,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6700,7 +6647,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6774,7 +6722,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6839,7 +6788,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6883,7 +6833,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -6954,7 +6905,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7004,7 +6956,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7075,7 +7028,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7125,7 +7079,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7196,7 +7151,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7246,7 +7202,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7317,7 +7274,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7367,7 +7325,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7438,7 +7397,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7488,7 +7448,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7575,7 +7536,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7681,7 +7643,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7741,7 +7704,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -7777,6 +7741,124 @@ fi +echo "$as_me:$LINENO: checking whether heap start address is randomized" >&5 +echo $ECHO_N "checking whether heap start address is randomized... $ECHO_C" >&6 +if test x"$ac_cv_header_unistd_h" != x && test x"$ac_cv_header_stdlib_h" != x +then + if test "$cross_compiling" = yes; then + emacs_cv_randomheap='assuming no' +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdio.h> +#include <unistd.h> +#include <stdlib.h> +int main (int argc, char *argv[]) +{ + unsigned long old_sbrk = 0; + unsigned long this_sbrk = (unsigned long) sbrk(0); + int nr = 1; + if (argc != 1) { + old_sbrk = strtoul (argv[1], 0, 0); + nr = atoi (argv[2])+1; + } + if (argc == 1 || (old_sbrk == this_sbrk && nr < 3)) + { + char buf1[32], buf2[32]; + sprintf (buf1, "%lu", this_sbrk); + sprintf (buf2, "%d", nr); + execl (argv[0], argv[0], buf1, buf2, 0); + exit (-1); + } + exit (this_sbrk == old_sbrk); +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + emacs_cv_randomheap=yes +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +emacs_cv_randomheap=no +fi +rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +else + emacs_cv_randomheap='assuming no' +fi +echo "$as_me:$LINENO: result: $emacs_cv_randomheap" >&5 +echo "${ECHO_T}$emacs_cv_randomheap" >&6 + +if test "$emacs_cv_randomheap" = yes; then + # Extract the first word of "setarch", so it can be a program name with args. +set dummy setarch; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_path_SETARCH+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + case $SETARCH in + [\\/]* | ?:[\\/]*) + ac_cv_path_SETARCH="$SETARCH" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_SETARCH="$as_dir/$ac_word$ac_exec_ext" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + + test -z "$ac_cv_path_SETARCH" && ac_cv_path_SETARCH="no" + ;; +esac +fi +SETARCH=$ac_cv_path_SETARCH + +if test -n "$SETARCH"; then + echo "$as_me:$LINENO: result: $SETARCH" >&5 +echo "${ECHO_T}$SETARCH" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + + if test "$SETARCH" != no && test "$machine" = "intel386"; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_RANDOM_HEAPSTART 1 +_ACEOF + + else + emacs_cv_randomheap=warn + fi +fi + + echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 @@ -7863,7 +7945,6 @@ echo "$as_me:$LINENO: checking for X" >&5 echo $ECHO_N "checking for X... $ECHO_C" >&6 -ac_path_x_has_been_run=yes # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then @@ -7956,7 +8037,7 @@ /usr/openwin/share/include' if test "$ac_x_includes" = no; then - # Guess where to find include files, by looking for a specified header file. + # Guess where to find include files, by looking for Intrinsic.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -8030,7 +8111,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -8090,12 +8172,8 @@ # Update the cache value to reflect the command line values. ac_cv_have_x="have_x=yes \ ac_x_includes=$x_includes ac_x_libraries=$x_libraries" - # It might be that x_includes is empty (headers are found in the - # standard search path. Then output the corresponding message - ac_out_x_includes=$x_includes - test "x$x_includes" = x && ac_out_x_includes="in standard search path" - echo "$as_me:$LINENO: result: libraries $x_libraries, headers $ac_out_x_includes" >&5 -echo "${ECHO_T}libraries $x_libraries, headers $ac_out_x_includes" >&6 + echo "$as_me:$LINENO: result: libraries $x_libraries, headers $x_includes" >&5 +echo "${ECHO_T}libraries $x_libraries, headers $x_includes" >&6 fi if test "$no_x" = yes; then @@ -8259,7 +8337,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -8354,7 +8433,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -8413,7 +8493,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -8497,7 +8578,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -8681,7 +8763,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -8933,7 +9016,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9000,7 +9084,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9069,7 +9154,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9154,7 +9240,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9231,7 +9318,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9285,7 +9373,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9354,7 +9443,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9458,7 +9548,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9525,7 +9616,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9595,7 +9687,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9833,7 +9926,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9907,7 +10001,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -9979,7 +10074,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10061,7 +10157,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10140,7 +10237,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10214,7 +10312,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10282,7 +10381,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10351,7 +10451,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10475,7 +10576,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10571,7 +10673,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10651,7 +10754,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10719,7 +10823,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10864,7 +10969,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -10973,7 +11079,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11118,7 +11225,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11225,7 +11333,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11379,7 +11488,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11454,7 +11564,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11602,7 +11713,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11679,7 +11791,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11826,7 +11939,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -11902,7 +12016,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12015,6 +12130,153 @@ fi +if test "${ac_cv_header_malloc_malloc_h+set}" = set; then + echo "$as_me:$LINENO: checking for malloc/malloc.h" >&5 +echo $ECHO_N "checking for malloc/malloc.h... $ECHO_C" >&6 +if test "${ac_cv_header_malloc_malloc_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_malloc_malloc_h" >&5 +echo "${ECHO_T}$ac_cv_header_malloc_malloc_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking malloc/malloc.h usability" >&5 +echo $ECHO_N "checking malloc/malloc.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <malloc/malloc.h> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking malloc/malloc.h presence" >&5 +echo $ECHO_N "checking malloc/malloc.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <malloc/malloc.h> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: malloc/malloc.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: malloc/malloc.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: malloc/malloc.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: malloc/malloc.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: malloc/malloc.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: malloc/malloc.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: malloc/malloc.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: malloc/malloc.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: malloc/malloc.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------------------ ## +## Report this to the AC_PACKAGE_NAME lists. ## +## ------------------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for malloc/malloc.h" >&5 +echo $ECHO_N "checking for malloc/malloc.h... $ECHO_C" >&6 +if test "${ac_cv_header_malloc_malloc_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_malloc_malloc_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_malloc_malloc_h" >&5 +echo "${ECHO_T}$ac_cv_header_malloc_malloc_h" >&6 + +fi +if test $ac_cv_header_malloc_malloc_h = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_MALLOC_MALLOC_H 1 +_ACEOF + +fi + + + if test "${HAVE_CARBON}" = "yes"; then cat >>confdefs.h <<\_ACEOF @@ -12067,7 +12329,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12212,7 +12475,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12288,7 +12552,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12351,7 +12616,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12432,7 +12698,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12573,7 +12840,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12718,7 +12986,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12794,7 +13063,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -12867,7 +13137,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -13022,7 +13293,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -13088,7 +13360,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -13346,7 +13619,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -13413,7 +13687,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -13565,7 +13840,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -13749,7 +14025,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14076,7 +14353,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14177,7 +14455,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14250,7 +14529,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14329,7 +14609,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14398,7 +14679,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14466,7 +14748,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14540,7 +14823,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14644,7 +14928,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14719,7 +15004,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14871,7 +15157,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -14939,7 +15226,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15116,7 +15404,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15192,7 +15481,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15346,7 +15636,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15497,7 +15788,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15648,7 +15940,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15790,7 +16083,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15834,7 +16128,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -15980,7 +16275,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16024,7 +16320,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16089,7 +16386,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16152,7 +16450,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16254,7 +16553,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16323,7 +16623,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16430,7 +16731,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16533,7 +16835,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16609,7 +16912,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16713,7 +17017,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16805,7 +17110,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16870,7 +17176,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -16936,7 +17243,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17046,7 +17354,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17111,7 +17420,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17191,7 +17501,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17264,7 +17575,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17337,7 +17649,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17410,7 +17723,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17484,7 +17798,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17556,7 +17871,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17631,7 +17947,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17703,7 +18020,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17776,7 +18094,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -17926,7 +18245,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -18072,7 +18392,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -18218,7 +18539,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -18375,7 +18697,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -18521,7 +18844,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -18667,7 +18991,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -18825,7 +19150,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -18983,7 +19309,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19172,7 +19499,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19245,7 +19573,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19313,7 +19642,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19359,7 +19689,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19433,7 +19764,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19497,7 +19829,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19635,7 +19968,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19696,7 +20030,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19841,7 +20176,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -19997,7 +20333,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20168,7 +20505,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20236,7 +20574,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20421,7 +20760,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20714,7 +21054,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20779,7 +21120,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20842,7 +21184,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20908,7 +21251,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -20949,7 +21293,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -21016,7 +21361,8 @@ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? @@ -21234,6 +21580,29 @@ echo " Does Emacs use X toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}" echo +if test "$emacs_cv_randomheap" = warn; then + { echo "$as_me:$LINENO: WARNING: +********************************************************************** + +Heap start address is randomized and no workaround is known. +Emacs will probably dump core when temacs is run in the build phase. +Maybe exec-shield is turned on. Read about exec-shield in \`etc/PROBLEMS' +for further information. + +********************************************************************** +" >&5 +echo "$as_me: WARNING: +********************************************************************** + +Heap start address is randomized and no workaround is known. +Emacs will probably dump core when temacs is run in the build phase. +Maybe exec-shield is turned on. Read about exec-shield in \`etc/PROBLEMS' +for further information. + +********************************************************************** +" >&2;} +fi + # Remove any trailing slashes in these variables. test "${prefix}" != NONE && prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` @@ -21921,8 +22290,8 @@ s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@INSTALL_INFO@,$INSTALL_INFO,;t t s,@EGREP@,$EGREP,;t t +s,@LIBSOUND@,$LIBSOUND,;t t s,@SETARCH@,$SETARCH,;t t -s,@LIBSOUND@,$LIBSOUND,;t t s,@SET_MAKE@,$SET_MAKE,;t t s,@PKG_CONFIG@,$PKG_CONFIG,;t t s,@GTK_CFLAGS@,$GTK_CFLAGS,;t t @@ -22123,6 +22492,11 @@ *) ac_INSTALL=$ac_top_builddir$INSTALL ;; esac + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ @@ -22161,12 +22535,6 @@ fi;; esac done` || { (exit 1); exit 1; } - - if test x"$ac_file" != x-; then - { echo "$as_me:$LINENO: creating $ac_file" >&5 -echo "$as_me: creating $ac_file" >&6;} - rm -f "$ac_file" - fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub
--- a/configure.in Wed Oct 13 02:40:50 2004 +0000 +++ b/configure.in Thu Oct 14 08:50:09 2004 +0000 @@ -1286,25 +1286,6 @@ dnl checks for Unix variants AC_AIX -dnl check if exec-shield is present. -AC_CHECK_FILE(/proc/sys/kernel/exec-shield, emacs_cv_execshield=1, - emacs_cv_execshield=0) -if test "$emacs_cv_execshield" = 1; then - AC_PATH_PROG(SETARCH, setarch, no) - AC_SUBST(SETARCH) - if test "$SETARCH" != no && test "$machine" = "intel386"; then - AC_DEFINE(HAVE_EXECSHIELD, 1, - [Define to 1 if this OS has exec shield and we can handle it.]) - else - case "`cat /proc/sys/kernel/exec-shield`" in - 0) ;; - *) - AC_MSG_ERROR([Exec-shield is turned on. -Emacs can not dump itself if exec-shield is turned on. -See `etc/PROBLEMS' for further information.]) - esac - fi -fi #### Extract some information from the operating system and machine files. @@ -1591,6 +1572,53 @@ [Define as `void' if your compiler accepts `void *'; otherwise define as `char'.])dnl +dnl Test if heap start address is randomized (exec-shield does this). +dnl The test program requires unistd.h and stdlib.h. They are present +dnl on the systems that currently have exec-shield. +AC_MSG_CHECKING(whether heap start address is randomized) +if test x"$ac_cv_header_unistd_h" != x && test x"$ac_cv_header_stdlib_h" != x +then + AC_TRY_RUN([#include <stdio.h> +#include <unistd.h> +#include <stdlib.h> +int main (int argc, char *argv[]) +{ + unsigned long old_sbrk = 0; + unsigned long this_sbrk = (unsigned long) sbrk(0); + int nr = 1; + if (argc != 1) { + old_sbrk = strtoul (argv[1], 0, 0); + nr = atoi (argv[2])+1; + } + if (argc == 1 || (old_sbrk == this_sbrk && nr < 3)) + { + char buf1[32], buf2[32]; + sprintf (buf1, "%lu", this_sbrk); + sprintf (buf2, "%d", nr); + execl (argv[0], argv[0], buf1, buf2, 0); + exit (-1); + } + exit (this_sbrk == old_sbrk); +}], emacs_cv_randomheap=yes, emacs_cv_randomheap=no, + emacs_cv_randomheap='assuming no') +else + emacs_cv_randomheap='assuming no' +fi +AC_MSG_RESULT($emacs_cv_randomheap) + +if test "$emacs_cv_randomheap" = yes; then + AC_PATH_PROG(SETARCH, setarch, no) + AC_SUBST(SETARCH) + if test "$SETARCH" != no && test "$machine" = "intel386"; then + AC_DEFINE(HAVE_RANDOM_HEAPSTART, 1, + [Define to 1 if this OS randomizes the start address of the heap.]) + else + dnl We do the warning at the end of the configure run so it is seen. + emacs_cv_randomheap=warn + fi +fi + + dnl This could be used for targets which can have both byte sexes. dnl We could presumably replace the hardwired WORDS_BIG_ENDIAN generally. dnl AC_C_BIGENDIAN @@ -2285,6 +2313,9 @@ AC_CHECK_HEADER(Carbon/Carbon.h, HAVE_CARBON=yes) fi +dnl Check for malloc/malloc.h on darwin +AC_CHECK_HEADER(malloc/malloc.h, AC_DEFINE(HAVE_MALLOC_MALLOC_H, 1, [Define to 1 if you have the <malloc/malloc.h> header file.])) + if test "${HAVE_CARBON}" = "yes"; then AC_DEFINE(HAVE_CARBON, 1, [Define to 1 if you are using the Carbon API on Mac OS X.]) window_system=mac @@ -3058,6 +3089,19 @@ echo " Does Emacs use X toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}" echo +if test "$emacs_cv_randomheap" = warn; then + AC_MSG_WARN([ +********************************************************************** + +Heap start address is randomized and no workaround is known. +Emacs will probably dump core when temacs is run in the build phase. +Maybe exec-shield is turned on. Read about exec-shield in `etc/PROBLEMS' +for further information. + +********************************************************************** +]) +fi + # Remove any trailing slashes in these variables. [test "${prefix}" != NONE && prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'`
--- a/etc/CENSORSHIP Wed Oct 13 02:40:50 2004 +0000 +++ b/etc/CENSORSHIP Thu Oct 14 08:50:09 2004 +0000 @@ -54,7 +54,7 @@ Of course, I'm making an assumption about just what "indecent" means. I have to do this, because nobody knows for sure. The most obvious -possibile meaning is the meaning it has for television, so I'm using +possible meaning is the meaning it has for television, so I'm using that as a tentative assumption. However, there is a good chance that our courts will reject that interpretation of the law as unconstitutional.
--- a/etc/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/etc/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,16 @@ +2004-10-08 Fr,Ai(Bd,Ai(Bric Bothamy <frederic.bothamy@free.fr> (tiny change) + + * TUTORIAL.fr: Minor wording fix. + +2004-10-04 Luc Teirlinck <teirllm@auburn.edu> + + * enriched.doc: Update for new bindings of `set-left-margin' and + `set-right-margin'. + +2004-10-04 Kim F. Storm <storm@cua.dk> + + * DEBUG: Mention pp and ff commands. + 2004-09-26 Luc Teirlinck <teirllm@auburn.edu> * enriched.doc: `enriched-annotation-alist' is now called
--- a/etc/DEBUG Wed Oct 13 02:40:50 2004 +0000 +++ b/etc/DEBUG Thu Oct 14 08:50:09 2004 +0000 @@ -69,9 +69,11 @@ in the ordinary way, with the `p' command. Then type `pr' with no arguments. This calls a subroutine which uses the Lisp printer. -Note: It is not a good idea to try `pr' if you know that Emacs is in -deep trouble: its stack smashed (e.g., if it encountered SIGSEGV due -to stack overflow), or crucial data structures, such as `obarray', +You can also use `pp value' to print the emacs value directly. + +Note: It is not a good idea to try `pr' or `pp' if you know that Emacs +is in deep trouble: its stack smashed (e.g., if it encountered SIGSEGV +due to stack overflow), or crucial data structures, such as `obarray', corrupted, etc. In such cases, the Emacs subroutine called by `pr' might make more damage, like overwrite some data that is important for debugging the original problem. @@ -442,6 +444,9 @@ Emacs compiled with GLYPH_DEBUG defined; type "C-h f dump- TAB" and "C-h f trace- TAB" to see the full list. +When you debug display problems running emacs under X, you can use +the `ff' command to flush all pending display updates to the screen. + ** Debugging LessTif
--- a/etc/NEWS Wed Oct 13 02:40:50 2004 +0000 +++ b/etc/NEWS Thu Oct 14 08:50:09 2004 +0000 @@ -174,6 +174,21 @@ * Changes in Emacs 21.4 +++ +** New function `looking-back' checks whether a regular expression matches +the text before point. Specifying the LIMIT argument bounds how far +back the match can start; this is a way to keep it from taking too long. + ++++ +** New functions `make-progress-reporter', `progress-reporter-update', +`progress-reporter-force-update' and `progress-reporter-done' provide +a simple and efficient way of printing progress messages to the user. + ++++ +** In Enriched mode, `set-left-margin' and `set-right-margin' are now +by default bound to `C-c [' and `C-c ]' instead of the former `C-c C-l' +and `C-c C-r'. + ++++ ** In processing a local variables list, Emacs strips the prefix and suffix are from every line before processing all the lines. @@ -1237,12 +1252,23 @@ new-kill-line is on C-k +++ +** Vertical scrolling is now possible within incremental search. +To enable this feature, customize the new user option +`isearch-allow-scroll'. User written commands which satisfy stringent +constraints can be marked as "scrolling commands". See the Emacs manual +for details. + ++++ ** C-w in incremental search now grabs either a character or a word, making the decision in a heuristic way. This new job is done by the command `isearch-yank-word-or-char'. To restore the old behavior, bind C-w to `isearch-yank-word' in `isearch-mode-map'. +++ +** C-y in incremental search now grabs the next line if point is already +at the end of a line. + ++++ ** C-M-w deletes and C-M-y grabs a character in isearch mode. Another method to grab a character is to enter the minibuffer by `M-e' and to type `C-f' at the end of the search string in the minibuffer. @@ -1466,6 +1492,10 @@ attempt to construct a unique auto-save name (e.g. for remote files). +++ +** There is a new calendar package, icalendar.el, that can be used to +convert Emacs diary entries to/from the iCalendar format. + ++++ ** Diary sexp entries can have custom marking in the calendar. Diary sexp functions which only apply to certain days (such as `diary-block' or `diary-cyclic') now take an optional parameter MARK, @@ -1481,6 +1511,11 @@ year and day number, and moves to that date. Negative day numbers count backward from the end of the year. ++++ +** The new Calendar function `calendar-goto-iso-week' (g w) +prompts for a year and a week number, and moves to the first +day of that ISO week. + --- ** The functions `holiday-easter-etc' and `holiday-advent' now take arguments, and only report on the specified holiday rather than all. @@ -2558,9 +2593,8 @@ `define-fringe-bitmap', and FACE is an optional face name to be used for displaying the bitmap. -*** New function `fringe-bitmaps-at-pos' returns a cons (LEFT . RIGHT) -identifying the current fringe bitmaps in the display line at a given -buffer position. A nil value means no bitmap. +*** New function `fringe-bitmaps-at-pos' returns the current fringe +bitmaps in the display line at a given buffer position. ** Multiple overlay arrows can now be defined and managed via the new variable `overlay-arrow-variable-list'. It contains a list of @@ -2579,10 +2613,12 @@ line in current buffer, or if optional buffer position is given, line number of corresponding line in current buffer. ++++ ** The default value of `sentence-end' is now defined using the new variable `sentence-end-without-space' which contains such characters that end a sentence without following spaces. ++++ ** The function `sentence-end' should be used to obtain the value of the variable `sentence-end'. If the variable `sentence-end' is nil, then this function returns the regexp constructed from the variables
--- a/etc/TODO Wed Oct 13 02:40:50 2004 +0000 +++ b/etc/TODO Thu Oct 14 08:50:09 2004 +0000 @@ -34,6 +34,9 @@ ** Implement a smoother vertical scroll facility, one that allows C-v to scroll through a tall image. +** Implement intelligent search/replace, going beyond query-replace + (see http://graphics.csail.mit.edu/~rcm/chi04.pdf). + ** Implement other text formatting properties. *** Footnotes that can appear either in place or at the end of the page. *** text property that says "don't break line in middle of this".
--- a/etc/TUTORIAL.fr Wed Oct 13 02:40:50 2004 +0000 +++ b/etc/TUTORIAL.fr Thu Oct 14 08:50:09 2004 +0000 @@ -17,7 +17,7 @@ Dans ce didacticiel, les caractères ">>" en marge gauche indiquent les directions à suivre pour essayer une commande. Ainsi : <<Lignes blanches insérées après cette ligne par help-with-tutorial>> -[Centre de page deliberéement vide. Le texte continue ci-dessous.] +[Centre de page delibérément vide. Le texte continue ci-dessous.] >> Tapez C-v (Voir l'écran suivant) pour passer à l'écran suivant (faites-le, pressez la touche CTRL tout en pressant la touche v). À partir de maintenant, vous devrez le faire à chaque fois que @@ -36,7 +36,7 @@ >> Faites M-v, puis C-v plusieurs fois. Si votre terminal en dispose, vous pouvez également utiliser les -touches PgUp et PgDn pour monter ou descendre d'un écran, bien les +touches PgUp et PgDn pour monter ou descendre d'un écran, bien que les combinaisons C-v et M-v soient plus efficaces. * RÉSUMÉ @@ -347,7 +347,7 @@ Lorsqu'une ligne de texte devient trop longue pour tenir sur une seule ligne de l'écran, elle se « continue » sur une deuxième ligne d'écran. Une barre de fraction inverse (« \ ») ou, si vous utilisez un -environnement grapgique, une petite flèche recourbée, sur la marge +environnement graphique, une petite flèche recourbée, sur la marge droite indique une ligne qui se poursuit sur la ligne suivante. >> Insérez du texte jusqu'à atteindre la marge droite et continuez @@ -423,7 +423,7 @@ Notez qu'un simple C-k supprime le contenu de la ligne et qu'un second détruit la ligne elle-même, ce qui fait remonter toutes les lignes suivantes. C-k traite son paramètre numérique d'une façon spéciale : -il détruit ce nombre de lignes ET leurs contenus. Ce n'est pas une +il détruit ce nombre de lignes ET leur contenu. Ce n'est pas une simple répétition : C-u 2 C-k détruit deux lignes et leurs Newlines alors que taper deux fois C-k n'aurait pas le même effet. @@ -523,7 +523,7 @@ cas où vous décideriez ensuite d'annuler vos modifications. Si vous examinez le bas de l'écran, vous verrez une ligne qui commence -et finit par des tirets et débute par « --:-- TUTORIAL.fr » ou quelque +et finit par des tirets et débute par « -1:-- TUTORIAL.fr » ou quelque chose comme ça. Cette partie de l'écran montre normalement le nom du fichier que vous êtes en train de visiter. Pour l'instant, vous visitez un fichier appelé « TUTORIAL.fr », qui est votre copie @@ -584,7 +584,7 @@ encore. C'est ainsi que l'on crée un fichier avec Emacs : on trouve le fichier, qui démarre vide, puis on insère du texte. Lorsque l'on demande à « sauvegarder » le fichier, Emacs crée alors vraiment le -fichier avec le texte que l'on a inséré. À partir de ce moment là, +fichier avec le texte que l'on a inséré. À partir de ce moment-là, vous pouvez considérer que vous éditez un fichier déjà existant. @@ -666,10 +666,10 @@ * EXTENSION DU JEU DE COMMANDES ------------------------------- -Il y bien plus de commandes Emacs qu'il ne serait possible d'en créer -avec tous les caractères de contrôle et les caractères Meta. Emacs -contourne ce problème à l'aide de la commande X (eXtension). Celle-ci -se présente sous deux déclinaisons : +Il y a bien plus de commandes Emacs qu'il ne serait possible d'en +créer avec tous les caractères de contrôle et Meta. Emacs contourne ce +problème à l'aide de la commande X (eXtension). Celle-ci se présente +sous deux déclinaisons : C-x eXtension caractère, suivie d'un seul caractère. M-x eXtension d'une commande nommée, suivie d'un nom long. @@ -742,7 +742,7 @@ Lorsque vous avez modifié un fichier, mais que vous ne l'avez pas encore sauvegardé, ces modifications pourraient être perdues si votre -système se plantait. Pour vous protéger ce de problème, Emacs écrit +système se plantait. Pour vous protéger de ce problème, Emacs écrit périodiquement un fichier de « sauvegarde automatique » pour chaque fichier en cours d'édition. Le nom de ce fichier commence et se termine par un # : si, par exemple, votre fichier s'appelle @@ -772,14 +772,14 @@ La ligne placée immédiatement au dessus de la zone d'écho s'appelle la « ligne de mode ». Elle affiche quelque chose comme ça : ---:** TUTORIAL.fr (Fundamental)--L752--67%---------------- +-1:** TUTORIAL.fr (Fundamental)--L752--67%---------------- Cette ligne donne des informations sur l'état d'Emacs et sur le texte que vous êtes en train d'éditer. Vous savez déjà ce que signifie le nom de fichier -- c'est celui que vous avez chargé. -NN%-- indique votre position actuelle dans le -texte ; cela signifie que NN pourcent du texte se trouve au dessus du +texte ; cela signifie que NN pour cent du texte se trouve au dessus du sommet de l'écran. Si le début du fichier est sur l'écran, il s'affichera --Top-- et non --00%--. Si le bas du texte est sur l'écran, il s'affichera --Bot--. Si tout le texte tient dans l'écran, @@ -802,7 +802,7 @@ prévus pour éditer différents langages et/ou types de texte (mode Lisp, mode Text, etc). À tout instant, il n'y a qu'un seul mode majeur actif et son nom se trouve toujours dans la ligne de mode, à l'endroit -ou « Fundamental » se trouve actuellement. +où « Fundamental » se trouve actuellement. Chaque mode majeur modifie le comportement de quelques commandes. Il existe, par exemple, des commandes pour créer des commentaires dans un @@ -940,7 +940,7 @@ C-s s'applique également à C-r, sauf que la direction de la recherche est inversée. -* FENETRES MULTIPLES +* FENÊTRES MULTIPLES -------------------- L'une des caractéristiques les plus agréables d'Emacs est que vous
--- a/etc/enriched.doc Wed Oct 13 02:40:50 2004 +0000 +++ b/etc/enriched.doc Thu Oct 14 08:50:09 2004 +0000 @@ -98,8 +98,8 @@ <indent>The fill functions also understand margins, which can be set for any region of a document. In addition to the menu items, which increase or decrease the margins, there are two commands for -setting the margins absolutely: <fixed>C-c C-l (set-left-margin)</fixed> and <fixed>C-c -C-r (set-right-margin)</fixed>. +setting the margins absolutely: <fixed>C-c [ (set-left-margin)</fixed> and <fixed>C-c +] (set-right-margin)</fixed>. You <indent>can change indentation at any point in a paragraph, which
--- a/lisp/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,4 +1,233 @@ -2004-10-03 Stefan <monnier@iro.umontreal.ca> +2004-10-13 Daniel Pfeiffer <occitan@esperanto.org> + + * button.el (button-activate): Allow a marker to display as an + action. + + * help-fns.el (describe-variable): Use it to make "below" a + hyperlink. + + * help.el (describe-mode): Use it to make minor mode list into + hyperlinks. + +2004-10-14 Masatake YAMATO <jet@gyve.org> + + * progmodes/gud.el (gdb-script-beginning-of-defun): New function. + (gdb-script-end-of-defun): New function. + (gdb-script-mode): Use `gdb-script-beginning-of-defun' and + `gdb-script-end-of-defun' as *-of-defun-function. + +2004-10-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc.el (vc-annotate-display-select): Fix typo. + + * subr.el (substitute-key-definition-key): New function. + (substitute-key-definition): Use it with map-keymap. + (event-modifiers): Use push. + (mouse-movement-p, with-temp-buffer): Simplify. + +2004-10-12 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.0.45. + + * net/tramp.el (top): Apply `def-edebug-spec' only if function is + defined. This is not the case for XEmacs without package "edebug". + (tramp-set-auto-save-file-modes): Set permissions of autosaved + remote files to the permissions of the original file. This is not + the case for Emacs < 21.3.50 and XEmacs < 21.5. Add function to + `auto-save-hook'. Reported by Thomas Prokosch <thomas@nadev.net>. + (tramp-perl-decode): Fix an error in Perl implementation. + $pending must be cleared every loop. Reported by Benjamin Place + <benjaminplace@sprintmail.com> + + * net/tramp-smb.el (tramp-smb-advice-PC-do-completion): + Don't activate advice during definition. This is done later on, + depending on test result of `substitute-in-file-name'. + Suggested by Stefan Monnier <monnier@iro.umontreal.ca>. + +2004-10-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * pcvs-parse.el (cvs-parse-commit): Fix parsing for new commit message. + + * emacs-lisp/lisp.el (mark-sexp): Preserve direction when repeating. + +2004-10-12 David Ponce <david@dponce.com> + + * recentf.el (recentf-edit-list): Update the menu when the recentf + list has been modified. + +2004-10-12 Simon Josefsson <jas@extundo.com> + + * net/tls.el (tls-certtool-program): New variable. + (tls-certificate-information): New function, based on + ssl-certificate-information. + +2004-10-12 Kenichi Handa <handa@m17n.org> + + * international/mule.el (coding-system-equal): Move from mule-util.el. + + * international/mule-util.el (coding-system-equal): Move to mule.el. + +2004-10-12 Kim F. Storm <storm@cua.dk> + + * kmacro.el (kmacro-insert-counter, kmacro-add-counter): Use and + reset kmacro-initial-counter-value if set. + (kmacro-set-counter): Only set kmacro-counter if defining or executing + macro. Set kmacro-initial-counter-value otherwise. Never set both. + (kmacro-display): Show macro counter if non-zero. + + * subr.el (substitute-key-definition): Mention command remapping + in doc string. + +2004-10-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * pcvs-defs.el (pcl-cvs-load-hook): Remove unused var. + + * font-lock.el (font-lock-apply-highlight): Fix last change. + +2004-10-11 Simon Josefsson <jas@extundo.com> + + * mail/smtpmail.el (smtpmail-open-stream): Look for + starttls-gnutls-program instead of starttls-program iff + starttls-use-gnutls is non-nil. + (smtpmail-open-stream): Don't overwrite user settings of + starttls-extra-arguments and starttls-extra-args. + +2004-10-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * comint.el (comint-mouse-insert-input): Remove. + (comint-insert-input): Make it work for mouse bindings. + (comint-mode-map): Move defs into the declaration. + (comint-output-filter): Typo. + + * diff-mode.el (diff-current-defun): Fix 2004-06-13's change. + +2004-10-10 Kai Grossjohann <kai.grossjohann@gmx.net> + + * net/ange-ftp.el (ange-ftp-remote-shell): Remove variable. + (ange-ftp-call-chmod): Reference remote-shell-program instead of + ange-ftp-remote-shell. + +2004-10-10 Andreas Schwab <schwab@suse.de> + + * emacs-lisp/byte-opt.el (byte-optimize-backward-word): Optimize + `(backward-word)' to `(forward-word -1)', not `(forward-char -1)'. + Reported by <sri@asu.edu>. + +2004-10-10 Benjamin Rutt <brutt@bloomington.in.us> + + * vc.el (vc-annotate-mode): Remove variable. + (vc-annotate-display-select): Only call vc-annotate-mode + if we're not in that mode already. + +2004-10-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * imenu.el (imenu--completion-buffer): Don't return t for rescan. + (imenu-choose-buffer-index): Check here for rescan instead. + + * font-lock.el (font-lock-apply-highlight): Explicitly check the case + where the face expression evals to nil. + + * textmodes/tex-mode.el (tex-font-lock-append-prop): New fun. + (tex-font-lock-keywords-2): Use it. + (tex-font-lock-syntactic-keywords): Fix the `verbatim' treatment. + + * emacs-lisp/lisp-mode.el (lisp-fill-paragraph): Fix backslashes. + +2004-10-09 Kim F. Storm <storm@cua.dk> + + * subr.el (progress-reporter-update): Define before first usage. + (make-progress-reporter): Doc fix. + +2004-10-09 Luc Teirlinck <teirllm@auburn.edu> + + * textmodes/paragraphs.el (sentence-end-double-space) + (sentence-end-without-period, sentence-end-without-space) + (sentence-end): Doc fixes. + +2004-10-08 Peter Seibel <peter@javamonkey.com> (tiny change) + + * emacs-lisp/lisp-mode.el (lisp-fill-paragraph): + Change paragraph-start regexp so we don't fill code starting with #'(. + +2004-10-08 Sebastien Kirche <seki@seki.fr> (tiny change) + + * mail/mail-extr.el (mail-extr-ignore-realname-equals-mailbox-name): + New defcustom. + (extract-address-components): Use it. + +2004-10-08 Paul Pogonyshev <pogonyshev@gmx.net> + + * subr.el (make-progress-reporter, progress-reporter-update) + (progress-reporter-force-update, progress-reporter-do-update) + (progress-reporter-done): New functions. + + * tar-mode.el (tar-summarize-buffer): Use progress reporter. + + * progmodes/etags.el (etags-tags-completion-table): Use progress + reporter. + (etags-tags-apropos): Likewise. + +2004-10-08 Alan Mackenzie <acm@muc.de> + + * isearch.el (isearch-yank-line): C-y yanks to next EOL, not end + of current line. + +2004-10-08 Masatake YAMATO <jet@gyve.org> + + * server.el (server-process-filter): Wrap `process-send-region' + by `condition-case' to guard the case when the pipe to PROC is closed. + +2004-10-07 Mark A. Hershberger <mah@everybody.org> + + * xml.el (xml-substitute-special): Limit handling of external entities. + +2004-10-06 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-ann3): (Re-)initialise gdb-input-queue. + +2004-10-06 John Paul Wallington <jpw@gnu.org> + + * xml.el (xml-parse-dtd): Fix `error' call. + +2004-10-05 Mark A. Hershberger <mah@everybody.org> + + * xml.el (xml-substitute-special): Return a single string instead + of a list of strings if an entity substitution is made. + +2004-10-05 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el: New file. + +2004-10-05 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-done): Set mark after running hook. + Suggested by Drew Adams <drew.adams@oracle.com>. + + * info.el (Info-history, Info-toc): Fix Info headers. + (Info-toc): Narrow buffer before Info-fontify-node. + (Info-build-toc): Don't check for special Info file names. + Set main-file to nil if Info-find-file returns a symbol. + +2004-10-05 Emilio C. Lopes <eclig@gmx.net>: + + * calendar/calendar.el (calendar-goto-iso-week): Add autoload. + (calendar-mode-map): Add binding for `calendar-goto-iso-week'. + * calendar/cal-menu.el (calendar-mode-map): Ditto. + +2004-10-05 Glenn Morris <gmorris@ast.cam.ac.uk> + + * calendar/cal-iso.el (calendar-iso-read-args): New function, + for old interactive spec from calendar-goto-iso-date. + (calendar-goto-iso-date): Use it. + (calendar-goto-iso-week): New function. Suggested by Emilio + C. Lopes <eclig@gmx.net>. + +2004-10-04 Luc Teirlinck <teirllm@auburn.edu> + + * textmodes/enriched.el (enriched-mode-map): Give `set-left-margin' and + `set-right-margin' bindings that follow the minor mode conventions. + +2004-10-03 Stefan Monnier <monnier@iro.umontreal.ca> * textmodes/tex-mode.el (tex-dvi-view-command): Use `yap' on w32. (tex-font-lock-keywords-1): Add url and nolinkurl for args with `_'. @@ -62,7 +291,7 @@ * diff-mode.el (diff-file-header-re): Tighten up regexp a tiny bit. (diff-fixup-modifs): Catch unified-diff file-headers. -2004-09-28 Stefan <monnier@iro.umontreal.ca> +2004-09-28 Stefan Monnier <monnier@iro.umontreal.ca> * dired.el (dired-view-command-alist): Use more efficient regexps. Remove dubious arguments. @@ -102,7 +331,7 @@ (pr-delete-file): Check if file exists before deleting it. Reported by Lennart Borgman <lennart.borgman.073@student.lu.se>. -2004-09-26 Stefan <monnier@iro.umontreal.ca> +2004-09-26 Stefan Monnier <monnier@iro.umontreal.ca> * term.el (term-display-table): New variable. (term-mode): Use it. @@ -126,7 +355,7 @@ (term-stop-output-log): Rename from `term-stop-photo'. (term-switch-to-alternate-sub-buffer): Comment out, unused. -2004-09-25 Stefan <monnier@iro.umontreal.ca> +2004-09-25 Stefan Monnier <monnier@iro.umontreal.ca> * dired.el (dired-move-to-filename): Don't output a message if raise-error is non-nil. Fix return position and value. @@ -270,7 +499,7 @@ * progmodes/sh-script.el (sh-mode-default-syntax-table): Set syntax of = to "." (punctuation). -2004-09-19 Stefan <monnier@iro.umontreal.ca> +2004-09-19 Stefan Monnier <monnier@iro.umontreal.ca> * subr.el (event-basic-type): Fix mask (extend to 22bits).
--- a/lisp/button.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/button.el Thu Oct 14 08:50:09 2004 +0000 @@ -78,6 +78,7 @@ (put 'default-button 'mouse-face 'highlight) (put 'default-button 'keymap button-map) (put 'default-button 'type 'button) +;; action may be either a function to call, or a marker to go to (put 'default-button 'action 'ignore) (put 'default-button 'help-echo "mouse-2, RET: Push this button") ;; Make overlay buttons go away if their underlying text is deleted. @@ -217,9 +218,14 @@ If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action instead of its normal action; if the button has no mouse-action, the normal action is used instead." - (funcall (or (and use-mouse-action (button-get button 'mouse-action)) - (button-get button 'action)) - button)) + (let ((action (or (and use-mouse-action (button-get button 'mouse-action)) + (button-get button 'action)))) + (if (markerp action) + (save-selected-window + (select-window (display-buffer (marker-buffer action))) + (goto-char action) + (recenter 0)) + (funcall action button)))) (defun button-label (button) "Return BUTTON's text label." @@ -373,10 +379,11 @@ (defun push-button (&optional pos use-mouse-action) "Perform the action specified by a button at location POS. -POS may be either a buffer position or a mouse-event. -If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action +POS may be either a buffer position or a mouse-event. If +USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action instead of its normal action; if the button has no mouse-action, -the normal action is used instead. +the normal action is used instead. The action may be either a +function to call or a marker to display. POS defaults to point, except when `push-button' is invoked interactively as the result of a mouse-event, in which case, the mouse event is used.
--- a/lisp/calc/calc-help.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/calc/calc-help.el Thu Oct 14 08:50:09 2004 +0000 @@ -93,18 +93,15 @@ (defun calc-describe-copying () (interactive) - (calc-info) - (Info-goto-node "Copying")) + (calc-info-goto-node "Copying")) (defun calc-describe-distribution () (interactive) - (calc-info) - (Info-goto-node "Reporting Bugs")) + (calc-info-goto-node "Reporting Bugs")) (defun calc-describe-no-warranty () (interactive) - (calc-info) - (Info-goto-node "Copying") + (calc-info-goto-node "Copying") (let ((case-fold-search nil)) (search-forward " NO WARRANTY")) (beginning-of-line) @@ -190,13 +187,13 @@ (message "Reading Calc summary from manual...") (save-window-excursion (save-excursion - (calc-info) - (Info-goto-node "Summary") + (calc-info-goto-node "Summary") (goto-char (point-min)) (forward-line 1) (copy-to-buffer "*Calc Summary*" (point) (point-max)) - (Info-last))) + (if Info-history + (Info-last)))) (setq case-fold-search nil) (re-search-forward "^\\(.*\\)\\[\\.\\. a b") (setq calc-summary-indentation @@ -299,35 +296,62 @@ (calc-describe-thing desc "Key Index" nil (string-match "[A-Z][A-Z][A-Z]" desc)))))) +(defvar calc-help-function-list nil + "List of functions provided by Calc.") + +(defvar calc-help-variable-list nil + "List of variables provided by Calc.") + +(defun calc-help-index-entries (&rest indices) + "Create a list of entries from the INDICES in the Calc info manual." + (let ((entrylist '()) + entry) + (require 'info nil t) + (while indices + (condition-case nil + (with-temp-buffer + (Info-mode) + (Info-goto-node (concat "(Calc)" (car indices) " Index")) + (goto-char (point-min)) + (while (re-search-forward "\n\\* \\(.*\\): " nil t) + (setq entry (match-string 1)) + (if (and (not (string-match "<[1-9]+>" entry)) + (not (string-match "(.*)" entry)) + (not (string= entry "Menu"))) + (unless (assoc entry entrylist) + (setq entrylist (cons entry entrylist)))))) + (error nil)) + (setq indices (cdr indices))) + entrylist)) + (defun calc-describe-function (&optional func) (interactive) + (unless calc-help-function-list + (setq calc-help-function-list + (calc-help-index-entries "Function" "Command"))) (or func - (setq func (intern (completing-read "Describe function: " - obarray nil t "calcFunc-")))) - (setq func (symbol-name func)) + (setq func (completing-read "Describe function: " + calc-help-function-list + nil t))) (if (string-match "\\`calc-." func) (calc-describe-thing func "Command Index") - (calc-describe-thing (if (string-match "\\`calcFunc-." func) - (substring func 9) - func) - "Function Index"))) + (calc-describe-thing func "Function Index"))) (defun calc-describe-variable (&optional var) (interactive) + (unless calc-help-variable-list + (setq calc-help-variable-list + (calc-help-index-entries "Variable"))) (or var - (setq var (intern (completing-read "Describe variable: " - obarray nil t "var-")))) - (setq var (symbol-name var)) - (calc-describe-thing var "Variable Index" - (if (string-match "\\`var-." var) - (substring var 4) - var))) + (setq var (completing-read "Describe variable: " + calc-help-variable-list + nil t))) + (calc-describe-thing var "Variable Index")) (defun calc-describe-thing (thing where &optional target not-quoted) (message "Looking for `%s' in %s..." thing where) (let ((savewin (current-window-configuration))) - (calc-info) - (Info-goto-node where) + (calc-info-goto-node where) (or (let ((case-fold-search nil)) (re-search-forward (format "\n\\* +%s: \\(.*\\)\\." (regexp-quote thing)) @@ -338,7 +362,8 @@ nil t) (setq thing (format "%s9" (substring thing 0 -1)))) (progn - (Info-last) + (if Info-history + (Info-last)) (set-window-configuration savewin) (error "Can't find `%s' in %s" thing where))) (let (Info-history)
--- a/lisp/calc/calc-misc.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/calc/calc-misc.el Thu Oct 14 08:50:09 2004 +0000 @@ -160,21 +160,25 @@ (select-window (get-largest-window)) (info "Calc")) +(defun calc-info-goto-node (node) + "Go to a node in the Calculator info documentation." + (interactive) + (select-window (get-largest-window)) + (Info-goto-node (concat "(Calc)" node))) + (defun calc-tutorial () "Run the Emacs Info system on the Calculator Tutorial." (interactive) (if (get-buffer-window "*Calculator*") (calc-quit)) - (calc-info) - (Info-goto-node "Interactive Tutorial") + (calc-info-goto-node "Interactive Tutorial") (calc-other-window) (message "Welcome to the Calc Tutorial!")) (defun calc-info-summary () "Run the Emacs Info system on the Calculator Summary." (interactive) - (calc-info) - (Info-goto-node "Summary")) + (calc-info-goto-node "Summary")) (defun calc-help () (interactive)
--- a/lisp/calc/calc.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/calc/calc.el Thu Oct 14 08:50:09 2004 +0000 @@ -942,7 +942,8 @@ calcDigit-algebraic calcDigit-edit) ("calc-misc" another-calc calc-big-or-small calc-dispatch-help - calc-help calc-info calc-info-summary calc-inv calc-last-args-stub + calc-help calc-info calc-info-goto-node calc-info-summary calc-inv + calc-last-args-stub calc-missing-key calc-mod calc-other-window calc-over calc-percent calc-pop-above calc-power calc-roll-down calc-roll-up calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
--- a/lisp/calendar/cal-iso.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/calendar/cal-iso.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,8 +1,9 @@ ;;; cal-iso.el --- calendar functions for the ISO calendar -;; Copyright (C) 1995, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1997, 2004 Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> +;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> ;; Keywords: calendar ;; Human-Keywords: ISO calendar, calendar, diary @@ -96,27 +97,39 @@ (message "ISO date: %s" (calendar-iso-date-string (calendar-cursor-to-date t)))) +(defun calendar-iso-read-args (&optional dayflag) + "Interactively read the arguments for an iso date command." + (let* ((today (calendar-current-date)) + (year (calendar-read + "ISO calendar year (>0): " + '(lambda (x) (> x 0)) + (int-to-string (extract-calendar-year today)))) + (no-weeks (extract-calendar-month + (calendar-iso-from-absolute + (1- + (calendar-dayname-on-or-before + 1 (calendar-absolute-from-gregorian + (list 1 4 (1+ year)))))))) + (week (calendar-read + (format "ISO calendar week (1-%d): " no-weeks) + '(lambda (x) (and (> x 0) (<= x no-weeks))))) + (day (if dayflag (calendar-read + "ISO day (1-7): " + '(lambda (x) (and (<= 1 x) (<= x 7)))) + 1))) + (list (list week day year)))) + (defun calendar-goto-iso-date (date &optional noecho) "Move cursor to ISO DATE; echo ISO date unless NOECHO is t." - (interactive - (let* ((today (calendar-current-date)) - (year (calendar-read - "ISO calendar year (>0): " - '(lambda (x) (> x 0)) - (int-to-string (extract-calendar-year today)))) - (no-weeks (extract-calendar-month - (calendar-iso-from-absolute - (1- - (calendar-dayname-on-or-before - 1 (calendar-absolute-from-gregorian - (list 1 4 (1+ year)))))))) - (week (calendar-read - (format "ISO calendar week (1-%d): " no-weeks) - '(lambda (x) (and (> x 0) (<= x no-weeks))))) - (day (calendar-read - "ISO day (1-7): " - '(lambda (x) (and (<= 1 x) (<= x 7)))))) - (list (list week day year)))) + (interactive (calendar-iso-read-args t)) + (calendar-goto-date (calendar-gregorian-from-absolute + (calendar-absolute-from-iso date))) + (or noecho (calendar-print-iso-date))) + +(defun calendar-goto-iso-week (date &optional noecho) + "Move cursor to ISO DATE; echo ISO date unless NOECHO is t. +Interactively, goes to the first day of the specified week." + (interactive (calendar-iso-read-args)) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-iso date))) (or noecho (calendar-print-iso-date)))
--- a/lisp/calendar/cal-menu.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/calendar/cal-menu.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,9 +1,10 @@ ;;; cal-menu.el --- calendar functions for menu bar and popup menu support -;; Copyright (C) 1994, 1995, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Lara Rios <lrios@coewl.cen.uiuc.edu> +;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> ;; Keywords: calendar ;; Human-Keywords: calendar, popup menus, menu bar @@ -121,6 +122,8 @@ '("Astronomical Date" . calendar-goto-astro-day-number)) (define-key calendar-mode-map [menu-bar goto iso] '("ISO Date" . calendar-goto-iso-date)) +(define-key calendar-mode-map [menu-bar goto iso-week] + '("ISO Week" . calendar-goto-iso-week)) (define-key calendar-mode-map [menu-bar goto day-of-year] '("Day of Year" . calendar-goto-day-of-year)) (define-key calendar-mode-map [menu-bar goto gregorian]
--- a/lisp/calendar/calendar.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/calendar/calendar.el Thu Oct 14 08:50:09 2004 +0000 @@ -1769,6 +1769,10 @@ "Move cursor to ISO date." t) +(autoload 'calendar-goto-iso-week "cal-iso" + "Move cursor to start of ISO week." + t) + (autoload 'calendar-print-iso-date "cal-iso" "Show the ISO date equivalents of date." t) @@ -2204,6 +2208,7 @@ (define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date) (define-key calendar-mode-map "gp" 'calendar-goto-persian-date) (define-key calendar-mode-map "gc" 'calendar-goto-iso-date) + (define-key calendar-mode-map "gw" 'calendar-goto-iso-week) (define-key calendar-mode-map "gf" 'calendar-goto-french-date) (define-key calendar-mode-map "gml" 'calendar-goto-mayan-long-count-date) (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/calendar/icalendar.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,1299 @@ +;;; icalendar.el --- iCalendar implementation + +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. + +;; Author: Ulf Jasper <ulf.jasper@web.de> +;; Created: August 2002 +;; Keywords: calendar +;; Human-Keywords: calendar, diary, iCalendar, vCalendar + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This package is documented in the Emacs Manual. + + +;;; History: + +;; 0.06 Bugfixes regarding icalendar-import-format-*. +;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau. + +;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*, +;; icalendar-import-ignored-properties, and +;; icalendar-import-separator with icalendar-import-format(-*). +;; icalendar-import-file and icalendar-convert-diary-to-ical +;; have an extra parameter which should prevent them from +;; erasing their target files (untested!). +;; Tested with Emacs 21.3.2 + +;; 0.04: Bugfix: import: double quoted param values did not work +;; Read DURATION property when importing. +;; Added parameter icalendar-duration-correction. + +;; 0.03: Export takes care of european-calendar-style. +;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 + +;; 0.02: Should work in XEmacs now. Thanks to Len Trigg for the +;; XEmacs patches! +;; Added exporting from Emacs diary to ical. +;; Some bugfixes, after testing with calendars from +;; http://icalshare.com. +;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 + +;; 0.01: First published version. Trial version. Alpha version. + +;; ====================================================================== +;; To Do: + +;; * Import from ical: +;; + Need more properties for icalendar-import-format +;; + check vcalendar version +;; + check (unknown) elements +;; + recurring events! +;; + works for european style calendars only! Does it? +;; + alarm +;; + exceptions in recurring events +;; + the parser is too soft +;; + error log is incomplete +;; + nice to have: #include "webcal://foo.com/some-calendar.ics" + +;; * Export into ical +;; + diary-date, diary-float, and self-made sexp entries are not +;; understood +;; + timezones, currently all times are local! + +;; * Other things +;; + defcustom icalendar-import-ignored-properties does not work with +;; XEmacs. +;; + clean up all those date/time parsing functions +;; + Handle todo items? +;; + Check iso 8601 for datetime and period +;; + Which chars to (un)escape? +;; + Time to find out how the profiler works? + + +;;; Code: + +(defconst icalendar-version 0.06 + "Version number of icalendar.el.") + +;; ====================================================================== +;; Customizables +;; ====================================================================== +(defgroup icalendar nil + "Icalendar support." + :prefix "icalendar-" + :group 'calendar) + +(defcustom icalendar-import-format + "%s%d%l%o" + "Format string for importing events from iCalendar into Emacs diary. +This string defines how iCalendar events are inserted into diary +file. Meaning of the specifiers: +%d Description, see `icalendar-import-format-description' +%l Location, see `icalendar-import-format-location' +%o Organizer, see `icalendar-import-format-organizer' +%s Subject, see `icalendar-import-format-subject'" + :type 'string + :group 'icalendar) + +(defcustom icalendar-import-format-subject + "%s" + "Format string defining how the subject element is formatted. +This applies only if the subject is not empty! `%s' is replaced +by the subject." + :type 'string + :group 'icalendar) + +(defcustom icalendar-import-format-description + "\n Desc: %s" + "Format string defining how the description element is formatted. +This applies only if the description is not empty! `%s' is +replaced by the description." + :type 'string + :group 'icalendar) + +(defcustom icalendar-import-format-location + "\n Location: %s" + "Format string defining how the location element is formatted. +This applies only if the location is not empty! `%s' is replaced +by the location." + :type 'string + :group 'icalendar) + +(defcustom icalendar-import-format-organizer + "\n Organizer: %s" + "Format string defining how the organizer element is formatted. +This applies only if the organizer is not empty! `%s' is +replaced by the organizer." + :type 'string + :group 'icalendar) + +(defcustom icalendar-duration-correction + t + "Workaround for all-day events. +If non-nil the length=duration of iCalendar appointments that +have a length of exactly n days is decreased by one day. This +fixes problems with all-day events, which appear to be one day +longer than they are." + :type 'boolean + :group 'icalendar) + + +;; ====================================================================== +;; NO USER SERVICABLE PARTS BELOW THIS LINE +;; ====================================================================== + +(defconst icalendar-weekdayabbrev-table + '(("mon\\(day\\)?" . "MO") + ("tue\\(sday\\)?" . "TU") + ("wed\\(nesday\\)?" . "WE") + ("thu\\(rsday\\)?" . "TH") + ("fri\\(day\\)?" . "FR") + ("sat\\(urday\\)?" . "SA") + ("sun\\(day\\)?" . "SU")) + "Translation table for weekdays.") + +(defconst icalendar-monthnumber-table + '(("^jan\\(uar\\)?y?$" . 1) + ("^feb\\(ruar\\)?y?$" . 2) + ("^mar\\(ch\\)?\\|märz?$" . 3) + ("^apr\\(il\\)?$" . 4) + ("^ma[iy]$" . 5) + ("^jun[ie]?$" . 6) + ("^jul[iy]?$" . 7) + ("^aug\\(ust\\)?$" . 8) + ("^sep\\(tember\\)?$" . 9) + ("^o[ck]t\\(ober\\)?$" . 10) + ("^nov\\(ember\\)?$" . 11) + ("^de[cz]\\(ember\\)?$" . 12)) + "Regular expressions for month names. +Currently this matches only German and English.") + +(defvar icalendar-debug nil ".") + +;; ====================================================================== +;; all the other libs we need +;; ====================================================================== +(require 'calendar) +(require 'appt) + +;; ====================================================================== +;; Core functionality +;; Functions for parsing icalendars, importing and so on +;; ====================================================================== + +(defun icalendar-get-unfolded-buffer (folded-ical-buffer) + "Return a new buffer containing the unfolded contents of a buffer. +Folding is the iCalendar way of wrapping long lines. In the +created buffer all occurrences of CR LF BLANK are replaced by the +empty string. Argument FOLDED-ICAL-BUFFER is the unfolded input +buffer." + (let ((unfolded-buffer (get-buffer-create " *icalendar-work*"))) + (save-current-buffer + (set-buffer unfolded-buffer) + (erase-buffer) + (insert-buffer folded-ical-buffer) + (while (re-search-forward "\r?\n[ \t]" nil t) + (replace-match "" nil nil)) + ) + unfolded-buffer)) + +;; Replace regexp RE with RP in string ST and return the new string. +;; This is here for compatibility with XEmacs. +(defsubst icalendar-rris (re rp st) + ;; XEmacs: + (if (fboundp 'replace-in-string) + (save-match-data ;; apparently XEmacs needs save-match-data + (replace-in-string st re rp)) + ;; Emacs: + (replace-regexp-in-string re rp st))) + +(defun icalendar-read-element (invalue inparams) + "Recursively read the next iCalendar element in the current buffer. +INVALUE gives the current iCalendar element we are reading. +INPARAMS gives the current parameters..... +This function calls itself recursively for each nested calendar element +it finds" + (let (element children line name params param param-name param-value + value + (continue t)) + (setq children '()) + (while (and continue + (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t)) + (setq name (intern (match-string 1))) + (backward-char 1) + (setq params '()) + (setq line '()) + (while (looking-at ";") + (re-search-forward ";\\([A-Za-z0-9-]+\\)=" nil nil) + (setq param-name (intern (match-string 1))) + (re-search-forward "\\(\\([^;,:\"]+\\)\\|\"\\([^\"]+\\)\"\\)[;:]" + nil t) + (backward-char 1) + (setq param-value (or (match-string 2) (match-string 3))) + (setq param (list param-name param-value)) + (while (looking-at ",") + (re-search-forward "\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\)" + nil t) + (if (match-string 2) + (setq param-value (match-string 2)) + (setq param-value (match-string 3))) + (setq param (append param param-value))) + (setq params (append params param))) + (unless (looking-at ":") + (error "Oops")) + (forward-char 1) + (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t) + (setq value (icalendar-rris "\r?\n[ \t]" "" (match-string 0))) + (setq line (list name params value)) + (cond ((eq name 'BEGIN) + (setq children + (append children + (list (icalendar-read-element (intern value) + params))))) + ((eq name 'END) + (setq continue nil)) + (t + (setq element (append element (list line)))))) + (if invalue + (list invalue inparams element children) + children))) + +;; ====================================================================== +;; helper functions for examining events +;; ====================================================================== + +(defsubst icalendar-get-all-event-properties (event) + "Return the list of properties in this EVENT." + (car (cddr event))) + +(defun icalendar-get-event-property (event prop) + "For the given EVENT return the value of the property PROP." + (catch 'found + (let ((props (car (cddr event))) pp) + (while props + (setq pp (car props)) + (if (eq (car pp) prop) + (throw 'found (car (cddr pp)))) + (setq props (cdr props)))) + nil)) + +(defun icalendar-set-event-property (event prop new-value) + "For the given EVENT set the property PROP to the value NEW-VALUE." + (catch 'found + (let ((props (car (cddr event))) pp) + (while props + (setq pp (car props)) + (when (eq (car pp) prop) + (setcdr (cdr pp) new-value) + (throw 'found (car (cddr pp)))) + (setq props (cdr props))) + (setq props (car (cddr event))) + (setcar (cddr event) + (append props (list (list prop nil new-value))))))) + +(defun icalendar-get-children (node name) + "Return all children of the given NODE which have a name NAME. +For instance the VCALENDAR node can have VEVENT children as well as VTODO +children." + (let ((result nil) + (children (cadr (cddr node)))) + (when (eq (car node) name) + (setq result node)) + ;;(message "%s" node) + (when children + (let ((subresult + (delq nil + (mapcar (lambda (n) + (icalendar-get-children n name)) + children)))) + (if subresult + (if result + (setq result (append result subresult)) + (setq result subresult))))) + result)) + +; private +(defun icalendar-all-events (icalendar) + "Return the list of all existing events in the given ICALENDAR." + (interactive "") + (icalendar-get-children (car icalendar) 'VEVENT)) + +(defun icalendar-split-value (value-string) + "Splits VALUE-STRING at ';='." + (let ((result '()) + param-name param-value) + (when value-string + (save-current-buffer + (set-buffer (get-buffer-create " *ical-temp*")) + (set-buffer-modified-p nil) + (erase-buffer) + (insert value-string) + (goto-char (point-min)) + (while + (re-search-forward + "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?" + nil t) + (setq param-name (intern (match-string 1))) + (setq param-value (match-string 2)) + (setq result + (append result (list (list param-name param-value))))))) + result)) + +(defun icalendar-decode-isodatetime (isodatetimestring) + "Return ISODATETIMESTRING in format like `decode-time'. +Converts from ISO-8601 to Emacs representation. If ISODATETIMESTRING +specifies UTC time (trailing letter Z) the decoded time is given in +the local time zone! FIXME: TZID-attributes are ignored....! FIXME: +multiple comma-separated values should be allowed!" + (icalendar-dmsg isodatetimestring) + (if isodatetimestring + ;; day/month/year must be present + (let ((year (read (substring isodatetimestring 0 4))) + (month (read (substring isodatetimestring 4 6))) + (day (read (substring isodatetimestring 6 8))) + (hour 0) + (minute 0) + (second 0)) + (when (> (length isodatetimestring) 12) + ;; hour/minute present + (setq hour (read (substring isodatetimestring 9 11))) + (setq minute (read (substring isodatetimestring 11 13)))) + (when (> (length isodatetimestring) 14) + ;; seconds present + (setq second (read (substring isodatetimestring 13 15)))) + (when (and (> (length isodatetimestring) 15) + ;; UTC specifier present + (char-equal ?Z (aref isodatetimestring 15))) + ;; if not UTC add current-time-zone offset + (setq second (+ (car (current-time-zone)) second))) + ;; create the decoded date-time + ;; FIXME!?! + (condition-case nil + (decode-time (encode-time second minute hour day month year)) + (error + (message "Cannot decode \"%s\"" isodatetimestring) + ;; hope for the best... + (list second minute hour day month year 0 nil 0)))) + ;; isodatetimestring == nil + nil)) + +(defun icalendar-decode-isoduration (isodurationstring) + "Return ISODURATIONSTRING in format like `decode-time'. +Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING +specifies UTC time (trailing letter Z) the decoded time is given in +the local time zone! FIXME: TZID-attributes are ignored....! FIXME: +multiple comma-separated values should be allowed!" + (if isodurationstring + (save-match-data + (string-match + (concat + "^P[+-]?\\(" + "\\(\\([0-9]+\\)D\\)" ; days only + "\\|" + "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days + "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time + "\\|" + "\\(\\([0-9]+\\)W\\)" ; weeks only + "\\)$") isodurationstring) + (let ((seconds 0) + (minutes 0) + (hours 0) + (days 0) + (months 0) + (years 0)) + (cond + ((match-beginning 2) ;days only + (setq days (read (substring isodurationstring + (match-beginning 3) + (match-end 3)))) + (when icalendar-duration-correction + (setq days (1- days)))) + ((match-beginning 4) ;days and time + (if (match-beginning 5) + (setq days (* 7 (read (substring isodurationstring + (match-beginning 6) + (match-end 6)))))) + (if (match-beginning 7) + (setq hours (read (substring isodurationstring + (match-beginning 8) + (match-end 8))))) + (if (match-beginning 9) + (setq minutes (read (substring isodurationstring + (match-beginning 10) + (match-end 10))))) + (if (match-beginning 11) + (setq seconds (read (substring isodurationstring + (match-beginning 12) + (match-end 12))))) + ) + ((match-beginning 13) ;weeks only + (setq days (* 7 (read (substring isodurationstring + (match-beginning 14) + (match-end 14)))))) + ) + (list seconds minutes hours days months years))) + ;; isodatetimestring == nil + nil)) + +(defun icalendar-add-decoded-times (time1 time2) + "Add TIME1 to TIME2. +Both times must be given in decoded form. One of these times must be +valid (year > 1900 or something)." + ;; FIXME: does this function exist already? + (decode-time (encode-time + (+ (nth 0 time1) (nth 0 time2)) + (+ (nth 1 time1) (nth 1 time2)) + (+ (nth 2 time1) (nth 2 time2)) + (+ (nth 3 time1) (nth 3 time2)) + (+ (nth 4 time1) (nth 4 time2)) + (+ (nth 5 time1) (nth 5 time2)) + nil + nil + ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME? + ))) + +(defun icalendar-datetime-to-noneuropean-date (datetime) + "Convert the decoded DATETIME to non-european-style format. +Non-European format: (month day year)." + (if datetime + (list (nth 4 datetime) ;month + (nth 3 datetime) ;day + (nth 5 datetime));year + ;; datetime == nil + nil)) + +(defun icalendar-datetime-to-european-date (datetime) + "Convert the decoded DATETIME to European format. +European format: (day month year). +FIXME" + (if datetime + (format "%d %d %d" (nth 3 datetime); day + (nth 4 datetime) ;month + (nth 5 datetime));year + ;; datetime == nil + nil)) + +(defun icalendar-datetime-to-colontime (datetime) + "Extract the time part of a decoded DATETIME into 24-hour format. +Note that this silently ignores seconds." + (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime))) + +(defun icalendar-get-month-number (monthname) + "Return the month number for the given MONTHNAME." + (save-match-data + (let ((case-fold-search t)) + (assoc-default monthname icalendar-monthnumber-table + 'string-match)))) + +(defun icalendar-get-weekday-abbrev (weekday) + "Return the abbreviated WEEKDAY." + ;;FIXME: ISO-like(?). + (save-match-data + (let ((case-fold-search t)) + (assoc-default weekday icalendar-weekdayabbrev-table + 'string-match)))) + +(defun icalendar-datestring-to-isodate (datestring &optional day-shift) + "Convert diary-style DATESTRING to iso-style date. +If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days +-- DAY-SHIFT must be either nil or an integer. This function +takes care of european-style." + (let ((day -1) month year) + (save-match-data + (cond (;; numeric date + (string-match (concat "\\s-*" + "0?\\([1-9][0-9]?\\)[ \t/]\\s-*" + "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring) + (setq day (read (substring datestring (match-beginning 1) + (match-end 1)))) + (setq month (read (substring datestring (match-beginning 2) + (match-end 2)))) + (setq year (read (substring datestring (match-beginning 3) + (match-end 3)))) + (unless european-calendar-style + (let ((x month)) + (setq month day) + (setq day x)))) + (;; date contains month names -- european-style + (and european-calendar-style + (string-match (concat "\\s-*" + "0?\\([123]?[0-9]\\)[ \t/]\\s-*" + "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring)) + (setq day (read (substring datestring (match-beginning 1) + (match-end 1)))) + (setq month (icalendar-get-month-number + (substring datestring (match-beginning 2) + (match-end 2)))) + (setq year (read (substring datestring (match-beginning 3) + (match-end 3))))) + (;; date contains month names -- non-european-style + (and (not european-calendar-style) + (string-match (concat "\\s-*" + "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" + "0?\\([123]?[0-9]\\),?[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring)) + (setq day (read (substring datestring (match-beginning 2) + (match-end 2)))) + (setq month (icalendar-get-month-number + (substring datestring (match-beginning 1) + (match-end 1)))) + (setq year (read (substring datestring (match-beginning 3) + (match-end 3))))) + (t + nil))) + (if (> day 0) + (let ((mdy (calendar-gregorian-from-absolute + (+ (calendar-absolute-from-gregorian (list month day year)) + (or day-shift 0))))) + (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) + nil))) + +(defun icalendar-dmsg (&rest args) + "Print message ARGS if `icalendar-debug' is non-nil." + (if icalendar-debug + (apply 'message args))) + +(defun icalendar-diarytime-to-isotime (timestring ampmstring) + "Convert a a time like 9:30pm to an iso-conform string like T213000. +In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING +would be \"pm\"." + (if timestring + (let ((starttimenum (read (icalendar-rris ":" "" timestring)))) + ;; take care of am/pm style + (if (and ampmstring (string= "pm" ampmstring)) + (setq starttimenum (+ starttimenum 1200))) + (format "T%04d00" starttimenum)) + nil)) + +(defun icalendar-convert-string-for-export (s) + "Escape comma and other critical characters in string S." + (icalendar-rris "," "\\\\," s)) + +(defun icalendar-convert-for-import (string) + "Remove escape chars for comma, semicolon etc. from STRING." + (icalendar-rris + "\\\\n" "\n " (icalendar-rris + "\\\\\"" "\"" (icalendar-rris + "\\\\;" ";" (icalendar-rris + "\\\\," "," string))))) + +;; ====================================================================== +;; export -- convert emacs-diary to icalendar +;; ====================================================================== + +(defun icalendar-convert-diary-to-ical (diary-filename ical-filename + &optional do-not-clear-diary-file) + "Export diary file to iCalendar format -- erases ical-filename!!!. +Argument DIARY-FILENAME is the input `diary-file'. +Argument ICAL-FILENAME is the output iCalendar file. +If DO-NOT-CLEAR-DIARY-FILE is not nil the target iCalendar file +is not erased." + (interactive "FExport diary data from file: +Finto iCalendar file: ") + (let ((result "") + (start 0) + (entry-main "") + (entry-rest "") + (header "") + (contents) + (oops nil) + (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) + "?"))) + (save-current-buffer + (set-buffer (find-file diary-filename)) + (goto-char (point-min)) + (while (re-search-forward + "^\\([^ \t\n].*\\)\\(\n[ \t].*\\)*" nil t) + (setq entry-main (match-string 1)) + (if (match-beginning 2) + (setq entry-rest (match-string 2)) + (setq entry-rest "")) + (setq header (format "\nBEGIN:VEVENT\nUID:emacs%d%d%d" + (car (current-time)) + (cadr (current-time)) + (car (cddr (current-time))))) + (setq oops nil) + (cond + ;; anniversaries + ((string-match + (concat nonmarker + "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar-dmsg "diary-anniversary %s" entry-main) + (let* ((datetime (substring entry-main (match-beginning 1) + (match-end 1))) + (summary (icalendar-convert-string-for-export + (substring entry-main (match-beginning 2) + (match-end 2)))) + (startisostring (icalendar-datestring-to-isodate + datetime)) + (endisostring (icalendar-datestring-to-isodate + datetime 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + "\nRRULE:FREQ=YEARLY;INTERVAL=1" + ;; the following is redundant, + ;; but korganizer seems to expect this... ;( + ;; and evolution doesn't understand it... :( + ;; so... who is wrong?! + ";BYMONTH=" (substring startisostring 4 6) + ";BYMONTHDAY=" (substring startisostring 6 8) + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar-convert-string-for-export + entry-rest))))) + ;; cyclic events + ;; %%(diary-cyclic ) + ((string-match + (concat nonmarker + "%%(diary-cyclic \\([^ ]+\\) +" + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar-dmsg "diary-cyclic %s" entry-main) + (let* ((frequency (substring entry-main (match-beginning 1) + (match-end 1))) + (datetime (substring entry-main (match-beginning 2) + (match-end 2))) + (summary (icalendar-convert-string-for-export + (substring entry-main (match-beginning 3) + (match-end 3)))) + (startisostring (icalendar-datestring-to-isodate + datetime)) + (endisostring (icalendar-datestring-to-isodate + datetime 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + "\nRRULE:FREQ=DAILY;INTERVAL=" frequency + ;; strange: korganizer does not expect + ;; BYSOMETHING here... + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar-convert-string-for-export + entry-rest))))) + ;; diary-date -- FIXME + ((string-match + (concat nonmarker + "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar-dmsg "diary-date %s" entry-main) + (setq oops t)) + ;; float events -- FIXME + ((string-match + (concat nonmarker + "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar-dmsg "diary-float %s" entry-main) + (setq oops t)) + ;; block events + ((string-match + (concat nonmarker + "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar-dmsg "diary-block %s" entry-main) + (let* ((startstring (substring entry-main (match-beginning 1) + (match-end 1))) + (endstring (substring entry-main (match-beginning 2) + (match-end 2))) + (summary (icalendar-convert-string-for-export + (substring entry-main (match-beginning 3) + (match-end 3)))) + (startisostring (icalendar-datestring-to-isodate + startstring)) + (endisostring (icalendar-datestring-to-isodate + endstring 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + )) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar-convert-string-for-export + entry-rest)))))) + ;; other sexp diary entries -- FIXME + ((string-match + (concat nonmarker + "%%(\\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar-dmsg "diary-sexp %s" entry-main) + (setq oops t)) + ;; weekly by day + ;; Monday 8:30 Team meeting + ((and (string-match + (concat nonmarker + "\\([a-z]+\\)\\s-+" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(-0?" + "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*\\)$") + entry-main) + (icalendar-get-weekday-abbrev + (substring entry-main (match-beginning 1) (match-end 1)))) + (icalendar-dmsg "weekly %s" entry-main) + (let* ((day (icalendar-get-weekday-abbrev + (substring entry-main (match-beginning 1) + (match-end 1)))) + (starttimestring (icalendar-diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar-diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar-convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar-rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents + (concat "\nDTSTART" + (if starttimestring "" ";VALUE=DATE") + ":19000101" ;; FIXME? Probability that this + ;; is the right day is 1/7 + (or starttimestring "") + "\nDTEND" + (if endtimestring "" ";VALUE=DATE") + ":19000101" ;; FIXME? + (or endtimestring "") + "\nSUMMARY:" summary + "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar-convert-string-for-export + entry-rest))))) + ;; yearly by day + ;; 1 May Tag der Arbeit + ((string-match + (concat nonmarker + (if european-calendar-style + "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" + "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") + "\\*?\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\([^0-9]+.*\\)$"; must not match years + ) + entry-main) + (icalendar-dmsg "yearly %s" entry-main) + (let* ((daypos (if european-calendar-style 1 2)) + (monpos (if european-calendar-style 2 1)) + (day (read (substring entry-main (match-beginning daypos) + (match-end daypos)))) + (month (icalendar-get-month-number + (substring entry-main (match-beginning monpos) + (match-end monpos)))) + (starttimestring (icalendar-diarytime-to-isotime + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil) + (if (match-beginning 5) + (substring entry-main + (match-beginning 5) + (match-end 5)) + nil))) + (endtimestring (icalendar-diarytime-to-isotime + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil) + (if (match-beginning 8) + (substring entry-main + (match-beginning 8) + (match-end 8)) + nil))) + (summary (icalendar-convert-string-for-export + (substring entry-main (match-beginning 9) + (match-end 9))))) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar-rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents + (concat "\nDTSTART" + (if starttimestring "" ";VALUE=DATE") + (format ":1900%02d%02d" month day) + (or starttimestring "") + "\nDTEND" + (if endtimestring "" ";VALUE=DATE") + (format ":1900%02d%02d" month day) + (or endtimestring "") + "\nSUMMARY:" summary + "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" + (format "%2d" month) + ";BYMONTHDAY=" + (format "%2d" day) + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar-convert-string-for-export + entry-rest))))) + ;; "ordinary" events, start and end time given + ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich + ((string-match + (concat nonmarker + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*\\)") + entry-main) + (icalendar-dmsg "ordinary %s" entry-main) + (let* ((datestring (icalendar-datestring-to-isodate + (substring entry-main (match-beginning 1) + (match-end 1)))) + (starttimestring (icalendar-diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar-diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar-convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar-rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents (format + "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" + (if starttimestring "" ";VALUE=DATE") + datestring + (or starttimestring "") + (if endtimestring "" + ";VALUE=DATE") + datestring + (or endtimestring "") + summary)) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar-convert-string-for-export + entry-rest)))))) + ;; everything else + (t + ;; Oops! what's that? + (setq oops t))) + (if oops + (message "Cannot export entry on line %d" + (count-lines (point-min) (point))) + (setq result (concat result header contents "\nEND:VEVENT")))) + ;; we're done, insert everything into the file + (let ((coding-system-for-write 'utf8)) + (set-buffer (find-file ical-filename)) + (unless do-not-clear-diary-file + (erase-buffer)) + (insert + "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN") + (insert "\nVERSION:2.0") + (insert result) + (insert "\nEND:VCALENDAR\n"))))) + + +;; ====================================================================== +;; import -- convert icalendar to emacs-diary +;; ====================================================================== + +;; user function +(defun icalendar-import-file (ical-filename diary-filename + &optional non-marking + do-not-clear-diary-file) + "Import a iCalendar file and save to a diary file -- erases diary-file! +Argument ICAL-FILENAME output iCalendar file. +Argument DIARY-FILENAME input `diary-file'. +Optional argument NON-MARKING determines whether events are created as +non-marking or not. +If DO-NOT-CLEAR-DIARY-FILE is not nil the target diary file is +not erased." + (interactive "fImport iCalendar data from file: +Finto diary file (will be erased!): +p") + ;; clean up the diary file + (save-current-buffer + (unless do-not-clear-diary-file + ;; clear the target diary file + (set-buffer (find-file diary-filename)) + (erase-buffer)) + ;; now load and convert from the ical file + (set-buffer (find-file ical-filename)) + (icalendar-extract-ical-from-buffer diary-filename t non-marking))) + +; user function +(defun icalendar-extract-ical-from-buffer (&optional + diary-file do-not-ask + non-marking) + "Extract iCalendar events from current buffer. + +This function searches the current buffer for the first iCalendar +object, reads it and adds all VEVENT elements to the diary +DIARY-FILE. + +It will ask for each appointment whether to add it to the diary +when DO-NOT-ASK is non-nil. When called interactively, +DO-NOT-ASK is set to t, so that you are asked fore each event. + +NON-MARKING determines whether diary events are created as +non-marking. + +This function attempts to notify about problems that occur when +reading, parsing, or converting iCalendar data!" + (interactive) + (save-current-buffer + ;; prepare ical + (message "Preparing icalendar...") + (set-buffer (icalendar-get-unfolded-buffer (current-buffer))) + (goto-char (point-min)) + (message "Preparing icalendar...done") + (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t) + (let (ical-contents ical-errors) + ;; read ical + (message "Reading icalendar...") + (beginning-of-line) + (setq ical-contents (icalendar-read-element nil nil)) + (message "Reading icalendar...done") + ;; convert ical + (message "Converting icalendar...") + (setq ical-errors (icalendar-convert-ical-to-diary + ical-contents + diary-file do-not-ask non-marking)) + (when diary-file + ;; save the diary file + (save-current-buffer + (set-buffer (find-buffer-visiting diary-file)) + (save-buffer))) + (message "Converting icalendar...done") + (if (and ical-errors (y-or-n-p + (concat "Something went wrong -- " + "do you want to see the " + "error log? "))) + (switch-to-buffer " *icalendar-errors*"))) + (message + "Current buffer does not contain icalendar contents!")))) + +;; ---------------------------------------------------------------------- +;; private area +;; ---------------------------------------------------------------------- +(defun icalendar-format-ical-event (event) + "Create a string representation of an iCalendar EVENT." + (let ((string icalendar-import-format) + (conversion-list + '(("%d" DESCRIPTION icalendar-import-format-description) + ("%s" SUMMARY icalendar-import-format-subject) + ("%l" LOCATION icalendar-import-format-location) + ("%o" ORGANIZER icalendar-import-format-organizer)))) + ;; convert the specifiers in the format string + (mapcar (lambda (i) + (let* ((spec (car i)) + (prop (cadr i)) + (format (car (cddr i))) + (contents (icalendar-get-event-property event prop)) + (formatted-contents "")) + ;;(message "%s" event) + ;;(message "contents%s = %s" prop contents) + (when (and contents (> (length contents) 0)) + (setq formatted-contents + (icalendar-rris "%s" + (icalendar-convert-for-import + contents) + (symbol-value format)))) + (setq string (icalendar-rris spec + formatted-contents + string)))) + conversion-list) + string)) + +(defun icalendar-convert-ical-to-diary (ical-list diary-file + &optional do-not-ask + non-marking) + "Convert an iCalendar file to an Emacs diary file. +Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a +DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event +whether to actually import it. NON-MARKING determines whether diary +events are created as non-marking. +This function attempts to return t if something goes wrong. In this +case an error string which describes all the errors and problems is +written into the buffer ` *icalendar-errors*'." + (let* ((ev (icalendar-all-events ical-list)) + (error-string "") + (event-ok t) + (found-error nil) + e diary-string) + ;; step through all events/appointments + (while ev + (setq e (car ev)) + (setq ev (cdr ev)) + (setq event-ok nil) + (condition-case error-val + (let* ((dtstart (icalendar-decode-isodatetime + (icalendar-get-event-property e 'DTSTART))) + (start-d (calendar-date-string + (icalendar-datetime-to-noneuropean-date + dtstart) + t t)) + (start-t (icalendar-datetime-to-colontime dtstart)) + (dtend (icalendar-decode-isodatetime + (icalendar-get-event-property e 'DTEND))) + end-d + end-t + (subject (icalendar-convert-for-import + (or (icalendar-get-event-property e 'SUMMARY) + "No Subject"))) + (rrule (icalendar-get-event-property e 'RRULE)) + (rdate (icalendar-get-event-property e 'RDATE)) + (duration (icalendar-get-event-property e 'DURATION))) + (icalendar-dmsg "%s: %s" start-d subject) + (when duration + (let ((dtend2 (icalendar-add-decoded-times + dtstart + (icalendar-decode-isoduration duration)))) + (if (and dtend (not (eq dtend dtend2))) + (message "Inconsistent endtime and duration for %s" + subject)) + (setq dtend dtend2))) + (setq end-d (if dtend + (calendar-date-string + (icalendar-datetime-to-noneuropean-date + dtend) + t t) + start-d)) + (setq end-t (if dtend + (icalendar-datetime-to-colontime dtend) + start-t)) + (icalendar-dmsg "start-d: %s, end-d: %s" start-d end-d) + (cond + ;; recurring event + (rrule + (icalendar-dmsg "recurring event") + (let* ((rrule-props (icalendar-split-value rrule)) + (frequency (car (cdr (assoc 'FREQ rrule-props)))) + (until (car (cdr (assoc 'UNTIL rrule-props)))) + (interval (read (car (cdr (assoc 'INTERVAL + rrule-props)))))) + (cond ((string-equal frequency "WEEKLY") + (if (not start-t) + (progn + ;; weekly and all-day + (icalendar-dmsg "weekly all-day") + (setq diary-string + (format + "%%%%(diary-cyclic %d %s)" + (* interval 7) + (icalendar-datetime-to-european-date + dtstart)))) + ;; weekly and not all-day + (let* ((byday (cadr (assoc 'BYDAY rrule-props))) + (weekday + (cdr (rassoc + byday + icalendar-weekdayabbrev-table)))) + (icalendar-dmsg "weekly not-all-day") + (if weekday + (setq diary-string + (format "%s %s%s%s" weekday + start-t (if end-t "-" "") + (or end-t ""))) + ;; FIXME!!!! + ;; DTSTART;VALUE=DATE-TIME:20030919T090000 + ;; DTEND;VALUE=DATE-TIME:20030919T113000 + (setq diary-string + (format + "%%%%(diary-cyclic %s %s) %s%s%s" + (* interval 7) + (icalendar-datetime-to-european-date + dtstart) + start-t (if end-t "-" "") (or end-t "")))) + (setq event-ok t)))) + ;; yearly + ((string-equal frequency "YEARLY") + (icalendar-dmsg "yearly") + (setq diary-string + (format + "%%%%(diary-anniversary %s)" + (icalendar-datetime-to-european-date dtstart))) + (setq event-ok t)) + ;; FIXME: war auskommentiert: + ((and (string-equal frequency "DAILY") + ;;(not (string= start-d end-d)) + ;;(not start-t) + ;;(not end-t) + ) + (let ((ds (icalendar-datetime-to-noneuropean-date + (icalendar-decode-isodatetime + (icalendar-get-event-property e + 'DTSTART)))) + (de (icalendar-datetime-to-noneuropean-date + (icalendar-decode-isodatetime + until)))) + (setq diary-string + (format + "%%%%(diary-block %d %d %d %d %d %d)" + (nth 1 ds) (nth 0 ds) (nth 2 ds) + (nth 1 de) (nth 0 de) (nth 2 de)))) + (setq event-ok t))) + )) + (rdate + (icalendar-dmsg "rdate event") + (setq diary-string "") + (mapcar (lambda (datestring) + (setq diary-string + (concat diary-string + (format "......")))) + (icalendar-split-value rdate))) + ;; non-recurring event + ;; long event + ((not (string= start-d end-d)) + (icalendar-dmsg "non-recurring event") + (let ((ds (icalendar-datetime-to-noneuropean-date dtstart)) + (de (icalendar-datetime-to-noneuropean-date dtend))) + (setq diary-string + (format "%%%%(diary-block %d %d %d %d %d %d)" + (nth 1 ds) (nth 0 ds) (nth 2 ds) + (nth 1 de) (nth 0 de) (nth 2 de)))) + (setq event-ok t)) + ;; not all-day + ((and start-t (or (not end-t) + (not (string= start-t end-t)))) + (icalendar-dmsg "not all day event") + (cond (end-t + (setq diary-string (format "%s %s-%s" start-d + start-t end-t))) + (t + (setq diary-string (format "%s %s" start-d + start-t)))) + (setq event-ok t)) + ;; all-day event + (t + (icalendar-dmsg "all day event") + (setq diary-string start-d) + (setq event-ok t))) + ;; add all other elements unless the user doesn't want to have + ;; them + (if event-ok + (progn + (setq diary-string + (concat diary-string " " + (icalendar-format-ical-event e))) + (if do-not-ask (setq subject nil)) + (icalendar-add-diary-entry diary-string diary-file + non-marking subject)) + ;; event was not ok + (setq found-error t) + (setq error-string + (format "%s\nCannot handle this event:%s" + error-string e)))) + ;; handle errors + (error + (message "Ignoring event \"%s\"" e) + (setq found-error t) + (setq error-string (format "%s\nCannot handle this event: %s" + error-string e))))) + (if found-error + (save-current-buffer + (set-buffer (get-buffer-create " *icalendar-errors*")) + (erase-buffer) + (insert error-string))) + (message "Converting icalendar...done") + found-error)) + +(defun icalendar-add-diary-entry (string diary-file non-marking + &optional subject) + "Add STRING to the diary file DIARY-FILE. +STRING must be a properly formatted valid diary entry. NON-MARKING +determines whether diary events are created as non-marking. If +SUBJECT is not nil it must be a string that gives the subject of the +entry. In this case the user will be asked whether he wants to insert +the entry." + (when (or (not subject) ; + (y-or-n-p (format "Add appointment for `%s' to diary? " + subject))) + (when subject + (setq non-marking + (y-or-n-p (format "Make appointment non-marking? ")))) + (save-window-excursion + (unless diary-file + (setq diary-file + (read-file-name "Add appointment to this diary file: "))) + (make-diary-entry string non-marking diary-file)))) + +;; ====================================================================== +;; (add-hook 'list-diary-entries-hook 'include-icalendar-files) +;; ====================================================================== +(defun include-icalendar-files () + "Not yet implemented.") + +(provide 'icalendar) + +;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc +;;; icalendar.el ends here
--- a/lisp/comint.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/comint.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,7 +1,7 @@ ;;; comint.el --- general command interpreter in a window stuff -;; Copyright (C) 1988,90,92,93,94,95,96,97,98,99,2000,01,02,03,2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1988, 1990, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Olin Shivers <shivers@cs.cmu.edu> ;; Simon Marshall <simon@gnu.org> @@ -185,10 +185,10 @@ wish to put something like the following in your `.emacs' file: \(add-hook 'comint-mode-hook - '(lambda () - (define-key comint-mode-map \"\C-w\" 'comint-kill-region) - (define-key comint-mode-map [C-S-backspace] - 'comint-kill-whole-line))) + (lambda () + (define-key comint-mode-map \"\C-w\" 'comint-kill-region) + (define-key comint-mode-map [C-S-backspace] + 'comint-kill-whole-line))) If you sometimes use comint-mode on text-only terminals or with `emacs-nw', you might wish to use another binding for `comint-kill-whole-line'." @@ -369,11 +369,8 @@ history list. Default is to save anything that isn't all whitespace.") (defvar comint-input-filter-functions '() - "Functions to call before input is sent to the process. -These functions get one argument, a string containing the text to send. - -You can use `add-hook' to add functions to this list -either globally or locally.") + "Special hook run before input is sent to the process. +These functions get one argument, a string containing the text to send.") (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom) "Functions to call after output is inserted into the buffer. @@ -411,7 +408,7 @@ (defcustom comint-use-prompt-regexp-instead-of-fields nil "*If non-nil, use `comint-prompt-regexp' to distinguish prompts from user-input. If nil, then program output and user-input are given different `field' -properties, which emacs commands can use to distinguish them (in +properties, which Emacs commands can use to distinguish them (in particular, common movement commands such as begining-of-line respect field boundaries in a natural way)." :type 'boolean @@ -432,7 +429,106 @@ :type 'hook :group 'comint) -(defvar comint-mode-map nil) +(defvar comint-mode-map + (let ((map (make-sparse-keymap))) + ;; Keys: + (define-key map "\ep" 'comint-previous-input) + (define-key map "\en" 'comint-next-input) + (define-key map [C-up] 'comint-previous-input) + (define-key map [C-down] 'comint-next-input) + (define-key map "\er" 'comint-previous-matching-input) + (define-key map "\es" 'comint-next-matching-input) + (define-key map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input) + (define-key map [?\C-c ?\M-s] 'comint-next-matching-input-from-input) + (define-key map "\e\C-l" 'comint-show-output) + (define-key map "\C-m" 'comint-send-input) + (define-key map "\C-d" 'comint-delchar-or-maybe-eof) + (define-key map "\C-c " 'comint-accumulate) + (define-key map "\C-c\C-x" 'comint-get-next-from-history) + (define-key map "\C-c\C-a" 'comint-bol-or-process-mark) + (define-key map "\C-c\C-u" 'comint-kill-input) + (define-key map "\C-c\C-w" 'backward-kill-word) + (define-key map "\C-c\C-c" 'comint-interrupt-subjob) + (define-key map "\C-c\C-z" 'comint-stop-subjob) + (define-key map "\C-c\C-\\" 'comint-quit-subjob) + (define-key map "\C-c\C-m" 'comint-insert-input) + (define-key map "\C-c\C-o" 'comint-delete-output) + (define-key map "\C-c\C-r" 'comint-show-output) + (define-key map "\C-c\C-e" 'comint-show-maximum-output) + (define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring) + (define-key map "\C-c\C-n" 'comint-next-prompt) + (define-key map "\C-c\C-p" 'comint-previous-prompt) + (define-key map "\C-c\C-d" 'comint-send-eof) + (define-key map "\C-c\C-s" 'comint-write-output) + (define-key map "\C-c." 'comint-insert-previous-argument) + ;; Mouse Buttons: + (define-key map [mouse-2] 'comint-insert-input) + ;; Menu bars: + ;; completion: + (define-key map [menu-bar completion] + (cons "Complete" (make-sparse-keymap "Complete"))) + (define-key map [menu-bar completion complete-expand] + '("Expand File Name" . comint-replace-by-expanded-filename)) + (define-key map [menu-bar completion complete-listing] + '("File Completion Listing" . comint-dynamic-list-filename-completions)) + (define-key map [menu-bar completion complete-file] + '("Complete File Name" . comint-dynamic-complete-filename)) + (define-key map [menu-bar completion complete] + '("Complete Before Point" . comint-dynamic-complete)) + ;; Input history: + (define-key map [menu-bar inout] + (cons "In/Out" (make-sparse-keymap "In/Out"))) + (define-key map [menu-bar inout delete-output] + '("Delete Current Output Group" . comint-delete-output)) + (define-key map [menu-bar inout append-output-to-file] + '("Append Current Output Group to File" . comint-append-output-to-file)) + (define-key map [menu-bar inout write-output] + '("Write Current Output Group to File" . comint-write-output)) + (define-key map [menu-bar inout next-prompt] + '("Forward Output Group" . comint-next-prompt)) + (define-key map [menu-bar inout previous-prompt] + '("Backward Output Group" . comint-previous-prompt)) + (define-key map [menu-bar inout show-maximum-output] + '("Show Maximum Output" . comint-show-maximum-output)) + (define-key map [menu-bar inout show-output] + '("Show Current Output Group" . comint-show-output)) + (define-key map [menu-bar inout kill-input] + '("Kill Current Input" . comint-kill-input)) + (define-key map [menu-bar inout copy-input] + '("Copy Old Input" . comint-insert-input)) + (define-key map [menu-bar inout forward-matching-history] + '("Forward Matching Input..." . comint-forward-matching-input)) + (define-key map [menu-bar inout backward-matching-history] + '("Backward Matching Input..." . comint-backward-matching-input)) + (define-key map [menu-bar inout next-matching-history] + '("Next Matching Input..." . comint-next-matching-input)) + (define-key map [menu-bar inout previous-matching-history] + '("Previous Matching Input..." . comint-previous-matching-input)) + (define-key map [menu-bar inout next-matching-history-from-input] + '("Next Matching Current Input" . comint-next-matching-input-from-input)) + (define-key map [menu-bar inout previous-matching-history-from-input] + '("Previous Matching Current Input" . comint-previous-matching-input-from-input)) + (define-key map [menu-bar inout next-history] + '("Next Input" . comint-next-input)) + (define-key map [menu-bar inout previous-history] + '("Previous Input" . comint-previous-input)) + (define-key map [menu-bar inout list-history] + '("List Input History" . comint-dynamic-list-input-ring)) + (define-key map [menu-bar inout expand-history] + '("Expand History Before Point" . comint-replace-by-expanded-history)) + ;; Signals + (let ((signals-map (make-sparse-keymap "Signals"))) + (define-key map [menu-bar signals] (cons "Signals" signals-map)) + (define-key signals-map [eof] '("EOF" . comint-send-eof)) + (define-key signals-map [kill] '("KILL" . comint-kill-subjob)) + (define-key signals-map [quit] '("QUIT" . comint-quit-subjob)) + (define-key signals-map [cont] '("CONT" . comint-continue-subjob)) + (define-key signals-map [stop] '("STOP" . comint-stop-subjob)) + (define-key signals-map [break] '("BREAK" . comint-interrupt-subjob))) + ;; Put them in the menu bar: + (setq menu-bar-final-items (append '(completion inout signals) + menu-bar-final-items)) + map)) ;; Fixme: Is this still relevant? (defvar comint-ptyp t @@ -548,114 +644,6 @@ ;; This behavior is not useful in comint buffers, and is annoying (set (make-local-variable 'next-line-add-newlines) nil)) -(if comint-mode-map - nil - ;; Keys: - (setq comint-mode-map (make-sparse-keymap)) - (define-key comint-mode-map "\ep" 'comint-previous-input) - (define-key comint-mode-map "\en" 'comint-next-input) - (define-key comint-mode-map [C-up] 'comint-previous-input) - (define-key comint-mode-map [C-down] 'comint-next-input) - (define-key comint-mode-map "\er" 'comint-previous-matching-input) - (define-key comint-mode-map "\es" 'comint-next-matching-input) - (define-key comint-mode-map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input) - (define-key comint-mode-map [?\C-c ?\M-s] 'comint-next-matching-input-from-input) - (define-key comint-mode-map "\e\C-l" 'comint-show-output) - (define-key comint-mode-map "\C-m" 'comint-send-input) - (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof) - (define-key comint-mode-map "\C-c " 'comint-accumulate) - (define-key comint-mode-map "\C-c\C-x" 'comint-get-next-from-history) - (define-key comint-mode-map "\C-c\C-a" 'comint-bol-or-process-mark) - (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input) - (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word) - (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob) - (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob) - (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob) - (define-key comint-mode-map "\C-c\C-m" 'comint-insert-input) - (define-key comint-mode-map "\C-c\C-o" 'comint-delete-output) - (define-key comint-mode-map "\C-c\C-r" 'comint-show-output) - (define-key comint-mode-map "\C-c\C-e" 'comint-show-maximum-output) - (define-key comint-mode-map "\C-c\C-l" 'comint-dynamic-list-input-ring) - (define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt) - (define-key comint-mode-map "\C-c\C-p" 'comint-previous-prompt) - (define-key comint-mode-map "\C-c\C-d" 'comint-send-eof) - (define-key comint-mode-map "\C-c\C-s" 'comint-write-output) - (define-key comint-mode-map "\C-c." 'comint-insert-previous-argument) - ;; Mouse Buttons: - (define-key comint-mode-map [mouse-2] 'comint-mouse-insert-input) - ;; Menu bars: - ;; completion: - (define-key comint-mode-map [menu-bar completion] - (cons "Complete" (make-sparse-keymap "Complete"))) - (define-key comint-mode-map [menu-bar completion complete-expand] - '("Expand File Name" . comint-replace-by-expanded-filename)) - (define-key comint-mode-map [menu-bar completion complete-listing] - '("File Completion Listing" . comint-dynamic-list-filename-completions)) - (define-key comint-mode-map [menu-bar completion complete-file] - '("Complete File Name" . comint-dynamic-complete-filename)) - (define-key comint-mode-map [menu-bar completion complete] - '("Complete Before Point" . comint-dynamic-complete)) - ;; Input history: - (define-key comint-mode-map [menu-bar inout] - (cons "In/Out" (make-sparse-keymap "In/Out"))) - (define-key comint-mode-map [menu-bar inout delete-output] - '("Delete Current Output Group" . comint-delete-output)) - (define-key comint-mode-map [menu-bar inout append-output-to-file] - '("Append Current Output Group to File" . comint-append-output-to-file)) - (define-key comint-mode-map [menu-bar inout write-output] - '("Write Current Output Group to File" . comint-write-output)) - (define-key comint-mode-map [menu-bar inout next-prompt] - '("Forward Output Group" . comint-next-prompt)) - (define-key comint-mode-map [menu-bar inout previous-prompt] - '("Backward Output Group" . comint-previous-prompt)) - (define-key comint-mode-map [menu-bar inout show-maximum-output] - '("Show Maximum Output" . comint-show-maximum-output)) - (define-key comint-mode-map [menu-bar inout show-output] - '("Show Current Output Group" . comint-show-output)) - (define-key comint-mode-map [menu-bar inout kill-input] - '("Kill Current Input" . comint-kill-input)) - (define-key comint-mode-map [menu-bar inout copy-input] - '("Copy Old Input" . comint-insert-input)) - (define-key comint-mode-map [menu-bar inout forward-matching-history] - '("Forward Matching Input..." . comint-forward-matching-input)) - (define-key comint-mode-map [menu-bar inout backward-matching-history] - '("Backward Matching Input..." . comint-backward-matching-input)) - (define-key comint-mode-map [menu-bar inout next-matching-history] - '("Next Matching Input..." . comint-next-matching-input)) - (define-key comint-mode-map [menu-bar inout previous-matching-history] - '("Previous Matching Input..." . comint-previous-matching-input)) - (define-key comint-mode-map [menu-bar inout next-matching-history-from-input] - '("Next Matching Current Input" . comint-next-matching-input-from-input)) - (define-key comint-mode-map [menu-bar inout previous-matching-history-from-input] - '("Previous Matching Current Input" . comint-previous-matching-input-from-input)) - (define-key comint-mode-map [menu-bar inout next-history] - '("Next Input" . comint-next-input)) - (define-key comint-mode-map [menu-bar inout previous-history] - '("Previous Input" . comint-previous-input)) - (define-key comint-mode-map [menu-bar inout list-history] - '("List Input History" . comint-dynamic-list-input-ring)) - (define-key comint-mode-map [menu-bar inout expand-history] - '("Expand History Before Point" . comint-replace-by-expanded-history)) - ;; Signals - (define-key comint-mode-map [menu-bar signals] - (cons "Signals" (make-sparse-keymap "Signals"))) - (define-key comint-mode-map [menu-bar signals eof] - '("EOF" . comint-send-eof)) - (define-key comint-mode-map [menu-bar signals kill] - '("KILL" . comint-kill-subjob)) - (define-key comint-mode-map [menu-bar signals quit] - '("QUIT" . comint-quit-subjob)) - (define-key comint-mode-map [menu-bar signals cont] - '("CONT" . comint-continue-subjob)) - (define-key comint-mode-map [menu-bar signals stop] - '("STOP" . comint-stop-subjob)) - (define-key comint-mode-map [menu-bar signals break] - '("BREAK" . comint-interrupt-subjob)) - ;; Put them in the menu bar: - (setq menu-bar-final-items (append '(completion inout signals) - menu-bar-final-items)) - ) - (defun comint-check-proc (buffer) "Return t if there is a living process associated w/buffer BUFFER. Living means the status is `open', `run', or `stop'. @@ -798,9 +786,10 @@ (set-process-coding-system proc decoding encoding)) proc)) -(defun comint-insert-input () +(defun comint-insert-input (&optional event) "In a Comint buffer, set the current input to the previous input at point." - (interactive) + (interactive (list last-input-event)) + (if event (mouse-set-point event)) (let ((pos (point))) (if (not (eq (get-char-property pos 'field) 'input)) ;; No input at POS, fall back to the global definition. @@ -818,13 +807,7 @@ ;; Insert the input at point (insert (buffer-substring-no-properties (previous-single-char-property-change (1+ pos) 'field) - (next-single-char-property-change pos 'field)))))) - -(defun comint-mouse-insert-input (event) - "In a Comint buffer, set the current input to the previous input you click on." - (interactive "e") - (mouse-set-point event) - (comint-insert-input)) + (next-single-char-property-change pos 'field)))))) ;; Input history processing in a buffer @@ -1734,7 +1717,7 @@ (1- prompt-start) prompt-start 'read-only 'fence)) (add-text-properties prompt-start (point) - '(read-only t rear-non-sticky t front-sticky (read-only)))) + '(read-only t rear-nonsticky t front-sticky (read-only)))) (unless (and (bolp) (null comint-last-prompt-overlay)) ;; Need to create or move the prompt overlay (in the case ;; where there is no prompt ((bolp) == t), we still do @@ -2136,8 +2119,8 @@ between the process mark and point. WARNING: if there is no current subjob, you can end up suspending -the top-level process running in the buffer. If you accidentally do -this, use \\[comint-continue-subjob] to resume the process. (This +the top-level process running in the buffer. If you accidentally do +this, use \\[comint-continue-subjob] to resume the process. (This is not a problem with most shells, since they ignore this signal.)" (interactive) (comint-skip-input) @@ -2357,9 +2340,9 @@ (defun comint-kill-whole-line (&optional arg) "Kill current line, ignoring read-only and field properties. -With prefix arg, kill that many lines starting from the current line. +With prefix ARG, kill that many lines starting from the current line. If arg is negative, kill backward. Also kill the preceding newline, -instead of the trailing one. \(This is meant to make C-x z work well +instead of the trailing one. \(This is meant to make \\[repeat] work well with negative arguments.) If arg is zero, kill current line but exclude the trailing newline. The read-only status of newlines is updated with `comint-update-fence', @@ -2505,7 +2488,7 @@ See `comint-source-default' for more on determining defaults. -PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair +PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair from the last source processing command. SOURCE-MODES is a list of major modes used to determine what file buffers contain source files. (These two arguments are used for determining defaults). If MUSTMATCH-P is true, @@ -3503,5 +3486,5 @@ (provide 'comint) -;;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164 +;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164 ;;; comint.el ends here
--- a/lisp/diff-mode.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/diff-mode.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,6 +1,7 @@ ;;; diff-mode.el --- a mode for viewing/editing context diffs -;; Copyright (C) 1998,1999,2000,01,02,03,2004 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: convenience patch diff @@ -171,75 +172,73 @@ (defface diff-header-face '((((class color) (min-colors 88) (background light)) - (:background "grey85")) + :background "grey85") (((class color) (min-colors 88) (background dark)) - (:background "grey45")) + :background "grey45") (((class color) (background light)) - (:foreground "blue1" :weight bold)) + :foreground "blue1" :weight bold) (((class color) (background dark)) - (:foreground "green" :weight bold)) - (t (:weight bold))) + :foreground "green" :weight bold) + (t :weight bold)) "`diff-mode' face inherited by hunk and index header faces.") (defvar diff-header-face 'diff-header-face) (defface diff-file-header-face '((((class color) (min-colors 88) (background light)) - (:background "grey70" :weight bold)) + :background "grey70" :weight bold) (((class color) (min-colors 88) (background dark)) - (:background "grey60" :weight bold)) + :background "grey60" :weight bold) (((class color) (background light)) - (:foreground "yellow" :weight bold)) + :foreground "yellow" :weight bold) (((class color) (background dark)) - (:foreground "cyan" :weight bold)) - (t (:weight bold))) ; :height 1.3 + :foreground "cyan" :weight bold) + (t :weight bold)) ; :height 1.3 "`diff-mode' face used to highlight file header lines.") (defvar diff-file-header-face 'diff-file-header-face) (defface diff-index-face - '((t (:inherit diff-file-header-face))) + '((t :inherit diff-file-header-face)) "`diff-mode' face used to highlight index header lines.") (defvar diff-index-face 'diff-index-face) (defface diff-hunk-header-face - '((t (:inherit diff-header-face))) + '((t :inherit diff-header-face)) "`diff-mode' face used to highlight hunk header lines.") (defvar diff-hunk-header-face 'diff-hunk-header-face) (defface diff-removed-face - '((t (:inherit diff-changed-face))) + '((t :inherit diff-changed-face)) "`diff-mode' face used to highlight removed lines.") (defvar diff-removed-face 'diff-removed-face) (defface diff-added-face - '((t (:inherit diff-changed-face))) + '((t :inherit diff-changed-face)) "`diff-mode' face used to highlight added lines.") (defvar diff-added-face 'diff-added-face) (defface diff-changed-face '((((type tty pc) (class color) (background light)) - (:foreground "magenta" :weight bold :slant italic)) + :foreground "magenta" :weight bold :slant italic) (((type tty pc) (class color) (background dark)) - (:foreground "yellow" :weight bold :slant italic)) - (t ())) + :foreground "yellow" :weight bold :slant italic)) "`diff-mode' face used to highlight changed lines.") (defvar diff-changed-face 'diff-changed-face) (defface diff-function-face - '((t (:inherit diff-context-face))) + '((t :inherit diff-context-face)) "`diff-mode' face used to highlight function names produced by \"diff -p\".") (defvar diff-function-face 'diff-function-face) (defface diff-context-face '((((class color) (background light)) - (:foreground "grey50")) + :foreground "grey50") (((class color) (background dark)) - (:foreground "grey70")) - (t )) + :foreground "grey70")) "`diff-mode' face used to highlight context and other side-information.") (defvar diff-context-face 'diff-context-face) (defface diff-nonexistent-face - '((t (:inherit diff-file-header-face))) + '((t :inherit diff-file-header-face)) "`diff-mode' face used to highlight nonexistent files in recursive diffs.") (defvar diff-nonexistent-face 'diff-nonexistent-face) @@ -1255,7 +1254,7 @@ (save-excursion (when (looking-at diff-hunk-header-re) (forward-line 1) - (while (and (looking-at " ") (not (zerop (forward-line 1)))))) + (re-search-forward "^[^ ]" nil t)) (destructuring-bind (buf line-offset pos src dst &optional switched) (diff-find-source-location) (beginning-of-line) @@ -1355,5 +1354,5 @@ ;; use `combine-after-change-calls' to minimize the slowdown of font-lock. ;; -;;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66 +;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66 ;;; diff-mode.el ends here
--- a/lisp/emacs-lisp/byte-opt.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/emacs-lisp/byte-opt.el Thu Oct 14 08:50:09 2004 +0000 @@ -1152,7 +1152,7 @@ (numberp (nth 1 form))) (list 'forward-word (eval (- (nth 1 form))))) ((= 1 (safe-length form)) - '(forward-char -1)) + '(forward-word -1)) (t form))) (put 'char-before 'byte-optimizer 'byte-optimize-char-before)
--- a/lisp/emacs-lisp/lisp-mode.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/emacs-lisp/lisp-mode.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,6 +1,7 @@ ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands -;; Copyright (C) 1985,86,1999,2000,01,03,2004 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2003, 2004 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: lisp, languages @@ -1153,7 +1154,8 @@ and initial semicolons." (interactive "P") (or (fill-comment-paragraph justify) - ;; Point is on a program line (a line no comment); we are interested + ;; Since fill-comment-paragraph returned nil, that means we're not in + ;; a comment: Point is on a program line; we are interested ;; particularly in docstring lines. ;; ;; We bind `paragraph-start' and `paragraph-separate' temporarily. They @@ -1182,7 +1184,7 @@ ;; The `fill-column' is temporarily bound to ;; `emacs-lisp-docstring-fill-column' if that value is an integer. (let ((paragraph-start (concat paragraph-start - "\\|\\s-*\\([\(;:\"]\\|`\(\\)")) + "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)")) (paragraph-separate (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) (fill-column (if (integerp emacs-lisp-docstring-fill-column) @@ -1227,5 +1229,5 @@ (provide 'lisp-mode) -;;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf +;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf ;;; lisp-mode.el ends here
--- a/lisp/emacs-lisp/lisp.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/emacs-lisp/lisp.el Thu Oct 14 08:50:09 2004 +0000 @@ -75,17 +75,19 @@ move to with the same argument. If this command is repeated, it marks the next ARG sexps after the ones already marked." - (interactive "p") + (interactive "P") (cond ((and (eq last-command this-command) (mark t)) + (setq arg (if arg (prefix-numeric-value arg) + (if (> (mark) (point)) 1 -1))) (set-mark (save-excursion (goto-char (mark)) - (forward-sexp (or arg 1)) + (forward-sexp arg) (point)))) (t (push-mark (save-excursion - (forward-sexp (or arg 1)) + (forward-sexp (prefix-numeric-value arg)) (point)) nil t))))
--- a/lisp/font-lock.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/font-lock.el Thu Oct 14 08:50:09 2004 +0000 @@ -1324,6 +1324,12 @@ (add-text-properties start end (cddr val)) (setq val (cadr val))) (cond + ((not (or val (eq override t))) + ;; If `val' is nil, don't do anything. It is important to do it + ;; explicitly, because when adding nil via things like + ;; font-lock-append-text-property, the property is actually + ;; changed from <face> to (<face>) which is undesirable. --Stef + nil) ((not override) ;; Cannot override existing fontification. (or (text-property-not-all start end 'face nil)
--- a/lisp/gnus/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,55 @@ +2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-tokenize-header): Fix 2004-09-06 change + which used point-min in the wrong place. + +2004-10-12 Simon Josefsson <jas@extundo.com> + + * net/tls.el (tls-certtool-program): New variable. + (tls-certificate-information): New function, based on + ssl-certificate-information. + +2004-10-10 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-sum.el: Mention that multibyte characters don't work as marks. + + * gnus.el (message-y-or-n-p): Autoload. + + * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port) + (pop3-password-required, pop3-authentication-scheme) + (pop3-leave-mail-on-server): Made customizable. + (pop3): New custom group. + (pop3-retr): Remove `sleep-for' statements. + Suggested by Dave Love <fx@gnu.org>. + + * nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for + Windows/DOS. + + * imap.el (imap-parse-flag-list, imap-parse-body-extension) + (imap-parse-body): Fix incorrect use of `assert'. Suggested by + Dave Love <fx@gnu.org>. + + * mml.el (mml-minibuffer-read-disposition): Require match. + Suggested by Dave Love <fx@gnu.org>. + +2004-10-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-group.el (gnus-update-group-mark-positions): + * gnus-sum.el (gnus-update-summary-mark-positions): + * message.el (message-check-news-body-syntax): + * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead + of string-as-multibyte. + + * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq. + +2004-10-05 Juri Linkov <juri@jurta.org> + + * gnus-group.el (gnus-update-group-mark-positions): + * gnus-sum.el (gnus-update-summary-mark-positions): + * message.el (message-check-news-body-syntax): + * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert + 8-bit unibyte values to a multibyte string for search functions. + 2004-10-01 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-sum.el (gnus-summary-toggle-header): Make it work even if
--- a/lisp/gnus/gnus-group.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/gnus-group.el Thu Oct 14 08:50:09 2004 +0000 @@ -1046,7 +1046,8 @@ (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) (goto-char (point-min)) (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward "\200" nil t) + (list (cons 'process (and (search-forward + (mm-string-as-multibyte "\200") nil t) (- (point) 2)))))))) (defun gnus-mouse-pick-group (e)
--- a/lisp/gnus/gnus-msg.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/gnus-msg.el Thu Oct 14 08:50:09 2004 +0000 @@ -1534,7 +1534,8 @@ ;; Remove any control chars - they seem to cause trouble for some ;; mailers. (Byte-compiled output from the stuff above.) (goto-char point) - (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t) + (while (re-search-forward (mm-string-as-multibyte + "[\000-\010\013-\037\200-\237]") nil t) (replace-match (format "\\%03o" (string-to-char (match-string 0))) t t))))
--- a/lisp/gnus/gnus-sum.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/gnus-sum.el Thu Oct 14 08:50:09 2004 +0000 @@ -428,6 +428,9 @@ (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) +;; FIXME: Although the custom type is `character' for the following variables, +;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs + (defcustom gnus-unread-mark ? ;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks @@ -3231,20 +3234,24 @@ [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil] 0 nil t 128 t nil "" nil 1) (goto-char (point-min)) - (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) (point-min) 1))))) + (setq pos (list (cons 'unread + (and (search-forward + (mm-string-as-multibyte "\200") nil t) + (- (point) (point-min) 1))))) (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) + (push (cons 'replied (and (search-forward + (mm-string-as-multibyte "\201") nil t) (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) + (push (cons 'score (and (search-forward + (mm-string-as-multibyte "\202") nil t) (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'download - (and (search-forward "\203" nil t) - (- (point) (point-min) 1))) + (push (cons 'download (and (search-forward + (mm-string-as-multibyte "\203") nil t) + (- (point) (point-min) 1))) pos))) (setq gnus-summary-mark-positions pos)))) @@ -6009,8 +6016,7 @@ ;; Remove list identifiers from subject. (when gnus-list-identifiers (let ((gnus-newsgroup-headers (list header))) - (gnus-summary-remove-list-identifiers) - (setq header (car gnus-newsgroup-headers)))) + (gnus-summary-remove-list-identifiers))) (when old-header (mail-header-set-number header (mail-header-number old-header))) (setq gnus-newsgroup-sparse
--- a/lisp/gnus/gnus.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/gnus.el Thu Oct 14 08:50:09 2004 +0000 @@ -34,6 +34,7 @@ (require 'wid-edit) (require 'mm-util) (require 'nnheader) +(autoload 'message-y-or-n-p "message" nil nil 'macro) (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
--- a/lisp/gnus/imap.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/imap.el Thu Oct 14 08:50:09 2004 +0000 @@ -2421,7 +2421,7 @@ (defun imap-parse-flag-list () (let (flag-list start) - (assert (eq (char-after) ?\() t "In imap-parse-flag-list") + (assert (eq (char-after) ?\() nil "In imap-parse-flag-list") (while (and (not (eq (char-after) ?\))) (setq start (progn (imap-forward) @@ -2430,7 +2430,7 @@ (point))) (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0)) (push (buffer-substring start (point)) flag-list)) - (assert (eq (char-after) ?\)) t "In imap-parse-flag-list") + (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list") (imap-forward) (nreverse flag-list))) @@ -2515,7 +2515,7 @@ (while (eq (char-after) ?\ ) (imap-forward) (push (imap-parse-body-extension) b-e)) - (assert (eq (char-after) ?\)) t "In imap-parse-body-extension") + (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension") (imap-forward) (nreverse b-e)) (or (imap-parse-number) @@ -2641,7 +2641,7 @@ (push (and (imap-parse-nil) nil) body)) (setq body (append (imap-parse-body-ext) body))) ;; body-ext-... - (assert (eq (char-after) ?\)) t "In imap-parse-body") + (assert (eq (char-after) ?\)) nil "In imap-parse-body") (imap-forward) (nreverse body)) @@ -2701,7 +2701,7 @@ (push (imap-parse-nstring) body) ;; body-fld-md5 (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part.. - (assert (eq (char-after) ?\)) t "In imap-parse-body 2") + (assert (eq (char-after) ?\)) nil "In imap-parse-body 2") (imap-forward) (nreverse body)))))
--- a/lisp/gnus/message.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/message.el Thu Oct 14 08:50:09 2004 +0000 @@ -1615,11 +1615,11 @@ (if (not header) nil (let ((regexp (format "[%s]+" (or separator ","))) - (beg (point-min)) (first t) - quoted elems paren) + beg quoted elems paren) (with-temp-buffer (mm-enable-multibyte) + (setq beg (point-min)) (insert header) (goto-char (point-min)) (while (not (eobp)) @@ -4399,7 +4399,9 @@ nil)))) ;; Check for control characters. (message-check 'control-chars - (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t) + (if (re-search-forward + (mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") + nil t) (y-or-n-p "The article contains control characters. Really post? ") t))
--- a/lisp/gnus/mml.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/mml.el Thu Oct 14 08:50:09 2004 +0000 @@ -945,8 +945,7 @@ "attachment"))) (disposition (completing-read "Disposition: " '(("attachment") ("inline") ("")) - nil - nil))) + nil t))) (if (not (equal disposition "")) disposition default)))
--- a/lisp/gnus/nnheader.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/nnheader.el Thu Oct 14 08:50:09 2004 +0000 @@ -74,7 +74,15 @@ (defvar nnheader-read-timeout (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" (symbol-name system-type)) - 1.0 ; why? + ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de + ;; + ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS. + ;; + ;; There should probably be a runtime test to determine the timing + ;; resolution, or a primitive to report it. I don't know off-hand + ;; what's possible. Perhaps better, maybe the Windows/DOS primitive + ;; could round up non-zero timeouts to a minimum of 1.0? + 1.0 0.1) "How long nntp should wait between checking for the end of output. Shorter values mean quicker response, but are more CPU intensive.")
--- a/lisp/gnus/pop3.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/gnus/pop3.el Thu Oct 14 08:50:09 2004 +0000 @@ -37,25 +37,56 @@ (require 'mail-utils) -(defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil) - "*POP3 maildrop.") -(defvar pop3-mailhost (or (getenv "MAILHOST") nil) - "*POP3 mailhost.") -(defvar pop3-port 110 - "*POP3 port.") +(defgroup pop3 nil + "Post Office Protocol" + :group 'mail + :group 'mail-source) + +(defcustom pop3-maildrop (or (user-login-name) + (getenv "LOGNAME") + (getenv "USER")) + "*POP3 maildrop." + :version "21.4" ;; Oort Gnus + :type 'string + :group 'pop3) -(defvar pop3-password-required t - "*Non-nil if a password is required when connecting to POP server.") +(defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch + "pop3") + "*POP3 mailhost." + :version "21.4" ;; Oort Gnus + :type 'string + :group 'pop3) + +(defcustom pop3-port 110 + "*POP3 port." + :version "21.4" ;; Oort Gnus + :type 'number + :group 'pop3) + +(defcustom pop3-password-required t + "*Non-nil if a password is required when connecting to POP server." + :version "21.4" ;; Oort Gnus + :type 'boolean + :group 'pop3) + +;; Should this be customizable? (defvar pop3-password nil "*Password to use when connecting to POP server.") -(defvar pop3-authentication-scheme 'pass +(defcustom pop3-authentication-scheme 'pass "*POP3 authentication scheme. Defaults to 'pass, for the standard USER/PASS authentication. Other valid -values are 'apop.") +values are 'apop." + :version "21.4" ;; Oort Gnus + :type '(choice (const :tag "USER/PASS" pass) + (const :tag "APOP" apop)) + :group 'pop3) -(defvar pop3-leave-mail-on-server nil - "*Non-nil if the mail is to be left on the POP server after fetching.") +(defcustom pop3-leave-mail-on-server nil + "*Non-nil if the mail is to be left on the POP server after fetching." + :version "21.4" ;; Oort Gnus + :type 'boolean + :group 'pop3) (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. @@ -71,8 +102,7 @@ (crashbuf (get-buffer-create " *pop3-retr*")) (n 1) message-count - (pop3-password pop3-password) - ) + (pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) ;; query for password @@ -114,8 +144,7 @@ "Return the number of messages in the maildrop." (let* ((process (pop3-open-server pop3-mailhost pop3-port)) message-count - (pop3-password pop3-password) - ) + (pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) ;; query for password @@ -159,15 +188,14 @@ (insert output))) (defun pop3-send-command (process command) - (set-buffer (process-buffer process)) - (goto-char (point-max)) -;; (if (= (aref command 0) ?P) -;; (insert "PASS <omitted>\r\n") -;; (insert command "\r\n")) - (setq pop3-read-point (point)) - (goto-char (point-max)) - (process-send-string process (concat command "\r\n")) - ) + (set-buffer (process-buffer process)) + (goto-char (point-max)) + ;; (if (= (aref command 0) ?P) + ;; (insert "PASS <omitted>\r\n") + ;; (insert command "\r\n")) + (setq pop3-read-point (point)) + (goto-char (point-max)) + (process-send-string process (concat command "\r\n"))) (defun pop3-read-response (process &optional return) "Read the response from the server. @@ -355,27 +383,15 @@ (while (not (re-search-forward "^\\.\r\n" nil t)) ;; Fixme: Shouldn't depend on nnheader. (nnheader-accept-process-output process) - ;; bill@att.com ... to save wear and tear on the heap - ;; uncommented because the condensed version below is a problem for - ;; some. - (if (> (buffer-size) 20000) (sleep-for 1)) - (if (> (buffer-size) 50000) (sleep-for 1)) - (if (> (buffer-size) 100000) (sleep-for 1)) - (if (> (buffer-size) 200000) (sleep-for 1)) - (if (> (buffer-size) 500000) (sleep-for 1)) - ;; bill@att.com - ;; condensed into: - ;; (sometimes causes problems for really large messages.) -; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000))) (goto-char start)) (setq pop3-read-point (point-marker)) -;; this code does not seem to work for some POP servers... -;; and I cannot figure out why not. -; (goto-char (match-beginning 0)) -; (backward-char 2) -; (if (not (looking-at "\r\n")) -; (insert "\r\n")) -; (re-search-forward "\\.\r\n") + ;; this code does not seem to work for some POP servers... + ;; and I cannot figure out why not. + ;; (goto-char (match-beginning 0)) + ;; (backward-char 2) + ;; (if (not (looking-at "\r\n")) + ;; (insert "\r\n")) + ;; (re-search-forward "\\.\r\n") (goto-char (match-beginning 0)) (setq end (point-marker)) (pop3-clean-region start end)
--- a/lisp/help-fns.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/help-fns.el Thu Oct 14 08:50:09 2004 +0000 @@ -552,9 +552,15 @@ (forward-line 1) (forward-sexp 1) (delete-region (point) (progn (end-of-line) (point))) - (insert " value is shown below.\n\n") (save-excursion - (insert "\n\nValue:")))) + (insert "\n\nValue:") + (set (make-local-variable 'help-button-cache) + (point-marker))) + (insert " value is shown ") + (insert-button "below" + 'action help-button-cache + 'help-echo "mouse-2, RET: show value") + (insert ".\n\n"))) ;; Add a note for variables that have been make-var-buffer-local. (when (and (local-variable-if-set-p variable) (or (not (local-variable-p variable))
--- a/lisp/help.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/help.el Thu Oct 14 08:50:09 2004 +0000 @@ -111,6 +111,9 @@ (define-key help-map "q" 'help-quit) +;; insert-button makes the action nil if it is not store somewhere +(defvar help-button-cache nil) + (defun help-quit () "Just exit from the Help command's command loop." @@ -655,32 +658,42 @@ (lambda (a b) (string-lessp (car a) (car b))))) (when minor-modes (princ "Summary of minor modes:\n") - (dolist (mode minor-modes) - (let ((pretty-minor-mode (nth 0 mode)) - (indicator (nth 2 mode))) - (princ (format " %s minor mode (%s):\n" - pretty-minor-mode - (if indicator - (format "indicator%s" indicator) - "no indicator"))))) + (make-local-variable 'help-button-cache) + (with-current-buffer standard-output + (dolist (mode minor-modes) + (let ((pretty-minor-mode (nth 0 mode)) + (mode-function (nth 1 mode)) + (indicator (nth 2 mode))) + (add-text-properties 0 (length pretty-minor-mode) + '(face bold) pretty-minor-mode) + (save-excursion + (goto-char (point-max)) + (princ "\n\f\n") + (push (point-marker) help-button-cache) + ;; Document the minor modes fully. + (insert pretty-minor-mode) + (princ (format " minor mode (%s):\n" + (if indicator + (format "indicator%s" indicator) + "no indicator"))) + (princ (documentation mode-function))) + (princ " ") + (insert-button pretty-minor-mode + 'action (car help-button-cache) + 'help-echo "mouse-2, RET: show full information") + (princ (format " minor mode (%s):\n" + (if indicator + (format "indicator%s" indicator) + "no indicator")))))) (princ "\n(Full information about these minor modes follows the description of the major mode.)\n\n")) ;; Document the major mode. - (princ mode-name) + (let ((mode mode-name)) + (with-current-buffer standard-output + (insert mode) + (add-text-properties (- (point) (length mode)) (point) '(face bold)))) (princ " mode:\n") - (princ (documentation major-mode)) - ;; Document the minor modes fully. - (dolist (mode minor-modes) - (let ((pretty-minor-mode (nth 0 mode)) - (mode-function (nth 1 mode)) - (indicator (nth 2 mode))) - (princ "\n\f\n") - (princ (format "%s minor mode (%s):\n" - pretty-minor-mode - (if indicator - (format "indicator%s" indicator) - "no indicator"))) - (princ (documentation mode-function))))) + (princ (documentation major-mode))) (print-help-return-message))))
--- a/lisp/imenu.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/imenu.el Thu Oct 14 08:50:09 2004 +0000 @@ -317,9 +317,12 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Return the current/previous sexp and the location of the sexp (its -;; beginning) without moving the point. +;; FIXME: This is the only imenu-example-* definition that's actually used, +;; and it seems to only be used by cperl-mode.el. We should just move it to +;; cperl-mode.el and remove the rest. (defun imenu-example--name-and-position () + "Return the current/previous sexp and its (beginning) location. +Don't move point." (save-excursion (forward-sexp -1) ;; [ydi] modified for imenu-use-markers @@ -549,12 +552,10 @@ (cond ((consp (cdr item)) (imenu--truncate-items (cdr item))) - (t - ;; truncate if necessary - (if (and (numberp imenu-max-item-length) - (> (length (car item)) imenu-max-item-length)) - (setcar item (substring (car item) 0 - imenu-max-item-length))))))) + ;; truncate if necessary + ((and (numberp imenu-max-item-length) + (> (length (car item)) imenu-max-item-length)) + (setcar item (substring (car item) 0 imenu-max-item-length)))))) menulist)) @@ -854,7 +855,7 @@ (defun imenu--completion-buffer (index-alist &optional prompt) "Let the user select from INDEX-ALIST in a completion buffer with PROMPT. -Returns t for rescan and otherwise a position number." +Return one of the entries in index-alist or nil." ;; Create a list for this buffer only when needed. (let ((name (thing-at-point 'symbol)) choice @@ -880,13 +881,11 @@ prepared-index-alist nil t nil 'imenu--history-list name))) - (cond ((not (stringp name)) nil) - ((string= name (car imenu--rescan-item)) t) - (t - (setq choice (assoc name prepared-index-alist)) - (if (imenu--subalist-p choice) - (imenu--completion-buffer (cdr choice) prompt) - choice))))) + (when (stringp name) + (setq choice (assoc name prepared-index-alist)) + (if (imenu--subalist-p choice) + (imenu--completion-buffer (cdr choice) prompt) + choice)))) (defun imenu--mouse-menu (index-alist event &optional title) "Let the user select from a buffer index from a mouse menu. @@ -937,9 +936,9 @@ (or (eq imenu-use-popup-menu t) mouse-triggered)) (imenu--mouse-menu index-alist last-nonmenu-event) (imenu--completion-buffer index-alist prompt))) - (and (eq result t) + (and (equal result imenu--rescan-item) (imenu--cleanup) - (setq imenu--index-alist nil))) + (setq result t imenu--index-alist nil))) result)) ;;;###autoload @@ -1014,7 +1013,7 @@ nil)) (defun imenu-default-goto-function (name position &optional rest) - "Move the point to the given position. + "Move to the given position. NAME is ignored. POSITION is where to move. REST is also ignored. The ignored args just make this function have the same interface as a @@ -1054,5 +1053,5 @@ (provide 'imenu) -;;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7 +;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7 ;;; imenu.el ends here
--- a/lisp/info-look.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/info-look.el Thu Oct 14 08:50:09 2004 +0000 @@ -245,6 +245,7 @@ (interactive) (setq info-lookup-cache nil)) +;;;###autoload (put 'info-lookup-symbol 'info-file "emacs") ;;;###autoload (defun info-lookup-symbol (symbol &optional mode) "Display the definition of SYMBOL, as found in the relevant manual. @@ -258,6 +259,7 @@ (info-lookup-interactive-arguments 'symbol current-prefix-arg)) (info-lookup 'symbol symbol mode)) +;;;###autoload (put 'info-lookup-file 'info-file "emacs") ;;;###autoload (defun info-lookup-file (file &optional mode) "Display the documentation of a file.
--- a/lisp/info.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/info.el Thu Oct 14 08:50:09 2004 +0000 @@ -79,8 +79,8 @@ :group 'info) (defface info-xref - '((((class color) (background light)) :foreground "blue") - (((class color) (background dark)) :foreground "cyan") + '((((class color) (background light)) :foreground "blue" :underline t) + (((class color) (background dark)) :foreground "cyan" :underline t) (t :underline t)) "Face for Info cross-references." :group 'info) @@ -455,6 +455,7 @@ ;;;###autoload (add-hook 'same-window-regexps "\\*info\\*\\(\\|<[0-9]+>\\)") +;;;###autoload (put 'info 'info-file "emacs") ;;;###autoload (defun info (&optional file buffer) "Enter Info, the documentation browser. @@ -1729,7 +1730,7 @@ (let ((inhibit-read-only t)) (erase-buffer) (goto-char (point-min)) - (insert "\n\^_\nFile: history Node: Top, Up: (dir)\n\n") + (insert "\n\^_\nFile: history, Node: Top, Up: (dir)\n\n") (insert "Recently Visited Nodes\n**********************\n\n") (insert "* Menu:\n\n") (let ((hl (delete '("history" "Top") Info-history-list))) @@ -1749,26 +1750,31 @@ "Go to a node with table of contents of the current Info file. Table of contents is created from the tree structure of menus." (interactive) - (let ((curr-file Info-current-file) - (curr-node Info-current-node) + (let ((curr-file (substring-no-properties Info-current-file)) + (curr-node (substring-no-properties Info-current-node)) p) (with-current-buffer (get-buffer-create " *info-toc*") (let ((inhibit-read-only t) (node-list (Info-build-toc curr-file))) (erase-buffer) (goto-char (point-min)) - (insert "\n\^_\nFile: toc Node: Top, Up: (dir)\n\n") + (insert "\n\^_\nFile: toc, Node: Top, Up: (dir)\n\n") (insert "Table of Contents\n*****************\n\n") - (insert "*Note Top::\n") + (insert "*Note Top: (" curr-file ")Top.\n") (Info-insert-toc (nth 2 (assoc "Top" node-list)) ; get Top nodes - node-list 0 (substring-no-properties curr-file))) + node-list 0 curr-file)) (if (not (bobp)) (let ((Info-hide-note-references 'hide) (Info-fontify-visited-nodes nil)) (Info-mode) (setq Info-current-file "toc" Info-current-node "Top") - (Info-fontify-node))) + (goto-char (point-min)) + (narrow-to-region (or (re-search-forward "\n[\^_\f]\n" nil t) + (point-min)) + (point-max)) + (Info-fontify-node) + (widen))) (goto-char (point-min)) (if (setq p (search-forward (concat "*Note " curr-node ":") nil t)) (setq p (- p (length curr-node) 2)))) @@ -1789,14 +1795,12 @@ (defun Info-build-toc (file) "Build table of contents from menus of Info FILE and its subfiles." - (if (equal file "dir") - (error "Table of contents for Info directory is not supported yet")) (with-temp-buffer - (let* ((default-directory (or (and (stringp file) - (file-name-directory - (setq file (Info-find-file file)))) + (let* ((file (and (stringp file) (Info-find-file file))) + (default-directory (or (and (stringp file) + (file-name-directory file)) default-directory)) - (main-file file) + (main-file (and (stringp file) file)) (sections '(("Top" "Top"))) nodes subfiles) (while (or main-file subfiles) @@ -3258,6 +3262,7 @@ (car elt) elt)) (file (if (consp elt) (cdr elt) elt)) + (case-fold-search nil) (regexp (concat "\\`" (regexp-quote name) "\\(\\'\\|-\\)"))) (if (string-match regexp (symbol-name command))
--- a/lisp/isearch.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/isearch.el Thu Oct 14 08:50:09 2004 +0000 @@ -676,16 +676,7 @@ (if isearch-small-window (goto-char found-point) ;; Exiting the save-window-excursion clobbers window-start; restore it. - (set-window-start (selected-window) found-start t)) - - ;; If there was movement, mark the starting position. - ;; Maybe should test difference between and set mark iff > threshold. - (if (/= (point) isearch-opoint) - (or (and transient-mark-mode mark-active) - (progn - (push-mark isearch-opoint t) - (or executing-kbd-macro (> (minibuffer-depth) 0) - (message "Mark saved where search started")))))) + (set-window-start (selected-window) found-start t))) (setq isearch-mode nil) (if isearch-input-method-local-p @@ -710,6 +701,16 @@ (isearch-update-ring isearch-string isearch-regexp)) (run-hooks 'isearch-mode-end-hook) + + ;; If there was movement, mark the starting position. + ;; Maybe should test difference between and set mark iff > threshold. + (if (/= (point) isearch-opoint) + (or (and transient-mark-mode mark-active) + (progn + (push-mark isearch-opoint t) + (or executing-kbd-macro (> (minibuffer-depth) 0) + (message "Mark saved where search started"))))) + (and (not edit) isearch-recursive-edit (exit-recursive-edit))) (defun isearch-update-ring (string &optional regexp) @@ -1249,8 +1250,8 @@ (defun isearch-yank-line () "Pull rest of line from buffer into search string." (interactive) - (isearch-yank-internal 'line-end-position)) - + (isearch-yank-internal + (lambda () (line-end-position (if (eolp) 2 1))))) (defun isearch-search-and-update () ;; Do the search and update the display.
--- a/lisp/kmacro.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/kmacro.el Thu Oct 14 08:50:09 2004 +0000 @@ -248,7 +248,9 @@ "Insert macro counter and increment with ARG or 1 if missing. With \\[universal-argument], insert previous kmacro-counter (but do not modify counter)." (interactive "P") - (setq kmacro-initial-counter-value nil) + (if kmacro-initial-counter-value + (setq kmacro-counter kmacro-initial-counter-value + kmacro-initial-counter-value nil)) (if (and arg (listp arg)) (insert (format kmacro-counter-format kmacro-last-counter)) (insert (format kmacro-counter-format kmacro-counter)) @@ -275,23 +277,23 @@ "Set kmacro-counter to ARG or prompt if missing. With \\[universal-argument] prefix, reset counter to its value prior to this iteration of the macro." (interactive "NMacro counter value: ") - (setq kmacro-last-counter kmacro-counter - kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg)) - kmacro-counter-value-start - arg)) - ;; setup initial macro counter value if we are not executing a macro. - (setq kmacro-initial-counter-value - (and (not (or defining-kbd-macro executing-kbd-macro)) - kmacro-counter)) - (unless executing-kbd-macro - (kmacro-display-counter))) + (if (not (or defining-kbd-macro executing-kbd-macro)) + (kmacro-display-counter (setq kmacro-initial-counter-value arg)) + (setq kmacro-last-counter kmacro-counter + kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg)) + kmacro-counter-value-start + arg)) + (unless executing-kbd-macro + (kmacro-display-counter)))) (defun kmacro-add-counter (arg) "Add numeric prefix arg (prompt if missing) to macro counter. With \\[universal-argument], restore previous counter value." (interactive "NAdd to macro counter: ") - (setq kmacro-initial-counter-value nil) + (if kmacro-initial-counter-value + (setq kmacro-counter kmacro-initial-counter-value + kmacro-initial-counter-value nil)) (let ((last kmacro-last-counter)) (setq kmacro-last-counter kmacro-counter kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg)) @@ -394,7 +396,10 @@ (m (format-kbd-macro macro)) (l (length m)) (z (and nil trunc (> l x)))) - (message (format "%s: %s%s" (or descr "Macro") + (message (format "%s%s: %s%s" (or descr "Macro") + (if (= kmacro-counter 0) "" + (format " [%s]" + (format kmacro-counter-format-start kmacro-counter))) (if z (substring m 0 (1- x)) m) (if z "..." "")))) (message (or empty "No keyboard macros defined"))))
--- a/lisp/mail/mail-extr.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/mail/mail-extr.el Thu Oct 14 08:50:09 2004 +0000 @@ -234,6 +234,13 @@ :version "21.4" :group 'mail-extr) +(defcustom mail-extr-ignore-realname-equals-mailbox-name t +"*Whether to ignore a name that is equal to the mailbox name. +If true, then when the address is like \"Single <single@address.com>\" +we will act as though we couldn't find a full name in the address." + :type 'boolean + :group 'mail-extr) + ;; Matches a leading title that is not part of the name (does not ;; contribute to uniquely identifying the person). (defcustom mail-extr-full-name-prefixes @@ -694,7 +701,7 @@ "Given an RFC-822 address ADDRESS, extract full name and canonical address. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). If no name can be extracted, FULL-NAME will be nil. Also see -`mail-extr-ignore-single-names'. +`mail-extr-ignore-single-names' and `mail-extr-ignore-realname-equals-mailbox-name'. If the optional argument ALL is non-nil, then ADDRESS can contain zero or more recipients, separated by commas, and we return a list of @@ -1404,8 +1411,9 @@ (setq names-match-flag nil)) (setq i (1+ i))) (delete-region (+ (point-min) buffer-length) (point-max)) - (if names-match-flag - (narrow-to-region (point) (point))))) + (and names-match-flag + mail-extr-ignore-realname-equals-mailbox-name + (narrow-to-region (point) (point))))) ;; Nuke name if it's just one word. (goto-char (point-min))
--- a/lisp/mail/smtpmail.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/mail/smtpmail.el Thu Oct 14 08:50:09 2004 +0000 @@ -471,26 +471,32 @@ (if (null (and cred (condition-case () (progn (require 'starttls) - (call-process starttls-program)) + (call-process (if starttls-use-gnutls + starttls-gnutls-program + starttls-program))) (error nil)))) ;; The normal case. (open-network-stream "SMTP" process-buffer host port) (let* ((cred-key (smtpmail-cred-key cred)) (cred-cert (smtpmail-cred-cert cred)) (starttls-extra-args - (when (and (stringp cred-key) (stringp cred-cert) - (file-regular-p - (setq cred-key (expand-file-name cred-key))) - (file-regular-p - (setq cred-cert (expand-file-name cred-cert)))) - (list "--key-file" cred-key "--cert-file" cred-cert))) + (append + starttls-extra-args + (when (and (stringp cred-key) (stringp cred-cert) + (file-regular-p + (setq cred-key (expand-file-name cred-key))) + (file-regular-p + (setq cred-cert (expand-file-name cred-cert)))) + (list "--key-file" cred-key "--cert-file" cred-cert)))) (starttls-extra-arguments - (when (and (stringp cred-key) (stringp cred-cert) - (file-regular-p - (setq cred-key (expand-file-name cred-key))) - (file-regular-p - (setq cred-cert (expand-file-name cred-cert)))) - (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))) + (append + starttls-extra-arguments + (when (and (stringp cred-key) (stringp cred-cert) + (file-regular-p + (setq cred-key (expand-file-name cred-key))) + (file-regular-p + (setq cred-cert (expand-file-name cred-cert)))) + (list "--x509keyfile" cred-key "--x509certfile" cred-cert))))) (starttls-open-stream "SMTP" process-buffer host port))))) (defun smtpmail-try-auth-methods (process supported-extensions host port)
--- a/lisp/net/ange-ftp.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/net/ange-ftp.el Thu Oct 14 08:50:09 2004 +0000 @@ -4514,9 +4514,6 @@ 1)) (apply 'call-process program nil (not discard) nil arguments))) -(defvar ange-ftp-remote-shell "rsh" - "Remote shell to use for chmod, if FTP server rejects the `chmod' command.") - ;; Handle an attempt to run chmod on a remote file ;; by using the ftp chmod command. (defun ange-ftp-call-chmod (args) @@ -4541,7 +4538,7 @@ abbr)))) (or (car result) (call-process - ange-ftp-remote-shell + remote-shell-program nil t nil host dired-chmod-program mode name)))))) rest)) (setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
--- a/lisp/net/tls.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/net/tls.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,6 +1,6 @@ ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2003, 2004 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; Keywords: comm, tls, gnutls, ssl @@ -76,6 +76,35 @@ :type 'regexp :group 'tls) +(defcustom tls-certtool-program (executable-find "certtool") + "Name of GnuTLS certtool. +Used by `tls-certificate-information'." + :type '(repeat string) + :group 'tls) + +(defun tls-certificate-information (der) + "Parse X.509 certificate in DER format into an assoc list." + (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" + (base64-encode-string der) + "\n-----END CERTIFICATE-----\n")) + (exit-code 0)) + (with-current-buffer (get-buffer-create " *certtool*") + (erase-buffer) + (insert certificate) + (setq exit-code (condition-case () + (call-process-region (point-min) (point-max) + tls-certtool-program + t (list (current-buffer) nil) t + "--certificate-info") + (error -1))) + (if (/= exit-code 0) + nil + (let ((vals nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t) + (push (cons (match-string 1) (match-string 2)) vals)) + (nreverse vals)))))) + (defun open-tls-stream (name buffer host service) "Open a TLS connection for a service to a host. Returns a subprocess-object to represent the connection.
--- a/lisp/net/tramp-smb.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/net/tramp-smb.el Thu Oct 14 08:50:09 2004 +0000 @@ -1087,7 +1087,7 @@ ;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'. ;; Must be corrected. -(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion activate) +(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion) "Changes \"$\" back to \"$$\" in minibuffer." (if (funcall PC-completion-as-file-name-predicate) @@ -1123,6 +1123,13 @@ ;; No file names. Behave unchanged. ad-do-it)) +;; Activate advice. Recent Emacsen don't need that. +(when (functionp 'PC-do-completion) + (condition-case nil + (substitute-in-file-name "C$/") + (error + (ad-activate 'PC-do-completion)))) + (provide 'tramp-smb) ;;; TODO:
--- a/lisp/net/tramp.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/net/tramp.el Thu Oct 14 08:50:09 2004 +0000 @@ -1668,6 +1668,7 @@ my $len = length($pending); my $chunk = substr($pending, 0, $len & ~3); + $pending = substr($pending, $len & ~3 + 1); # Easy method: translate from chars to (pregenerated) six-bit packets, join, # split in 8-bit chunks and convert back to char. @@ -1883,7 +1884,11 @@ (put 'with-parsed-tramp-file-name 'lisp-indent-function 2) ;; To be activated for debugging containing this macro -(def-edebug-spec with-parsed-tramp-file-name t) +;; It works only when VAR is nil. Otherwise, it can be deactivated by +;; (def-edebug-spec with-parsed-tramp-file-name 0) +;; I'm too stupid to write a precise SPEC for it. +(if (functionp 'def-edebug-spec) + (def-edebug-spec with-parsed-tramp-file-name t)) (defmacro tramp-let-maybe (variable value &rest body) "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete. @@ -6731,6 +6736,31 @@ (tramp-make-auto-save-file-name (buffer-file-name))) ad-do-it)) +;; In Emacs < 21.4 and XEmacs < 21.5 autosaved remote files have +;; permission 666 minus umask. This is a security threat. + +(defun tramp-set-auto-save-file-modes () + "Set permissions of autosaved remote files to the original permissions." + (let ((bfn (buffer-file-name))) + (when (and (stringp bfn) + (tramp-tramp-file-p bfn) + (stringp buffer-auto-save-file-name) + (not (equal bfn buffer-auto-save-file-name)) + (not (file-exists-p buffer-auto-save-file-name))) + (write-region "" nil buffer-auto-save-file-name) + (set-file-modes buffer-auto-save-file-name (file-modes bfn))))) + +(unless (or (> emacs-major-version 21) + (and (featurep 'xemacs) + (= emacs-major-version 21) + (> emacs-minor-version 4)) + (and (not (featurep 'xemacs)) + (= emacs-major-version 21) + (or (> emacs-minor-version 3) + (and (string-match "^21\\.3\\.\\([0-9]+\\)" emacs-version) + (>= (string-to-int (match-string 1 emacs-version)) 50))))) + (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)) + (defun tramp-subst-strs-in-string (alist string) "Replace all occurrences of the string FROM with TO in STRING. ALIST is of the form ((FROM . TO) ...)."
--- a/lisp/net/trampver.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/net/trampver.el Thu Oct 14 08:50:09 2004 +0000 @@ -30,7 +30,7 @@ ;; are auto-frobbed from configure.ac, so you should edit that file and run ;; "autoconf && ./configure" to change them. -(defconst tramp-version "2.0.44" +(defconst tramp-version "2.0.45" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
--- a/lisp/pcvs-defs.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/pcvs-defs.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,7 +1,7 @@ ;;; pcvs-defs.el --- variable definitions for PCL-CVS -;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 03, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2003, 2004 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs @@ -249,9 +249,6 @@ :type '(choice (const :tag "Ediff" (cvs-ediff-diff . cvs-ediff-merge)) (const :tag "Emerge" (cvs-emerge-diff . cvs-emerge-merge)))) -(defvar pcl-cvs-load-hook nil - "Run after loading pcl-cvs.") - (defvar cvs-mode-hook nil "Run after `cvs-mode' was setup.") @@ -510,5 +507,5 @@ ;; (provide 'pcvs-defs) -;;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e +;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e ;;; pcvs-defs.el ends here
--- a/lisp/pcvs-parse.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/pcvs-parse.el Thu Oct 14 08:50:09 2004 +0000 @@ -511,15 +511,19 @@ (cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$" (subtype 'COMMITTED) (base-rev 1))) (cvs-or (cvs-match "done$") t) + ;; In cvs-1.12.9 commit messages have been changed and became + ;; ambiguous. More specifically, the `path' above is not given. + ;; We assume here that in future releases the corresponding info will + ;; be put into `file'. (progn ;; Try to remove the temp files used by VC. - (vc-delete-automatic-version-backups (expand-file-name path)) + (vc-delete-automatic-version-backups (expand-file-name (or path file))) ;; it's important here not to rely on the default directory management ;; because `cvs commit' might begin by a series of Examining messages ;; so the processing of the actual checkin messages might begin with ;; a `current-dir' set to something different from "" (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) - (or path file) (if path 'trust) + (or path file) 'trust :base-rev base-rev))) ;; useless message added before the actual addition: ignored
--- a/lisp/progmodes/etags.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/progmodes/etags.el Thu Oct 14 08:50:09 2004 +0000 @@ -1229,10 +1229,10 @@ (defun etags-tags-completion-table () (let ((table (make-vector 511 0)) - (point-max (/ (float (point-max)) 100.0)) - (msg-fmt (format - "Making tags completion table for %s...%%d%%%%" - buffer-file-name))) + (progress-reporter + (make-progress-reporter + (format "Making tags completion table for %s..." buffer-file-name) + (point-min) (point-max)))) (save-excursion (goto-char (point-min)) ;; This monster regexp matches an etags tag line. @@ -1253,7 +1253,7 @@ (buffer-substring (match-beginning 5) (match-end 5)) ;; No explicit tag name. Best guess. (buffer-substring (match-beginning 3) (match-end 3))) - (message msg-fmt (/ (point) point-max))) + (progress-reporter-update progress-reporter (point))) table))) table)) @@ -1433,11 +1433,12 @@ (tags-with-face 'highlight (princ buffer-file-name)) (princ "':\n\n")) (goto-char (point-min)) - (let ((point-max (/ (float (point-max)) 100.0))) + (let ((progress-reporter (make-progress-reporter + (format "Making tags apropos buffer for `%s'..." + string) + (point-min) (point-max)))) (while (re-search-forward string nil t) - (message "Making tags apropos buffer for `%s'...%d%%" - string - (/ (point) point-max)) + (progress-reporter-update progress-reporter (point)) (beginning-of-line) (let* ( ;; Get the local value in the tags table
--- a/lisp/progmodes/gdb-ui.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/progmodes/gdb-ui.el Thu Oct 14 08:50:09 2004 +0000 @@ -188,6 +188,7 @@ (setq gdb-var-changed nil) (setq gdb-first-prompt nil) (setq gdb-prompting nil) + (setq gdb-input-queue nil) (setq gdb-current-item nil) (setq gdb-pending-triggers nil) (setq gdb-output-sink 'user)
--- a/lisp/progmodes/gud.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/progmodes/gud.el Thu Oct 14 08:50:09 2004 +0000 @@ -3027,6 +3027,27 @@ (save-excursion (indent-line-to indent)) (indent-line-to indent))))) +;; Derived from cfengine.el. +(defun gdb-script-beginning-of-defun () + "`beginning-of-defun' function for Gdb script mode. +Treats actions as defuns." + (unless (<= (current-column) (current-indentation)) + (end-of-line)) + (if (re-search-backward "^define \\|^document " nil t) + (beginning-of-line) + (goto-char (point-min))) + t) + +;; Derived from cfengine.el. +(defun gdb-script-end-of-defun () + "`end-of-defun' function for Gdb script mode. +Treats actions as defuns." + (end-of-line) + (if (re-search-forward "^end" nil t) + (beginning-of-line) + (goto-char (point-max))) + t) + ;;;###autoload (add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode)) @@ -3039,6 +3060,10 @@ (set (make-local-variable 'imenu-generic-expression) '((nil "^define[ \t]+\\(\\w+\\)" 1))) (set (make-local-variable 'indent-line-function) 'gdb-script-indent-line) + (set (make-local-variable 'beginning-of-defun-function) + #'gdb-script-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + #'gdb-script-end-of-defun) (set (make-local-variable 'font-lock-defaults) '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil (font-lock-syntactic-keywords
--- a/lisp/recentf.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/recentf.el Thu Oct 14 08:50:09 2004 +0000 @@ -1032,7 +1032,8 @@ (dolist (e recentf-edit-selected-items) (setq recentf-list (delq e recentf-list) i (1+ i))) - (message "%S file(s) removed from the list" i)) + (message "%S file(s) removed from the list" i) + (recentf-clear-data)) (message "No file selected"))) "Ok") (widget-insert " ")
--- a/lisp/server.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/server.el Thu Oct 14 08:50:09 2004 +0000 @@ -343,7 +343,11 @@ (with-temp-buffer (let ((standard-output (current-buffer))) (pp v) - (process-send-region proc (point-min) (point-max)))))) + ;; Suppress the error rose when the pipe to PROC is closed. + (condition-case err + (process-send-region proc (point-min) (point-max)) + (file-error nil)) + )))) ;; ARG is a file name. ;; Collapse multiple slashes to single slashes. (setq arg (command-line-normalize-file-name arg))
--- a/lisp/subr.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/subr.el Thu Oct 14 08:50:09 2004 +0000 @@ -367,15 +367,6 @@ (define-key map (char-to-string loop) 'digit-argument) (setq loop (1+ loop)))))) -;Moved to keymap.c -;(defun copy-keymap (keymap) -; "Return a copy of KEYMAP" -; (while (not (keymapp keymap)) -; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap)))) -; (if (vectorp keymap) -; (copy-sequence keymap) -; (copy-alist keymap))) - (defvar key-substitution-in-progress nil "Used internally by substitute-key-definition.") @@ -383,7 +374,10 @@ "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. In other words, OLDDEF is replaced with NEWDEF where ever it appears. Alternatively, if optional fourth argument OLDMAP is specified, we redefine -in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP." +in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP. + +For most uses, it is simpler and safer to use command remappping like this: + \(define-key KEYMAP [remap OLDDEF] NEWDEF)" ;; Don't document PREFIX in the doc string because we don't want to ;; advertise it. It's meant for recursive calls only. Here's its ;; meaning @@ -393,126 +387,54 @@ ;; original key, with PREFIX added at the front. (or prefix (setq prefix "")) (let* ((scan (or oldmap keymap)) - (vec1 (vector nil)) - (prefix1 (vconcat prefix vec1)) + (prefix1 (vconcat prefix [nil])) (key-substitution-in-progress (cons scan key-substitution-in-progress))) ;; Scan OLDMAP, finding each char or event-symbol that ;; has any definition, and act on it with hack-key. - (while (consp scan) - (if (consp (car scan)) - (let ((char (car (car scan))) - (defn (cdr (car scan)))) - ;; The inside of this let duplicates exactly - ;; the inside of the following let that handles array elements. - (aset vec1 0 char) - (aset prefix1 (length prefix) char) - (let (inner-def skipped) - ;; Skip past menu-prompt. - (while (stringp (car-safe defn)) - (setq skipped (cons (car defn) skipped)) - (setq defn (cdr defn))) - ;; Skip past cached key-equivalence data for menu items. - (and (consp defn) (consp (car defn)) - (setq defn (cdr defn))) - (setq inner-def defn) - ;; Look past a symbol that names a keymap. - (while (and (symbolp inner-def) - (fboundp inner-def)) - (setq inner-def (symbol-function inner-def))) - (if (or (eq defn olddef) - ;; Compare with equal if definition is a key sequence. - ;; That is useful for operating on function-key-map. - (and (or (stringp defn) (vectorp defn)) - (equal defn olddef))) - (define-key keymap prefix1 (nconc (nreverse skipped) newdef)) - (if (and (keymapp defn) - ;; Avoid recursively scanning - ;; where KEYMAP does not have a submap. - (let ((elt (lookup-key keymap prefix1))) - (or (null elt) - (keymapp elt))) - ;; Avoid recursively rescanning keymap being scanned. - (not (memq inner-def - key-substitution-in-progress))) - ;; If this one isn't being scanned already, - ;; scan it now. - (substitute-key-definition olddef newdef keymap - inner-def - prefix1))))) - (if (vectorp (car scan)) - (let* ((array (car scan)) - (len (length array)) - (i 0)) - (while (< i len) - (let ((char i) (defn (aref array i))) - ;; The inside of this let duplicates exactly - ;; the inside of the previous let. - (aset vec1 0 char) - (aset prefix1 (length prefix) char) - (let (inner-def skipped) - ;; Skip past menu-prompt. - (while (stringp (car-safe defn)) - (setq skipped (cons (car defn) skipped)) - (setq defn (cdr defn))) - (and (consp defn) (consp (car defn)) - (setq defn (cdr defn))) - (setq inner-def defn) - (while (and (symbolp inner-def) - (fboundp inner-def)) - (setq inner-def (symbol-function inner-def))) - (if (or (eq defn olddef) - (and (or (stringp defn) (vectorp defn)) - (equal defn olddef))) - (define-key keymap prefix1 - (nconc (nreverse skipped) newdef)) - (if (and (keymapp defn) - (let ((elt (lookup-key keymap prefix1))) - (or (null elt) - (keymapp elt))) - (not (memq inner-def - key-substitution-in-progress))) - (substitute-key-definition olddef newdef keymap - inner-def - prefix1))))) - (setq i (1+ i)))) - (if (char-table-p (car scan)) - (map-char-table - (function (lambda (char defn) - (let () - ;; The inside of this let duplicates exactly - ;; the inside of the previous let, - ;; except that it uses set-char-table-range - ;; instead of define-key. - (aset vec1 0 char) - (aset prefix1 (length prefix) char) - (let (inner-def skipped) - ;; Skip past menu-prompt. - (while (stringp (car-safe defn)) - (setq skipped (cons (car defn) skipped)) - (setq defn (cdr defn))) - (and (consp defn) (consp (car defn)) - (setq defn (cdr defn))) - (setq inner-def defn) - (while (and (symbolp inner-def) - (fboundp inner-def)) - (setq inner-def (symbol-function inner-def))) - (if (or (eq defn olddef) - (and (or (stringp defn) (vectorp defn)) - (equal defn olddef))) - (define-key keymap prefix1 - (nconc (nreverse skipped) newdef)) - (if (and (keymapp defn) - (let ((elt (lookup-key keymap prefix1))) - (or (null elt) - (keymapp elt))) - (not (memq inner-def - key-substitution-in-progress))) - (substitute-key-definition olddef newdef keymap - inner-def - prefix1))))))) - (car scan))))) - (setq scan (cdr scan))))) + (map-keymap + (lambda (char defn) + (aset prefix1 (length prefix) char) + (substitute-key-definition-key defn olddef newdef prefix1 keymap)) + scan))) + +(defun substitute-key-definition-key (defn olddef newdef prefix keymap) + (let (inner-def skipped menu-item) + ;; Find the actual command name within the binding. + (if (eq (car-safe defn) 'menu-item) + (setq menu-item defn defn (nth 2 defn)) + ;; Skip past menu-prompt. + (while (stringp (car-safe defn)) + (push (pop defn) skipped)) + ;; Skip past cached key-equivalence data for menu items. + (if (consp (car-safe defn)) + (setq defn (cdr defn)))) + (if (or (eq defn olddef) + ;; Compare with equal if definition is a key sequence. + ;; That is useful for operating on function-key-map. + (and (or (stringp defn) (vectorp defn)) + (equal defn olddef))) + (define-key keymap prefix + (if menu-item + (let ((copy (copy-sequence menu-item))) + (setcar (nthcdr 2 copy) newdef) + copy) + (nconc (nreverse skipped) newdef))) + ;; Look past a symbol that names a keymap. + (setq inner-def + (condition-case nil (indirect-function defn) (error defn))) + ;; For nested keymaps, we use `inner-def' rather than `defn' so as to + ;; avoid autoloading a keymap. This is mostly done to preserve the + ;; original non-autoloading behavior of pre-map-keymap times. + (if (and (keymapp inner-def) + ;; Avoid recursively scanning + ;; where KEYMAP does not have a submap. + (let ((elt (lookup-key keymap prefix))) + (or (null elt) (natnump elt) (keymapp elt))) + ;; Avoid recursively rescanning keymap being scanned. + (not (memq inner-def key-substitution-in-progress))) + ;; If this one isn't being scanned already, scan it now. + (substitute-key-definition olddef newdef keymap inner-def prefix))))) (defun define-key-after (keymap key definition &optional after) "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. @@ -658,19 +580,19 @@ (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@ ?\H-\^@ ?\s-\^@ ?\A-\^@))))) (if (not (zerop (logand type ?\M-\^@))) - (setq list (cons 'meta list))) + (push 'meta list)) (if (or (not (zerop (logand type ?\C-\^@))) (< char 32)) - (setq list (cons 'control list))) + (push 'control list)) (if (or (not (zerop (logand type ?\S-\^@))) (/= char (downcase char))) - (setq list (cons 'shift list))) + (push 'shift list)) (or (zerop (logand type ?\H-\^@)) - (setq list (cons 'hyper list))) + (push 'hyper list)) (or (zerop (logand type ?\s-\^@)) - (setq list (cons 'super list))) + (push 'super list)) (or (zerop (logand type ?\A-\^@)) - (setq list (cons 'alt list))) + (push 'alt list)) list)))) (defun event-basic-type (event) @@ -688,8 +610,7 @@ (defsubst mouse-movement-p (object) "Return non-nil if OBJECT is a mouse movement event." - (and (consp object) - (eq (car object) 'mouse-movement))) + (eq (car-safe object) 'mouse-movement)) (defsubst event-start (event) "Return the starting position of EVENT. @@ -1880,8 +1801,7 @@ See also `with-temp-file' and `with-output-to-string'." (declare (indent 0) (debug t)) (let ((temp-buffer (make-symbol "temp-buffer"))) - `(let ((,temp-buffer - (get-buffer-create (generate-new-buffer-name " *temp*")))) + `(let ((,temp-buffer (generate-new-buffer " *temp*"))) (unwind-protect (with-current-buffer ,temp-buffer ,@body) @@ -2652,5 +2572,132 @@ (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) +;; Standardized progress reporting + +;; Progress reporter has the following structure: +;; +;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME +;; MIN-VALUE +;; MAX-VALUE +;; MESSAGE +;; MIN-CHANGE +;; MIN-TIME]) +;; +;; This weirdeness is for optimization reasons: we want +;; `progress-reporter-update' to be as fast as possible, so +;; `(car reporter)' is better than `(aref reporter 0)'. +;; +;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple +;; digits of precision, it doesn't really matter here. On the other +;; hand, it greatly simplifies the code. + +(defsubst progress-reporter-update (reporter value) + "Report progress of an operation in the echo area. +However, if the change since last echo area update is too small +or not enough time has passed, then do nothing (see +`make-progress-reporter' for details). + +First parameter, REPORTER, should be the result of a call to +`make-progress-reporter'. Second, VALUE, determines the actual +progress of operation; it must be between MIN-VALUE and MAX-VALUE +as passed to `make-progress-reporter'. + +This function is very inexpensive, you may not bother how often +you call it." + (when (>= value (car reporter)) + (progress-reporter-do-update reporter value))) + +(defun make-progress-reporter (message min-value max-value + &optional current-value + min-change min-time) + "Return progress reporter object usage with `progress-reporter-update'. + +MESSAGE is shown in the echo area. When at least 1% of operation +is complete, the exact percentage will be appended to the +MESSAGE. When you call `progress-reporter-done', word \"done\" +is printed after the MESSAGE. You can change MESSAGE of an +existing progress reporter with `progress-reporter-force-update'. + +MIN-VALUE and MAX-VALUE designate starting (0% complete) and +final (100% complete) states of operation. The latter should be +larger; if this is not the case, then simply negate all values. +Optional CURRENT-VALUE specifies the progress by the moment you +call this function. You should omit it or set it to nil in most +cases since it defaults to MIN-VALUE. + +Optional MIN-CHANGE determines the minimal change in percents to +report (default is 1%.) Optional MIN-TIME specifies the minimal +time before echo area updates (default is 0.2 seconds.) If +`float-time' function is not present, then time is not tracked +at all. If OS is not capable of measuring fractions of seconds, +then this parameter is effectively rounded up." + + (unless min-time + (setq min-time 0.2)) + (let ((reporter + (cons min-value ;; Force a call to `message' now + (vector (if (and (fboundp 'float-time) + (>= min-time 0.02)) + (float-time) nil) + min-value + max-value + message + (if min-change (max (min min-change 50) 1) 1) + min-time)))) + (progress-reporter-update reporter (or current-value min-value)) + reporter)) + +(defun progress-reporter-force-update (reporter value &optional new-message) + "Report progress of an operation in the echo area unconditionally. + +First two parameters are the same as for +`progress-reporter-update'. Optional NEW-MESSAGE allows you to +change the displayed message." + (let ((parameters (cdr reporter))) + (when new-message + (aset parameters 3 new-message)) + (when (aref parameters 0) + (aset parameters 0 (float-time))) + (progress-reporter-do-update reporter value))) + +(defun progress-reporter-do-update (reporter value) + (let* ((parameters (cdr reporter)) + (min-value (aref parameters 1)) + (max-value (aref parameters 2)) + (one-percent (/ (- max-value min-value) 100.0)) + (percentage (truncate (/ (- value min-value) one-percent))) + (update-time (aref parameters 0)) + (current-time (float-time)) + (enough-time-passed + ;; See if enough time has passed since the last update. + (or (not update-time) + (when (>= current-time update-time) + ;; Calculate time for the next update + (aset parameters 0 (+ update-time (aref parameters 5))))))) + ;; + ;; Calculate NEXT-UPDATE-VALUE. If we are not going to print + ;; message this time because not enough time has passed, then use + ;; 1 instead of MIN-CHANGE. This makes delays between echo area + ;; updates closer to MIN-TIME. + (setcar reporter + (min (+ min-value (* (+ percentage + (if enough-time-passed + (aref parameters 4) ;; MIN-CHANGE + 1)) + one-percent)) + max-value)) + (when (integerp value) + (setcar reporter (ceiling (car reporter)))) + ;; + ;; Only print message if enough time has passed + (when enough-time-passed + (if (> percentage 0) + (message "%s%d%%" (aref parameters 3) percentage) + (message "%s" (aref parameters 3)))))) + +(defun progress-reporter-done (reporter) + "Print reporter's message followed by word \"done\" in echo area." + (message "%sdone" (aref (cdr reporter) 3))) + ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc ;;; subr.el ends here
--- a/lisp/tar-mode.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/tar-mode.el Thu Oct 14 08:50:09 2004 +0000 @@ -405,11 +405,12 @@ Place a dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden)." - (message "Parsing tar file...") + (set-buffer-multibyte nil) (let* ((result '()) (pos (point-min)) - (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. - (bs100 (max 1 (/ bs 100))) + (progress-reporter + (make-progress-reporter "Parsing tar file..." + (point-min) (max 1 (- (buffer-size) 1024)))) tokens) (while (and (<= (+ pos 512) (point-max)) (not (eq 'empty-tar-block @@ -417,10 +418,7 @@ (tar-header-block-tokenize (buffer-substring pos (+ pos 512))))))) (setq pos (+ pos 512)) - (message "Parsing tar file...%d%%" - ;(/ (* pos 100) bs) ; this gets round-off lossage - (/ pos bs100) ; this doesn't - ) + (progress-reporter-update progress-reporter pos) (if (eq (tar-header-link-type tokens) 20) ;; Foo. There's an extra empty block after these. (setq pos (+ pos 512))) @@ -447,7 +445,7 @@ ;; A tar file should end with a block or two of nulls, ;; but let's not get a fatal error if it doesn't. (if (eq tokens 'empty-tar-block) - (message "Parsing tar file...done") + (progress-reporter-done progress-reporter) (message "Warning: premature EOF parsing tar file"))) (save-excursion (goto-char (point-min))
--- a/lisp/textmodes/enriched.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/textmodes/enriched.el Thu Oct 14 08:50:09 2004 +0000 @@ -258,8 +258,8 @@ (define-key enriched-mode-map "\M-j" 'facemenu-justification-menu) (define-key enriched-mode-map "\M-S" 'set-justification-center) (define-key enriched-mode-map "\C-x\t" 'increase-left-margin) -(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin) -(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin) +(define-key enriched-mode-map "\C-c[" 'set-left-margin) +(define-key enriched-mode-map "\C-c]" 'set-right-margin) ;;; ;;; Some functions dealing with text-properties, especially indentation
--- a/lisp/textmodes/paragraphs.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/textmodes/paragraphs.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,6 +1,6 @@ ;;; paragraphs.el --- paragraph and sentence parsing -;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001 +;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001, 2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -122,8 +122,8 @@ and `colon-double-space'. This value is used by the function `sentence-end' to construct the -regexp describing the end of a sentence, in case when the value of -the variable `sentence-end' is nil. See Info node `Sentences'." +regexp describing the end of a sentence, when the value of the variable +`sentence-end' is nil. See Info node `(elisp)Standard Regexps'." :type 'boolean :group 'fill) @@ -133,18 +133,18 @@ without a period. This value is used by the function `sentence-end' to construct the -regexp describing the end of a sentence, in case when the value of -the variable `sentence-end' is nil. See Info node `Sentences'." +regexp describing the end of a sentence, when the value of the variable +`sentence-end' is nil. See Info node `(elisp)Standard Regexps'." :type 'boolean :group 'fill) (defcustom sentence-end-without-space "$B!#!%!)!*$A!##.#?#!$(0!$!%!)!*$(G!$!%!)!*(B" - "*String containing characters that end sentence without following spaces. + "*String of characters that end sentence without following spaces. This value is used by the function `sentence-end' to construct the -regexp describing the end of a sentence, in case when the value of -the variable `sentence-end' is nil. See Info node `Sentences'." +regexp describing the end of a sentence, when the value of the variable +`sentence-end' is nil. See Info node `(elisp)Standard Regexps'." :group 'paragraphs :type 'string) @@ -169,7 +169,7 @@ that in order to be recognized as the end of a sentence, the ending period, question mark, or exclamation point must be followed by two spaces, unless it's inside some sort of quotes or -parenthesis. See Info node `Sentences'." +parenthesis. See Info node `(elisp)Standard Regexps'." (or sentence-end (concat (if sentence-end-without-period "\\w \\|") "\\([.?!][]\"'\xd0c9\x5397d)}]*"
--- a/lisp/textmodes/tex-mode.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/textmodes/tex-mode.el Thu Oct 14 08:50:09 2004 +0000 @@ -500,6 +500,11 @@ 1 font-lock-function-name-face)))) "Subdued expressions to highlight in TeX modes.") +(defun tex-font-lock-append-prop (prop) + (unless (memq (get-text-property (match-end 1) 'face) + '(font-lock-comment-face tex-verbatim-face)) + prop)) + (defconst tex-font-lock-keywords-2 (append tex-font-lock-keywords-1 (eval-when-compile @@ -553,16 +558,19 @@ ;; ;; Font environments. It seems a bit dubious to use `bold' etc. faces ;; since we might not be able to display those fonts. - (list (concat slash bold " *" arg) 2 '(quote bold) 'append) - (list (concat slash italic " *" arg) 2 '(quote italic) 'append) + (list (concat slash bold " *" arg) 2 + '(tex-font-lock-append-prop 'bold) 'append) + (list (concat slash italic " *" arg) 2 + '(tex-font-lock-append-prop 'italic) 'append) ;; (list (concat slash type arg) 2 '(quote bold-italic) 'append) ;; ;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for tables. (list (concat "\\\\\\(em\\|it\\|sl\\)\\>" args) - 2 '(quote italic) 'append) + 2 '(tex-font-lock-append-prop 'italic) 'append) ;; This is separate from the previous one because of cases like ;; {\em foo {\bf bar} bla} where both match. - (list (concat "\\\\bf\\>" args) 1 '(quote bold) 'append))))) + (list (concat "\\\\\\(bf\\)\\>" args) + 2 '(tex-font-lock-append-prop 'bold) 'append))))) "Gaudy expressions to highlight in TeX modes.") (defun tex-font-lock-suscript (pos) @@ -604,11 +612,14 @@ (defvar tex-font-lock-syntactic-keywords (let ((verbs (regexp-opt tex-verbatim-environments t))) `((,(concat "^\\\\begin *{" verbs "}.*\\(\n\\)") 2 "|") - (,(concat "^\\\\end *{" verbs "}\\(.?\\)") 2 - (unless (<= (match-beginning 0) (point-min)) - (put-text-property (1- (match-beginning 0)) (match-beginning 0) - 'syntax-table (string-to-syntax "|")) - "<")) + ;; Technically, we'd like to put the "|" property on the \n preceding + ;; the \end, but this would have 2 disadvantages: + ;; 1 - it's wrong if the verbatim env is empty (the same \n is used to + ;; start and end the fenced-string). + ;; 2 - font-lock considers the preceding \n as being part of the + ;; preceding line, so things gets screwed every time the previous + ;; line is re-font-locked on its own. + (,(concat "^\\(\\\\\\)end *{" verbs "}\\(.?\\)") (1 "|") (3 "<")) ;; ("^\\(\\\\\\)begin *{comment}" 1 "< b") ;; ("^\\\\end *{comment}.*\\(\n\\)" 1 "> b") ("\\\\verb\\**\\([^a-z@*]\\)" 1 "\""))))
--- a/lisp/url/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/url/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,64 @@ +2004-10-12 Simon Josefsson <jas@extundo.com> + + * url-vars.el (url-gateway-method): Add new method `tls'. + + * url-news.el (url-snews): Use nntp-open-tls-stream if + url-gateway-method is tls. + + * url-ldap.el (url-ldap-certificate-formatter): Use + tls-certificate-information if ssl.el is not available. + + * url-https.el (url-https-create-secure-wrapper): Use tls if ssl + is not available. + + * url-gw.el (url-open-stream): Support tls url-gateway-method. + (url-open-stream): Likewise. + +2004-10-10 Lars Hansen <larsh@math.ku.dk> + + * url-auth.el: Fix copyright notice. + + * url-cache.el: Fix copyright notice. + + * url-cookie.el: Fix copyright notice. + + * url-dired.el: Fix copyright notice. + + * url-file.el: Fix copyright notice. + + * url-ftp.el: Fix copyright notice. + + * url-handlers.el: Fix copyright notice. + + * url-history.el: Fix copyright notice. + + * url-irc.el: Fix copyright notice. + + * url-mailto.el: Fix copyright notice. + + * url-methods.el: Fix copyright notice. + + * url-misc.el: Fix copyright notice. + + * url-news.el: Fix copyright notice. + + * url-nfs.el: Fix copyright notice. + + * url-parse.el: Fix copyright notice. + + * url-privacy.el: Fix copyright notice. + + * url-vars.el: Fix copyright notice. + + * url.el: Fix copyright notice. + + * url-util.el: Fix copyright notice. + +2004-10-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-handlers.el (url-insert-file-contents): Use the URL to decide the + encoding, not the buffer-file-name (which might not even exist). + 2004-09-20 Stefan Monnier <monnier@iro.umontreal.ca> * url-handlers.el (url-insert-file-contents): Decode contents.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-auth.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,316 @@ +;;; url-auth.el --- Uniform Resource Locator authorization modules +;; Keywords: comm, data, processes, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 - 1999 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 'url-vars) +(require 'url-parse) +(autoload 'url-warn "url") + +(defsubst url-auth-user-prompt (url realm) + "String to usefully prompt for a username." + (concat "Username [for " + (or realm (url-truncate-url-for-viewing + (url-recreate-url url) + (- (window-width) 10 20))) + "]: ")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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 'url-http-real-basic-auth-storage + "Where usernames and passwords are stored. + +Must be a symbol pointing to another variable that will actually store +the information. The value of this variable is an assoc list of assoc +lists. The first assoc list is keyed by the server name. The cdr of +this is an assoc list based on the 'directory' specified by the url we +are looking up.") + +(defun url-basic-auth (url &optional prompt overwrite realm args) + "Get the username/password for the specified URL. +If optional argument PROMPT is non-nil, ask for the username/password +to use for the url and its descendants. If optional third argument +OVERWRITE is non-nil, overwrite the old username/password pair if it +is found in the assoc list. If REALM is specified, use that as the realm +instead of the pathname inheritance method." + (let* ((href (if (stringp url) + (url-generic-parse-url url) + url)) + (server (url-host href)) + (port (url-port href)) + (path (url-filename href)) + user pass byserv retval data) + (setq server (format "%s:%d" server port) + path (cond + (realm realm) + ((string-match "/$" path) path) + (t (url-basepath path))) + byserv (cdr-safe (assoc server + (symbol-value url-basic-auth-storage)))) + (cond + ((and prompt (not byserv)) + (setq user (read-string (url-auth-user-prompt url realm) + (user-real-login-name)) + pass (funcall url-passwd-entry-func "Password: ")) + (set url-basic-auth-storage + (cons (list server + (cons path + (setq retval + (base64-encode-string + (format "%s:%s" user pass))))) + (symbol-value 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 (url-auth-user-prompt url realm) + (user-real-login-name)) + pass (funcall url-passwd-entry-func "Password: ") + retval (base64-encode-string (format "%s:%s" user pass)) + byserv (assoc server (symbol-value url-basic-auth-storage))) + (setcdr byserv + (cons (cons path retval) (cdr byserv)))))) + (t (setq retval nil))) + (if retval (setq retval (concat "Basic " retval))) + retval)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Digest authorization code +;;; ------------------------ +;;; This implements the DIGEST authorization type. See the internet draft +;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt +;;; for the complete documentation on this type. +;;; +;;; This is very secure +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar url-digest-auth-storage nil + "Where usernames and passwords are stored. Its value is an assoc list of +assoc lists. The first assoc list is keyed by the server name. The cdr of +this is an assoc list based on the 'directory' specified by the url we are +looking up.") + +(defun url-digest-auth-create-key (username password realm method uri) + "Create a key for digest authentication method" + (let* ((info (if (stringp uri) + (url-generic-parse-url uri) + uri)) + (a1 (md5 (concat username ":" realm ":" password))) + (a2 (md5 (concat method ":" (url-filename info))))) + (list a1 a2))) + +(defun url-digest-auth (url &optional prompt overwrite realm args) + "Get the username/password for the specified URL. +If optional argument PROMPT is non-nil, ask for the username/password +to use for the url and its descendants. If optional third argument +OVERWRITE is non-nil, overwrite the old username/password pair if it +is found in the assoc list. If REALM is specified, use that as the realm +instead of hostname:portnum." + (if args + (let* ((href (if (stringp url) + (url-generic-parse-url url) + url)) + (server (url-host href)) + (port (url-port href)) + (path (url-filename href)) + user pass byserv retval data) + (setq path (cond + (realm realm) + ((string-match "/$" path) path) + (t (url-basepath path))) + server (format "%s:%d" server port) + byserv (cdr-safe (assoc server url-digest-auth-storage))) + (cond + ((and prompt (not byserv)) + (setq user (read-string (url-auth-user-prompt url realm) + (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 (url-auth-user-prompt url realm) + (user-real-login-name)) + pass (funcall url-passwd-entry-func "Password: ") + retval (setq retval + (cons user + (url-digest-auth-create-key + user pass realm + (or url-request-method "GET") + url))) + byserv (assoc server url-digest-auth-storage)) + (setcdr byserv + (cons (cons path retval) (cdr byserv)))))) + (t (setq retval nil))) + (if retval + (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) + (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven"))) + (format + (concat "Digest username=\"%s\", realm=\"%s\"," + "nonce=\"%s\", uri=\"%s\"," + "response=\"%s\", opaque=\"%s\"") + (nth 0 retval) realm nonce (url-filename href) + (md5 (concat (nth 1 retval) ":" nonce ":" + (nth 2 retval))) opaque)))))) + +(defvar url-registered-auth-schemes nil + "A list of the registered authorization schemes and various and sundry +information associated with them.") + +;;;###autoload +(defun url-get-authentication (url realm type prompt &optional args) + "Return an authorization string suitable for use in the WWW-Authenticate +header in an HTTP/1.0 request. + +URL is the url you are requesting authorization to. This can be either a + string representing the URL, or the parsed representation returned by + `url-generic-parse-url' +REALM is the realm at a specific site we are looking for. This should be a + string specifying the exact realm, or nil or the symbol 'any' to + specify that the filename portion of the URL should be used as the + realm +TYPE is the type of authentication to be returned. This is either a string + representing the type (basic, digest, etc), or nil or the symbol 'any' + to specify that any authentication is acceptable. If requesting 'any' + the strongest matching authentication will be returned. If this is + wrong, its no big deal, the error from the server will specify exactly + what type of auth to use +PROMPT is boolean - specifies whether to ask the user for a username/password + if one cannot be found in the cache" + (if (not realm) + (setq realm (cdr-safe (assoc "realm" args)))) + (if (stringp url) + (setq url (url-generic-parse-url url))) + (if (or (null type) (eq type 'any)) + ;; Whooo doogies! + ;; Go through and get _all_ the authorization strings that could apply + ;; to this URL, store them along with the 'rating' we have in the list + ;; of schemes, then sort them so that the 'best' is at the front of the + ;; list, then get the car, then get the cdr. + ;; Zooom zooom zoooooom + (cdr-safe + (car-safe + (sort + (mapcar + (function + (lambda (scheme) + (if (fboundp (car (cdr scheme))) + (cons (cdr (cdr scheme)) + (funcall (car (cdr scheme)) url nil nil realm)) + (cons 0 nil)))) + url-registered-auth-schemes) + (function + (lambda (x y) + (cond + ((null (cdr x)) nil) + ((and (cdr x) (null (cdr y))) t) + ((and (cdr x) (cdr y)) + (>= (car x) (car y))) + (t nil))))))) + (if (symbolp type) (setq type (symbol-name type))) + (let* ((scheme (car-safe + (cdr-safe (assoc (downcase type) + url-registered-auth-schemes))))) + (if (and scheme (fboundp scheme)) + (funcall scheme url prompt + (and prompt + (funcall scheme url nil nil realm args)) + realm args))))) + +;;;###autoload +(defun url-register-auth-scheme (type &optional function rating) + "Register an HTTP authentication method. + +TYPE is a string or symbol specifying the name of the method. This + should be the same thing you expect to get returned in an Authenticate + header in HTTP/1.0 - it will be downcased. +FUNCTION is the function to call to get the authorization information. This + defaults to `url-?-auth', where ? is TYPE +RATING a rating between 1 and 10 of the strength of the authentication. + This is used when asking for the best authentication for a specific + URL. The item with the highest rating is returned." + (let* ((type (cond + ((stringp type) (downcase type)) + ((symbolp type) (downcase (symbol-name type))) + (t (error "Bad call to `url-register-auth-scheme'")))) + (function (or function (intern (concat "url-" type "-auth")))) + (rating (cond + ((null rating) 2) + ((stringp rating) (string-to-int rating)) + (t rating))) + (node (assoc type url-registered-auth-schemes))) + (if (not (fboundp function)) + (url-warn 'security + (format (concat + "Tried to register `%s' as an auth scheme" + ", but it is not a function!") function))) + + (if node + (setcdr node (cons function rating)) + (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 'url-auth) + +;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-cache.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,202 @@ +;;; url-cache.el --- Uniform Resource Locator retrieval tool +;; Keywords: comm, data, processes, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 - 1999 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 'url-parse) +(require 'url-util) + +(defcustom url-cache-directory + (expand-file-name "cache" url-configuration-directory) + "*The directory where cache files should be stored." + :type 'directory + :group 'url-file) + +;; Cache manager +(defun url-cache-file-writable-p (file) + "Follows the documentation of `file-writable-p', unlike `file-writable-p'." + (and (file-writable-p file) + (if (file-exists-p file) + (not (file-directory-p file)) + (file-directory-p (file-name-directory file))))) + +(defun url-cache-prepare (file) + "Makes it possible to cache data in FILE. +Creates any necessary parent directories, deleting any non-directory files +that would stop this. Returns nil if parent directories can not be +created. If FILE already exists as a non-directory, it changes +permissions of FILE or deletes FILE to make it possible to write a new +version of FILE. Returns nil if this can not be done. Returns nil if +FILE already exists as a directory. Otherwise, returns t, indicating that +FILE can be created or overwritten." + (cond + ((url-cache-file-writable-p file) + t) + ((file-directory-p file) + nil) + (t + (condition-case () + (or (make-directory (file-name-directory file) t) t) + (error nil))))) + +;;;###autoload +(defun url-store-in-cache (&optional buff) + "Store buffer BUFF in the cache." + (if (not (and buff (get-buffer buff))) + nil + (save-excursion + (and buff (set-buffer buff)) + (let* ((fname (url-cache-create-filename (url-view-url t)))) + (if (url-cache-prepare fname) + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) fname nil 5))))))) + +;;;###autoload +(defun url-is-cached (url) + "Return non-nil if the URL is cached." + (let* ((fname (url-cache-create-filename url)) + (attribs (file-attributes fname))) + (and fname ; got a filename + (file-exists-p fname) ; file exists + (not (eq (nth 0 attribs) t)) ; Its not a directory + (nth 5 attribs)))) ; Can get last mod-time + +(defun url-cache-create-filename-human-readable (url) + "Return a filename in the local cache for URL" + (if url + (let* ((url (if (vectorp url) (url-recreate-url url) url)) + (urlobj (url-generic-parse-url url)) + (protocol (url-type urlobj)) + (hostname (url-host urlobj)) + (host-components + (cons + (user-real-login-name) + (cons (or protocol "file") + (reverse (split-string (or hostname "localhost") + (eval-when-compile + (regexp-quote "."))))))) + (fname (url-filename urlobj))) + (if (and fname (/= (length fname) 0) (= (aref fname 0) ?/)) + (setq fname (substring fname 1 nil))) + (if fname + (let ((slash nil)) + (setq fname + (mapconcat + (function + (lambda (x) + (cond + ((and (= ?/ x) slash) + (setq slash nil) + "%2F") + ((= ?/ x) + (setq slash t) + "/") + (t + (setq slash nil) + (char-to-string x))))) fname "")))) + + (setq fname (and fname + (mapconcat + (function (lambda (x) + (if (= x ?~) "" (char-to-string x)))) + fname "")) + fname (cond + ((null fname) nil) + ((or (string= "" fname) (string= "/" fname)) + url-directory-index-file) + ((= (string-to-char fname) ?/) + (if (string= (substring fname -1 nil) "/") + (concat fname url-directory-index-file) + (substring fname 1 nil))) + (t + (if (string= (substring fname -1 nil) "/") + (concat fname url-directory-index-file) + fname)))) + (and fname + (expand-file-name fname + (expand-file-name + (mapconcat 'identity host-components "/") + url-cache-directory)))))) + +(defun url-cache-create-filename-using-md5 (url) + "Create a cached filename using MD5. +Very fast if you have an `md5' primitive function, suitably fast otherwise." + (require 'md5) + (if url + (let* ((url (if (vectorp url) (url-recreate-url url) url)) + (checksum (md5 url)) + (urlobj (url-generic-parse-url url)) + (protocol (url-type urlobj)) + (hostname (url-host urlobj)) + (host-components + (cons + (user-real-login-name) + (cons (or protocol "file") + (nreverse + (delq nil + (split-string (or hostname "localhost") + (eval-when-compile + (regexp-quote ".")))))))) + (fname (url-filename urlobj))) + (and fname + (expand-file-name checksum + (expand-file-name + (mapconcat 'identity host-components "/") + url-cache-directory)))))) + +(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5 + "*What function to use to create a cached filename." + :type '(choice (const :tag "MD5 of filename (low collision rate)" + :value url-cache-create-filename-using-md5) + (const :tag "Human readable filenames (higher collision rate)" + :value url-cache-create-filename-human-readable) + (function :tag "Other")) + :group 'url-cache) + +(defun url-cache-create-filename (url) + (funcall url-cache-creation-function url)) + +;;;###autoload +(defun url-cache-extract (fnam) + "Extract FNAM from the local disk cache" + (erase-buffer) + (insert-file-contents-literally fnam)) + +;;;###autoload +(defun url-cache-expired (url mod) + "Return t iff a cached file has expired." + (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url))) + (type (url-type urlobj))) + (cond + (url-standalone-mode + (not (file-exists-p (url-cache-create-filename url)))) + ((string= type "http") + t) + ((member type '("file" "ftp")) + (if (or (equal mod '(0 0)) (not mod)) + t + (or (> (nth 0 mod) (nth 0 (current-time))) + (> (nth 1 mod) (nth 1 (current-time)))))) + (t nil)))) + +(provide 'url-cache) + +;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-cookie.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,466 @@ +;;; url-cookie.el --- Netscape Cookie support + +;; Copyright (c) 1996 - 1999,2004 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes, hypermedia + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(require 'timezone) +(require 'url-util) +(require 'url-parse) +(eval-when-compile (require 'cl)) + +;; See http://home.netscape.com/newsref/std/cookie_spec.html for the +;; 'open standard' defining this crap. +;; +;; A cookie is stored internally as a vector of 7 slots +;; [ 'cookie name value expires path domain secure ] + +(defsubst url-cookie-name (cookie) (aref cookie 1)) +(defsubst url-cookie-value (cookie) (aref cookie 2)) +(defsubst url-cookie-expires (cookie) (aref cookie 3)) +(defsubst url-cookie-path (cookie) (aref cookie 4)) +(defsubst url-cookie-domain (cookie) (aref cookie 5)) +(defsubst url-cookie-secure (cookie) (aref cookie 6)) + +(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val)) +(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val)) +(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val)) +(defsubst url-cookie-set-path (cookie val) (aset cookie 4 val)) +(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val)) +(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val)) +(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args))) + +(defsubst url-cookie-create (&rest args) + (let ((retval (make-vector 7 nil))) + (aset retval 0 'cookie) + (url-cookie-set-name retval (url-cookie-retrieve-arg :name args)) + (url-cookie-set-value retval (url-cookie-retrieve-arg :value args)) + (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args)) + (url-cookie-set-path retval (url-cookie-retrieve-arg :path args)) + (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args)) + (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args)) + retval)) + +(defun url-cookie-p (obj) + (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie))) + +(defgroup url-cookie nil + "URL cookies" + :prefix "url-" + :prefix "url-cookie-" + :group 'url) + +(defvar url-cookie-storage nil "Where cookies are stored.") +(defvar url-cookie-secure-storage nil "Where secure cookies are stored.") +(defcustom url-cookie-file nil "*Where cookies are stored on disk." + :type '(choice (const :tag "Default" :value nil) file) + :group 'url-file + :group 'url-cookie) + +(defcustom url-cookie-confirmation nil + "*If non-nil, confirmation by the user is required to accept HTTP cookies." + :type 'boolean + :group 'url-cookie) + +(defcustom url-cookie-multiple-line nil + "*If nil, HTTP requests put all cookies for the server on one line. +Some web servers, such as http://www.hotmail.com/, only accept cookies +when they are on one line. This is broken behaviour, but just try +telling Microsoft that.") + +(defvar url-cookies-changed-since-last-save nil + "Whether the cookies list has changed since the last save operation.") + +;;;###autoload +(defun url-cookie-parse-file (&optional fname) + (setq fname (or fname url-cookie-file)) + (condition-case () + (load fname nil t) + (error (message "Could not load cookie file %s" fname)))) + +(defun url-cookie-clean-up (&optional secure) + (let* ( + (var (if secure 'url-cookie-secure-storage 'url-cookie-storage)) + (val (symbol-value var)) + (cur nil) + (new nil) + (cookies nil) + (cur-cookie nil) + (new-cookies nil) + ) + (while val + (setq cur (car val) + val (cdr val) + new-cookies nil + cookies (cdr cur)) + (while cookies + (setq cur-cookie (car cookies) + cookies (cdr cookies)) + (if (or (not (url-cookie-p cur-cookie)) + (url-cookie-expired-p cur-cookie) + (null (url-cookie-expires cur-cookie))) + nil + (setq new-cookies (cons cur-cookie new-cookies)))) + (if (not new-cookies) + nil + (setcdr cur new-cookies) + (setq new (cons cur new)))) + (set var new))) + +;;;###autoload +(defun url-cookie-write-file (&optional fname) + (setq fname (or fname url-cookie-file)) + (cond + ((not url-cookies-changed-since-last-save) nil) + ((not (file-writable-p fname)) + (message "Cookies file %s (see variable `url-cookie-file') is unwritable." fname)) + (t + (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) + "Store a netscape-style cookie." + (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage)) + (tmp storage) + (cur nil) + (found-domain nil)) + + ;; First, look for a matching domain + (setq found-domain (assoc domain storage)) + + (if found-domain + ;; Need to either stick the new cookie in existing domain storage + ;; or possibly replace an existing cookie if the names match. + (progn + (setq storage (cdr found-domain) + tmp nil) + (while storage + (setq cur (car storage) + storage (cdr storage)) + (if (and (equal path (url-cookie-path cur)) + (equal name (url-cookie-name cur))) + (progn + (url-cookie-set-expires cur expires) + (url-cookie-set-value cur value) + (setq tmp t)))) + (if (not tmp) + ;; New cookie + (setcdr found-domain (cons + (url-cookie-create :name name + :value value + :expires expires + :domain domain + :path path + :secure secure) + (cdr found-domain))))) + ;; Need to add a new top-level domain + (setq tmp (url-cookie-create :name name + :value value + :expires expires + :domain domain + :path path + :secure secure)) + (cond + (storage + (setcdr storage (cons (list domain tmp) (cdr storage)))) + (secure + (setq url-cookie-secure-storage (list (list domain tmp)))) + (t + (setq url-cookie-storage (list (list domain tmp)))))))) + +(defun url-cookie-expired-p (cookie) + (let* ( + (exp (url-cookie-expires cookie)) + (cur-date (and exp (timezone-parse-date (current-time-string)))) + (exp-date (and exp (timezone-parse-date exp))) + (cur-greg (and cur-date (timezone-absolute-from-gregorian + (string-to-int (aref cur-date 1)) + (string-to-int (aref cur-date 2)) + (string-to-int (aref cur-date 0))))) + (exp-greg (and exp (timezone-absolute-from-gregorian + (string-to-int (aref exp-date 1)) + (string-to-int (aref exp-date 2)) + (string-to-int (aref exp-date 0))))) + (diff-in-days (and exp (- cur-greg exp-greg))) + ) + (cond + ((not exp) nil) ; No expiry == expires at browser quit + ((< diff-in-days 0) nil) ; Expires sometime after today + ((> diff-in-days 0) t) ; Expired before today + (t ; Expires sometime today, check times + (let* ((cur-time (timezone-parse-time (aref cur-date 3))) + (exp-time (timezone-parse-time (aref exp-date 3))) + (cur-norm (+ (* 360 (string-to-int (aref cur-time 2))) + (* 60 (string-to-int (aref cur-time 1))) + (* 1 (string-to-int (aref cur-time 0))))) + (exp-norm (+ (* 360 (string-to-int (aref exp-time 2))) + (* 60 (string-to-int (aref exp-time 1))) + (* 1 (string-to-int (aref exp-time 0)))))) + (> (- cur-norm exp-norm) 1)))))) + +;;;###autoload +(defun url-cookie-retrieve (host path &optional secure) + "Retrieve all the netscape-style cookies for a specified HOST and PATH." + (let ((storage (if secure + (append url-cookie-secure-storage url-cookie-storage) + url-cookie-storage)) + (case-fold-search t) + (cookies nil) + (cur nil) + (retval nil) + (path-regexp nil)) + (while storage + (setq cur (car storage) + storage (cdr storage) + cookies (cdr cur)) + (if (and (car cur) + (string-match (concat "^.*" (regexp-quote (car cur)) "$") host)) + ;; The domains match - a possible hit! + (while cookies + (setq cur (car cookies) + cookies (cdr cookies) + path-regexp (concat "^" (regexp-quote + (url-cookie-path cur)))) + (if (and (string-match path-regexp path) + (not (url-cookie-expired-p cur))) + (setq retval (cons cur retval)))))) + retval)) + +;;;###autolaod +(defun url-cookie-generate-header-lines (host path secure) + (let* ((cookies (url-cookie-retrieve host path secure)) + (retval nil) + (cur nil) + (chunk nil)) + ;; Have to sort this for sending most specific cookies first + (setq cookies (and cookies + (sort cookies + (function + (lambda (x y) + (> (length (url-cookie-path x)) + (length (url-cookie-path y)))))))) + (while cookies + (setq cur (car cookies) + cookies (cdr cookies) + chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur)) + retval (if (and url-cookie-multiple-line + (< 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 regexp of top level domains that only require two matching +'.'s in the domain name in order to set a cookie.") + +(defcustom url-cookie-trusted-urls nil + "*A list of regular expressions matching URLs to always accept cookies from." + :type '(repeat regexp) + :group 'url-cookie) + +(defcustom url-cookie-untrusted-urls nil + "*A list of regular expressions matching URLs to never accept cookies from." + :type '(repeat regexp) + :group 'url-cookie) + +(defun url-cookie-host-can-set-p (host domain) + (let ((numdots 0) + (tmp domain) + (last nil) + (case-fold-search t) + (mindots 3)) + (while (setq last (string-match "\\." domain 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) ; We have enough dots in domain name + ;; Need to check and make sure the host is actually _in_ the + ;; domain it wants to set a cookie for though. + (string-match (concat (regexp-quote domain) "$") host)) + (t + nil)))) + +;;;###autoload +(defun url-cookie-handle-set-cookie (str) + (setq url-cookies-changed-since-last-save t) + (let* ((args (url-parse-args str t)) + (case-fold-search t) + (secure (and (assoc-string "secure" args t) t)) + (domain (or (cdr-safe (assoc-string "domain" args t)) + (url-host url-current-object))) + (current-url (url-view-url t)) + (trusted url-cookie-trusted-urls) + (untrusted url-cookie-untrusted-urls) + (expires (cdr-safe (assoc-string "expires" args t))) + (path (or (cdr-safe (assoc-string "path" args t)) + (file-name-directory + (url-filename url-current-object)))) + (rest nil)) + (while args + (if (not (member (downcase (car (car args))) + '("secure" "domain" "expires" "path"))) + (setq rest (cons (car args) rest))) + (setq args (cdr args))) + + ;; Sometimes we get dates that the timezone package cannot handle very + ;; gracefully - take care of this here, instead of in url-cookie-expired-p + ;; to speed things up. + (if (and expires + (string-match + (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +" + "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$") + expires)) + (setq expires (concat (match-string 1 expires) " " + (match-string 2 expires) " " + (match-string 3 expires) " " + (match-string 4 expires) " [" + (match-string 5 expires) "]"))) + + ;; This one is for older Emacs/XEmacs variants that don't + ;; understand this format without tenths of a second in it. + ;; Wednesday, 30-Dec-2037 16:00:00 GMT + ;; - vs - + ;; Wednesday, 30-Dec-2037 16:00:00.00 GMT + (if (and expires + (string-match + "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)" + expires)) + (setq expires (concat (match-string 1 expires) "-" ; day + (match-string 2 expires) "-" ; month + (match-string 3 expires) " " ; year + (match-string 4 expires) ".00 " ; hour:minutes:seconds + (match-string 6 expires)))) ":" ; timezone + + (while (consp trusted) + (if (string-match (car trusted) current-url) + (setq trusted (- (match-end 0) (match-beginning 0))) + (pop trusted))) + (while (consp untrusted) + (if (string-match (car untrusted) current-url) + (setq untrusted (- (match-end 0) (match-beginning 0))) + (pop untrusted))) + (if (and trusted untrusted) + ;; Choose the more specific match + (if (> trusted untrusted) + (setq untrusted nil) + (setq trusted nil))) + (cond + (untrusted + ;; The site was explicity marked as untrusted by the user + nil) + ((or (eq url-privacy-level 'paranoid) + (and (listp url-privacy-level) (memq 'cookies url-privacy-level))) + ;; user never wants cookies + nil) + ((and url-cookie-confirmation + (not trusted) + (save-window-excursion + (with-output-to-temp-buffer "*Cookie Warning*" + (mapcar + (function + (lambda (x) + (princ (format "%s - %s" (car x) (cdr x))))) rest)) + (prog1 + (not (funcall url-confirmation-func + (format "Allow %s to set these cookies? " + (url-host url-current-object)))) + (if (get-buffer "*Cookie Warning*") + (kill-buffer "*Cookie Warning*"))))) + ;; user wants to be asked, and declined. + nil) + ((url-cookie-host-can-set-p (url-host url-current-object) domain) + ;; Cookie is accepted by the user, and passes our security checks + (let ((cur nil)) + (while rest + (setq cur (pop rest)) + (url-cookie-store (car cur) (cdr cur) + expires domain path secure)))) + (t + (message "%s tried to set a cookie for domain %s - rejected." + (url-host url-current-object) domain))))) + +(defvar url-cookie-timer nil) + +(defcustom url-cookie-save-interval 3600 + "*The number of seconds between automatic saves of cookies. +Default is 1 hour. Note that if you change this variable outside of +the `customize' interface after `url-do-setup' has been run, you need +to run the `url-cookie-setup-save-timer' function manually." + :set (function (lambda (var val) + (set-default var val) + (and (featurep 'url) + (fboundp 'url-cookie-setup-save-timer) + (url-cookie-setup-save-timer)))) + :type 'integer + :group 'url) + +;;;###autoload +(defun url-cookie-setup-save-timer () + "Reset the cookie saver timer." + (interactive) + (ignore-errors + (cond ((fboundp 'cancel-timer) (cancel-timer url-cookie-timer)) + ((fboundp 'delete-itimer) (delete-itimer url-cookie-timer)))) + (setq url-cookie-timer nil) + (if url-cookie-save-interval + (setq url-cookie-timer + (cond + ((fboundp 'run-at-time) + (run-at-time url-cookie-save-interval + url-cookie-save-interval + 'url-cookie-write-file)) + ((fboundp 'start-itimer) + (start-itimer "url-cookie-saver" 'url-cookie-write-file + url-cookie-save-interval + url-cookie-save-interval)))))) + +(provide 'url-cookie) + +;; arch-tag: 2568751b-6452-4398-aa2d-303edadb54d7 +;;; url-cookie.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-dired.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,100 @@ +;;; url-dired.el --- URL Dired minor mode +;; Keywords: comm, files + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 - 1999 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(autoload 'w3-fetch "w3") +(autoload 'w3-open-local "w3") +(autoload 'dired-get-filename "dired") + +(defvar url-dired-minor-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-m" 'url-dired-find-file) + (if (featurep 'xemacs) + (define-key map [button2] 'url-dired-find-file-mouse) + (define-key map [mouse-2] 'url-dired-find-file-mouse)) + map) + "Keymap used when browsing directories.") + +(defvar url-dired-minor-mode nil + "Whether we are in url-dired-minor-mode") + +(make-variable-buffer-local 'url-dired-minor-mode) + +(defun url-dired-find-file () + "In dired, visit the file or directory named on this line, using Emacs-W3." + (interactive) + (let ((filename (dired-get-filename))) + (cond ((string-match "/\\(.*@.*\\):\\(/.*\\)" filename) + (w3-fetch (concat "file://" (match-string 1 filename) (match-string 2 filename)))) + (t + (w3-open-local filename))))) + +(defun url-dired-find-file-mouse (event) + "In dired, visit the file or directory name you click on, using Emacs-W3." + (interactive "@e") + (mouse-set-point event) + (url-dired-find-file)) + +(defun url-dired-minor-mode (&optional arg) + "Minor mode for directory browsing with Emacs-W3." + (interactive "P") + (cond + ((null arg) + (setq url-dired-minor-mode (not url-dired-minor-mode))) + ((equal 0 arg) + (setq url-dired-minor-mode nil)) + (t + (setq url-dired-minor-mode t)))) + +(if (not (fboundp 'add-minor-mode)) + (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))))) + +(add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map) + +(defun url-find-file-dired (dir) + "\"Edit\" directory DIR, but with additional URL-friendly bindings." + (interactive "DURL Dired (directory): ") + (find-file dir) + (url-dired-minor-mode t)) + +(provide 'url-dired) + +;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f
--- a/lisp/url/url-file.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/url/url-file.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,7 +1,6 @@ ;;; url-file.el --- File retrieval code ;; Copyright (c) 1996 - 1999,2004 Free Software Foundation, Inc. -;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu> ;; Keywords: comm, data, processes
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-ftp.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,42 @@ +;;; url-ftp.el --- FTP wrapper +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 - 1999 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; We knew not what we did when we overloaded 'file' to mean 'file' +;; and 'ftp' back in the dark ages of the web. +;; +;; This stub file is just here to please the auto-scheme-loading code +;; in url-methods.el and just maps everything onto the code in +;; url-file. + +(require 'url-parse) +(require 'url-file) + +(defconst url-ftp-default-port 21 "Default FTP port.") +(defconst url-ftp-asynchronous-p t "FTP transfers are asynchronous.") +(defalias 'url-ftp-expand-file-name 'url-default-expander) +(defalias 'url-ftp 'url-file) + +(provide 'url-ftp) + +;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-gw.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,268 @@ +;;; url-gw.el --- Gateway munging for URL loading +;; Author: Bill Perry <wmperry@gnu.org> +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc. +;;; +;;; This file is part of GNU Emacs. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(eval-when-compile (require 'cl)) +(require 'url-vars) + +;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program? + +(autoload 'socks-open-network-stream "socks") +(autoload 'open-ssl-stream "ssl") +(autoload 'open-tls-stream "tls") + +(defgroup url-gateway nil + "URL gateway variables" + :group 'url) + +(defcustom url-gateway-local-host-regexp nil + "*A regular expression specifying local hostnames/machines." + :type '(choice (const nil) regexp) + :group 'url-gateway) + +(defcustom url-gateway-prompt-pattern + "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" + "*A regular expression matching a shell prompt." + :type 'regexp + :group 'url-gateway) + +(defcustom url-gateway-rlogin-host nil + "*What hostname to actually rlog into before doing a telnet." + :type '(choice (const nil) string) + :group 'url-gateway) + +(defcustom url-gateway-rlogin-user-name nil + "*Username to log into the remote machine with when using rlogin." + :type '(choice (const nil) string) + :group 'url-gateway) + +(defcustom url-gateway-rlogin-parameters '("telnet" "-8") + "*Parameters to `url-open-rlogin'. +This list will be used as the parameter list given to rsh." + :type '(repeat string) + :group 'url-gateway) + +(defcustom url-gateway-telnet-host nil + "*What hostname to actually login to before doing a telnet." + :type '(choice (const nil) string) + :group 'url-gateway) + +(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") + "*Parameters to `url-open-telnet'. +This list will be executed as a command after logging in via telnet." + :type '(repeat string) + :group 'url-gateway) + +(defcustom url-gateway-telnet-login-prompt "^\r*.?login:" + "*Prompt that tells us we should send our username when loggin in w/telnet." + :type 'regexp + :group 'url-gateway) + +(defcustom url-gateway-telnet-password-prompt "^\r*.?password:" + "*Prompt that tells us we should send our password when loggin in w/telnet." + :type 'regexp + :group 'url-gateway) + +(defcustom url-gateway-telnet-user-name nil + "User name to log in via telnet with." + :type '(choice (const nil) string) + :group 'url-gateway) + +(defcustom url-gateway-telnet-password nil + "Password to use to log in via telnet with." + :type '(choice (const nil) string) + :group 'url-gateway) + +(defcustom url-gateway-broken-resolution nil + "*Whether to use nslookup to resolve hostnames. +This should be used when your version of Emacs cannot correctly use DNS, +but your machine can. This usually happens if you are running a statically +linked Emacs under SunOS 4.x" + :type 'boolean + :group 'url-gateway) + +(defcustom url-gateway-nslookup-program "nslookup" + "*If non-NIL then a string naming nslookup program." + :type '(choice (const :tag "None" :value nil) string) + :group 'url-gateway) + +;; Stolen from ange-ftp +;;;###autoload +(defun url-gateway-nslookup-host (host) + "Attempt to resolve the given HOST using nslookup if possible." + (interactive "sHost: ") + (if url-gateway-nslookup-program + (let ((proc (start-process " *nslookup*" " *nslookup*" + url-gateway-nslookup-program host)) + (res host)) + (process-kill-without-query proc) + (save-excursion + (set-buffer (process-buffer proc)) + (while (memq (process-status proc) '(run open)) + (accept-process-output proc)) + (goto-char (point-min)) + (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t) + (setq res (buffer-substring (match-beginning 1) + (match-end 1)))) + (kill-buffer (current-buffer))) + res) + host)) + +;; Stolen from red gnus nntp.el +(defun url-wait-for-string (regexp proc) + "Wait until string matching REGEXP arrives in process PROC's buffer." + (let ((buf (current-buffer))) + (goto-char (point-min)) + (while (not (re-search-forward regexp nil t)) + (accept-process-output proc) + (set-buffer buf) + (goto-char (point-min))))) + +;; Stolen from red gnus nntp.el +(defun url-open-rlogin (name buffer host service) + "Open a connection using rsh." + (if (not (stringp service)) + (setq service (int-to-string service))) + (let ((proc (if url-gateway-rlogin-user-name + (start-process + name buffer "rsh" + url-gateway-rlogin-host "-l" url-gateway-rlogin-user-name + (mapconcat 'identity + (append url-gateway-rlogin-parameters + (list host service)) " ")) + (start-process + name buffer "rsh" url-gateway-rlogin-host + (mapconcat 'identity + (append url-gateway-rlogin-parameters + (list host service)) + " "))))) + (set-buffer buffer) + (url-wait-for-string "^\r*200" proc) + (beginning-of-line) + (delete-region (point-min) (point)) + proc)) + +;; Stolen from red gnus nntp.el +(defun url-open-telnet (name buffer host service) + (if (not (stringp service)) + (setq service (int-to-string service))) + (save-excursion + (set-buffer (get-buffer-create buffer)) + (erase-buffer) + (let ((proc (start-process name buffer "telnet" "-8")) + (case-fold-search t)) + (when (memq (process-status proc) '(open run)) + (process-send-string proc "set escape \^X\n") + (process-send-string proc (concat + "open " url-gateway-telnet-host "\n")) + (url-wait-for-string url-gateway-telnet-login-prompt proc) + (process-send-string + proc (concat + (or url-gateway-telnet-user-name + (setq url-gateway-telnet-user-name (read-string "login: "))) + "\n")) + (url-wait-for-string url-gateway-telnet-password-prompt proc) + (process-send-string + proc (concat + (or url-gateway-telnet-password + (setq url-gateway-telnet-password + (funcall url-passwd-entry-func "Password: "))) + "\n")) + (erase-buffer) + (url-wait-for-string url-gateway-prompt-pattern proc) + (process-send-string + proc (concat (mapconcat 'identity + (append url-gateway-telnet-parameters + (list host service)) " ") "\n")) + (url-wait-for-string "^\r*Escape character.*\r*\n+" proc) + (delete-region (point-min) (match-end 0)) + (process-send-string proc "\^]\n") + (url-wait-for-string "^telnet" proc) + (process-send-string proc "mode character\n") + (accept-process-output proc 1) + (sit-for 1) + (goto-char (point-min)) + (forward-line 1) + (delete-region (point) (point-max))) + proc))) + +;;;###autoload +(defun url-open-stream (name buffer host service) + "Open a stream to HOST, possibly via a gateway. +Args per `open-network-stream'. +Will not make a connexion if `url-gateway-unplugged' is non-nil." + (unless url-gateway-unplugged + (let ((gw-method (if (and url-gateway-local-host-regexp + (not (eq 'tls url-gateway-method)) + (not (eq 'ssl url-gateway-method)) + (string-match + url-gateway-local-host-regexp + host)) + 'native + url-gateway-method)) +;;; ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF +;;; ;; conversions while trying to be 'helpful' +;;; (tcp-binary-process-output-services (if (stringp service) +;;; (list service) +;;; (list service +;;; (int-to-string service)))) + + ;; An attempt to deal with denied connections, and attempt + ;; to reconnect + (cur-retries 0) + (retry t) + (errobj nil) + (conn nil)) + + ;; If the user told us to do DNS for them, do it. + (if url-gateway-broken-resolution + (setq host (url-gateway-nslookup-host host))) + + (condition-case errobj + ;; This is a clean way to ensure the new process inherits the + ;; right coding systems in both Emacs and XEmacs. + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (setq conn (case gw-method + (tls + (open-tls-stream name buffer host service)) + (ssl + (open-ssl-stream name buffer host service)) + ((native) + (open-network-stream name buffer host service)) + (socks + (socks-open-network-stream name buffer host service)) + (telnet + (url-open-telnet name buffer host service)) + (rlogin + (url-open-rlogin name buffer host service)) + (otherwise + (error "Bad setting of url-gateway-method: %s" + url-gateway-method))))) + (error + (setq conn nil))) + conn))) + +(provide 'url-gw) + +;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838
--- a/lisp/url/url-handlers.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/url/url-handlers.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,7 +1,6 @@ ;;; url-handlers.el --- file-name-handler stuff for URL loading ;; Copyright (c) 1996, 1997, 1998, 1999, 2004 Free Software Foundation, Inc. -;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu> ;; Keywords: comm, data, processes, hypermedia @@ -208,7 +207,7 @@ ;; annotation which we could use as a hint of the locale in use ;; at the remote site. Not sure how/if that should be done. --Stef (decode-coding-inserted-region - start (point) buffer-file-name visit beg end replace))) + start (point) url visit beg end replace))) (list url (length data)))) (defun url-file-name-completion (url directory)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-history.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,199 @@ +;;; url-history.el --- Global history tracking for URL package + +;; Copyright (c) 1996 - 1999,2004 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes, hypermedia + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +;; This can get a recursive require. +;;(require 'url) +(eval-when-compile (require 'cl)) +(require 'url-parse) +(autoload 'url-do-setup "url") + +(defgroup url-history nil + "History variables in the URL package" + :prefix "url-history" + :group 'url) + +(defcustom url-history-track nil + "*Controls whether to keep a list of all the URLS being visited. +If non-nil, url will keep track of all the URLS visited. +If eq to `t', then the list is saved to disk at the end of each emacs +session." + :type 'boolean + :group 'url-history) + +(defcustom url-history-file nil + "*The global history file for the URL package. +This file contains a list of all the URLs you have visited. This file +is parsed at startup and used to provide URL completion." + :type '(choice (const :tag "Default" :value nil) file) + :group 'url-history) + +(defcustom url-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 outside of +the `customize' interface after `url-do-setup' has been run, you need +to run the `url-history-setup-save-timer' function manually." + :set (function (lambda (var val) + (set-default var val) + (and (featurep 'url) + (fboundp 'url-history-setup-save-timer) + (let ((def (symbol-function + 'url-history-setup-save-timer))) + (not (and (listp def) (eq 'autoload (car def))))) + (url-history-setup-save-timer)))) + :type 'integer + :group 'url-history) + +(defvar url-history-timer nil) + +(defvar url-history-list nil + "List of urls visited this session.") + +(defvar url-history-changed-since-last-save nil + "Whether the history list has changed since the last save operation.") + +(defvar url-history-hash-table nil + "Hash table for global history completion.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun url-history-setup-save-timer () + "Reset the history list timer." + (interactive) + (ignore-errors + (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer)) + ((fboundp 'delete-itimer) (delete-itimer url-history-timer)))) + (setq url-history-timer nil) + (if url-history-save-interval + (setq url-history-timer + (cond + ((fboundp 'run-at-time) + (run-at-time url-history-save-interval + url-history-save-interval + 'url-history-save-history)) + ((fboundp 'start-itimer) + (start-itimer "url-history-saver" 'url-history-save-history + url-history-save-interval + url-history-save-interval)))))) + +;;;###autoload +(defun url-history-parse-history (&optional fname) + "Parse a history file stored in FNAME." + ;; Parse out the mosaic global history file for completions, etc. + (or fname (setq fname (expand-file-name url-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 nil + (load fname nil t) + (error (message "Could not load %s" fname))))) + (if (not url-history-hash-table) + (setq url-history-hash-table (make-hash-table :size 31 :test 'equal)))) + +(defun url-history-update-url (url time) + (setq url-history-changed-since-last-save t) + (puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table)) + +;;;###autoload +(defun url-history-save-history (&optional fname) + "Write the global history file into `url-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-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) + (let ((count 0)) + (maphash (function + (lambda (key value) + (while (string-match "[\r\n]+" key) + (setq key (concat (substring key 0 (match-beginning 0)) + (substring key (match-end 0) nil)))) + (setq count (1+ count)) + (insert "(puthash \"" key "\"" + (if (not (stringp value)) " '" "") + (prin1-to-string value) + " url-history-hash-table)\n"))) + url-history-hash-table) + (goto-char (point-min)) + (insert (format + "(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n" + (/ count 4))) + (goto-char (point-max)) + (insert "\n") + (write-file fname)) + (kill-buffer (current-buffer)))))) + (setq url-history-changed-since-last-save nil)) + +(defun url-have-visited-url (url) + (url-do-setup) + (gethash url url-history-hash-table nil)) + +(defun url-completion-function (string predicate function) + (url-do-setup) + (cond + ((eq function nil) + (let ((list nil)) + (maphash (function (lambda (key val) + (setq list (cons (cons key val) + list)))) + url-history-hash-table) + (try-completion string (nreverse list) predicate))) + ((eq function t) + (let ((stub (concat "^" (regexp-quote string))) + (retval nil)) + (maphash + (function + (lambda (url time) + (if (string-match stub url) + (setq retval (cons url retval))))) + url-history-hash-table) + retval)) + ((eq function 'lambda) + (and url-history-hash-table + (gethash string url-history-hash-table) + t)) + (t + (error "url-completion-function very confused.")))) + +(provide 'url-history) + +;; arch-tag: fbbbaf63-db36-4e88-bc9f-2939aa93afb2 +;;; url-history.el ends here
--- a/lisp/url/url-https.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/url/url-https.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,4 +1,4 @@ -;;; url-https.el --- HTTP over SSL routines +;;; url-https.el --- HTTP over SSL/TLS routines ;; Copyright (c) 1999, 2004 Free Software Foundation, Inc. @@ -30,6 +30,7 @@ (require 'url-parse) (require 'url-cookie) (require 'url-http) +(require 'tls) (defconst url-https-default-port 443 "Default HTTPS port.") (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") @@ -38,12 +39,11 @@ (defmacro url-https-create-secure-wrapper (method args) `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args ,(format "HTTPS wrapper around `%s' call." (or method "url-http")) - (condition-case () - (require 'ssl) - (error - (error "HTTPS support could not find `ssl' library"))) - (let ((url-gateway-method 'ssl)) - ( ,(intern (format (if method "url-http-%s" "url-http") method)) ,@(remove '&rest (remove '&optional args)))))) + (let ((url-gateway-method (condition-case () + (require 'ssl) + (error 'tls)))) + (,(intern (format (if method "url-http-%s" "url-http") method)) + ,@(remove '&rest (remove '&optional args)))))) (url-https-create-secure-wrapper nil (url callback cbargs)) (url-https-create-secure-wrapper file-exists-p (url))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-irc.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,76 @@ +;;; url-irc.el --- IRC URL interface +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 - 1999 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt + +(require 'url-vars) +(require 'url-parse) + +(defconst url-irc-default-port 6667 "Default port for IRC connections") + +(defcustom url-irc-function 'url-irc-zenirc + "*Function to actually open an IRC connection. +Should be a function that takes several argument: + HOST - the hostname of the IRC server to contact + PORT - the port number of the IRC server to contact + CHANNEL - What channel on the server to visit right away (can be nil) + USER - What username to use +PASSWORD - What password to use" + :type '(choice (const :tag "ZEN IRC" :value 'url-irc-zenirc) + (function :tag "Other")) + :group 'url) + +(defun url-irc-zenirc (host port channel user password) + (let ((zenirc-buffer-name (if (and user host port) + (format "%s@%s:%d" user host port) + (format "%s:%d" host port))) + (zenirc-server-alist + (list + (list host port password nil user)))) + (zenirc) + (goto-char (point-max)) + (if (not channel) + nil + (insert "/join " channel) + (zenirc-send-line)))) + +;;;###autoload +(defun url-irc (url) + (let* ((host (url-host url)) + (port (string-to-int (url-port url))) + (pass (url-password url)) + (user (url-user url)) + (chan (url-filename url))) + (if (url-target url) + (setq chan (concat chan "#" (url-target url)))) + (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) + nil)) + +(provide 'url-irc) + +;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-ldap.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,240 @@ +;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code +;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(require 'url-vars) +(require 'url-parse) +(require 'url-util) +(require 'ldap) +(autoload 'tls-certificate-information "tls") + +;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997) +;; +;; basic format is: ldap://host:port/dn?attributes?scope?filter?extensions +;; +;; Test URLs: +;; ldap://ldap.itd.umich.edu/cn%3Dumbflabmanager%2C%20ou%3DUser%20Groups%2C%20ou%3DGroups%2C%20o%3DUniversity%20of%20Michigan%2C%20c%3DUS +;; ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US +;; +;; For simple queries, I have verified compatibility with Netscape +;; Communicator v4.5 under GNU/Linux. +;; +;; For anything _useful_ though, like specifying the attributes, +;; scope, filter, or extensions, netscape claims the URL format is +;; unrecognized. So I don't think it supports anything other than the +;; defaults (scope=base,attributes=*,filter=(objectClass=*) + +(defconst url-ldap-default-port 389 "Default LDAP port.") +(defalias 'url-ldap-expand-file-name 'url-default-expander) + +(defvar url-ldap-pretty-names + '(("l" . "City") + ("objectclass" . "Object Class") + ("o" . "Organization") + ("ou" . "Organizational Unit") + ("cn" . "Name") + ("sn" . "Last Name") + ("givenname" . "First Name") + ("mail" . "Email") + ("title" . "Title") + ("c" . "Country") + ("postalcode" . "ZIP Code") + ("telephonenumber" . "Phone Number") + ("facsimiletelephonenumber" . "Fax") + ("postaladdress" . "Mailing Address") + ("description" . "Notes")) + "*An assoc list mapping LDAP attribute names to pretty descriptions of them.") + +(defvar url-ldap-attribute-formatters + '(("mail" . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x))) + ("owner" . url-ldap-dn-formatter) + ("creatorsname" . url-ldap-dn-formatter) + ("jpegphoto" . url-ldap-image-formatter) + ("usercertificate" . url-ldap-certificate-formatter) + ("modifiersname" . url-ldap-dn-formatter) + ("namingcontexts" . url-ldap-dn-formatter) + ("defaultnamingcontext" . url-ldap-dn-formatter) + ("member" . url-ldap-dn-formatter)) + "*An assoc list mapping LDAP attribute names to pretty formatters for them.") + +(defsubst url-ldap-attribute-pretty-name (n) + (or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n)) + +(defsubst url-ldap-attribute-pretty-desc (n v) + (if (string-match "^\\([^;]+\\);" n) + (setq n (match-string 1 n))) + (funcall (or (cdr-safe (assoc (downcase n) url-ldap-attribute-formatters)) 'identity) v)) + +(defun url-ldap-dn-formatter (dn) + (concat "<a href='/" + (url-hexify-string dn) + "'>" dn "</a>")) + +(defun url-ldap-certificate-formatter (data) + (condition-case () + (require 'ssl) + (error nil)) + (let ((vals (if (fboundp 'ssl-certificate-information) + (ssl-certificate-information data) + (tls-certificate-information data)))) + (if (not vals) + "<b>Unable to parse certificate</b>" + (concat "<table border=0>\n" + (mapconcat + (lambda (ava) + (format "<tr><td>%s</td><td>%s</td></tr>\n" (car ava) (cdr ava))) + vals "\n") + "</table>\n")))) + +(defun url-ldap-image-formatter (data) + (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>" + (url-hexify-string (base64-encode-string data)))) + +;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically +;; calls of ldap-open, ldap-close, ldap-search-internal +;;;###autoload +(defun url-ldap (url) + (save-excursion + (set-buffer (generate-new-buffer " *url-ldap*")) + (setq url-current-object url) + (insert "Content-type: text/html\r\n\r\n") + (if (not (fboundp 'ldap-search-internal)) + (insert "<html>\n" + " <head>\n" + " <title>LDAP Not Supported</title>\n" + " <base href='" (url-recreate-url url) "'>\n" + " </head>\n" + " <body>\n" + " <h1>LDAP Not Supported</h1>\n" + " <p>\n" + " This version of Emacs does not support LDAP.\n" + " </p>\n" + " </body>\n" + "</html>\n") + (let* ((binddn nil) + (data (url-filename url)) + (host (url-host url)) + (port (url-port url)) + (base-object nil) + (attributes nil) + (scope nil) + (filter nil) + (extensions nil) + (connection nil) + (results nil) + (extract-dn (and (fboundp 'function-max-args) + (= (function-max-args 'ldap-search-internal) 7)))) + + ;; Get rid of leading / + (if (string-match "^/" data) + (setq data (substring data 1))) + + (setq data (mapcar (lambda (x) (if (/= (length x) 0) x nil)) (split-string data "\\?")) + base-object (nth 0 data) + attributes (nth 1 data) + scope (nth 2 data) + filter (nth 3 data) + extensions (nth 4 data)) + + ;; fill in the defaults + (setq base-object (url-unhex-string (or base-object "")) + scope (intern (url-unhex-string (or scope "base"))) + filter (url-unhex-string (or filter "(objectClass=*)"))) + + (if (not (memq scope '(base one tree))) + (error "Malformed LDAP URL: Unknown scope: %S" scope)) + + ;; Convert to the internal LDAP support scoping names. + (setq scope (cdr (assq scope '((base . base) (one . onelevel) (sub . subtree))))) + + (if attributes + (setq attributes (mapcar 'url-unhex-string (split-string attributes ",")))) + + ;; Parse out the exentions + (if extensions + (setq extensions (mapcar (lambda (ext) + (if (string-match "\\([^=]*\\)=\\(.*\\)" ext) + (cons (match-string 1 ext) (match-string 2 ext)) + (cons ext ext))) + (split-string extensions ",")) + extensions (mapcar (lambda (ext) + (cons (url-unhex-string (car ext)) + (url-unhex-string (cdr ext)))) + extensions))) + + (setq binddn (cdr-safe (or (assoc "bindname" extensions) + (assoc "!bindname" extensions)))) + + ;; Now, let's actually do something with it. + (setq connection (ldap-open host (if binddn (list 'binddn binddn))) + results (if extract-dn + (ldap-search-internal connection filter base-object scope attributes nil t) + (ldap-search-internal connection filter base-object scope attributes nil))) + + (ldap-close connection) + (insert "<html>\n" + " <head>\n" + " <title>LDAP Search Results</title>\n" + " <base href='" (url-recreate-url url) "'>\n" + " </head>\n" + " <body>\n" + " <h1>" (int-to-string (length results)) " matches</h1>\n") + + (mapc (lambda (obj) + (insert " <hr>\n" + " <table border=1>\n") + (if extract-dn + (insert " <tr><th colspan=2>" (car obj) "</th></tr>\n")) + (mapc (lambda (attr) + (if (= (length (cdr attr)) 1) + ;; single match, easy + (insert " <tr><td>" + (url-ldap-attribute-pretty-name (car attr)) + "</td><td>" + (url-ldap-attribute-pretty-desc (car attr) (car (cdr attr))) + "</td></tr>\n") + ;; Multiple matches, slightly uglier + (insert " <tr>\n" + (format " <td valign=top>") + (url-ldap-attribute-pretty-name (car attr)) "</td><td>" + (mapconcat (lambda (x) + (url-ldap-attribute-pretty-desc (car attr) x)) + (cdr attr) + "<br>\n") + "</td>" + " </tr>\n"))) + (if extract-dn (cdr obj) obj)) + (insert " </table>\n")) + results) + + (insert " <hr>\n" + " </body>\n" + "</html>\n"))) + (current-buffer))) + +(provide 'url-ldap) + +;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8 +;;; url-ldap.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-mailto.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,131 @@ +;;; url-mail.el --- Mail Uniform Resource Locator retrieval code + +;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'url-vars) +(require 'url-parse) +(require 'url-util) + +;;;###autoload +(defun url-mail (&rest args) + (interactive "P") + (if (fboundp 'message-mail) + (apply 'message-mail args) + (or (apply 'mail args) + (error "Mail aborted")))) + +(defun url-mail-goto-field (field) + (if (not field) + (goto-char (point-max)) + (let ((dest nil) + (lim nil) + (case-fold-search t)) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (regexp-quote mail-header-separator) nil t) + (setq lim (match-beginning 0))) + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote field) ":") lim t) + (setq dest (match-beginning 0)))) + (if dest + (progn + (goto-char dest) + (end-of-line)) + (goto-char lim) + (insert (capitalize field) ": ") + (save-excursion + (insert "\n")))))) + +;;;###autoload +(defun url-mailto (url) + "Handle the mailto: URL syntax." + (if (url-user url) + ;; malformed mailto URL (mailto://wmperry@gnu.org instead of + ;; mailto:wmperry@gnu.org + (url-set-filename url (concat (url-user url) "@" (url-filename url)))) + (setq url (url-filename url)) + (let (to args source-url subject func headers-start) + (if (string-match (regexp-quote "?") url) + (setq headers-start (match-end 0) + to (url-unhex-string (substring url 0 (match-beginning 0))) + args (url-parse-query-string + (substring url headers-start 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))) + + (if (assoc "to" args) + (push to (cdr (assoc "to" args))) + (setq args (cons (list "to" to) args))) + (setq subject (cdr-safe (assoc "subject" args))) + (if (fboundp url-mail-command) (funcall url-mail-command) (mail)) + (while args + (if (string= (caar args) "body") + (progn + (goto-char (point-max)) + (insert (mapconcat 'identity (cdar args) "\n"))) + (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 "User-Agent") +;; (insert url-package-name "/" url-package-version " URL/" url-version) + (if (not url-request-data) + (progn + (set-buffer-modified-p nil) + (if subject + (url-mail-goto-field nil) + (url-mail-goto-field "subject"))) + (if url-request-extra-headers + (mapconcat + (lambda (x) + (url-mail-goto-field (car x)) + (insert (cdr x))) + url-request-extra-headers "")) + (goto-char (point-max)) + (insert url-request-data) + ;; It seems Microsoft-ish to send without warning. + ;; Fixme: presumably this should depend on a privacy setting. + (if (y-or-n-p "Send this auto-generated mail? ") + (cond ((eq url-mail-command 'compose-mail) + (funcall (get mail-user-agent 'sendfunc) nil)) + ;; otherwise, we can't be sure + ((fboundp 'message-send-and-exit) + (message-send-and-exit)) + (t (mail-send-and-exit nil))))) + nil)) + +(provide 'url-mailto) + +;; arch-tag: 7b7ad52e-8760-497b-9444-75fae14e34c5 +;;; url-mailto.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-methods.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,150 @@ +;;; url-methods.el --- Load URL schemes as needed + +;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes, hypermedia + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl)) + +;; This loads up some of the small, silly URLs that I really don't +;; want to bother putting in their own separate files. +(require 'url-parse) + +(defvar url-scheme-registry (make-hash-table :size 7 :test 'equal)) + +(defconst url-scheme-methods + '((default-port . variable) + (asynchronous-p . variable) + (expand-file-name . function) + (file-exists-p . function) + (file-attributes . function) + (parse-url . function) + (file-symlink-p . function) + (file-writable-p . function) + (file-directory-p . function) + (file-executable-p . function) + (directory-files . function) + (file-truename . function)) + "Assoc-list of methods that each URL loader can provide.") + +(defconst url-scheme-default-properties + (list 'name "unknown" + 'loader 'url-scheme-default-loader + 'default-port 0 + 'expand-file-name 'url-identity-expander + 'parse-url 'url-generic-parse-url + 'asynchronous-p nil + 'file-directory-p 'ignore + 'file-truename (lambda (&rest args) + (url-recreate-url (car args))) + 'file-exists-p 'ignore + 'file-attributes 'ignore)) + +(defun url-scheme-default-loader (url &optional callback cbargs) + "Signal an error for an unknown URL scheme." + (error "Unkown URL scheme: %s" (url-type url))) + +(defun url-scheme-register-proxy (scheme) + "Automatically find a proxy for SCHEME and put it in `url-proxy-services'." + (let* ((env-var (concat scheme "_proxy")) + (env-proxy (or (getenv (upcase env-var)) + (getenv (downcase env-var)))) + (cur-proxy (assoc scheme url-proxy-services)) + (urlobj nil)) + + ;; 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 (match-string 1 env-proxy)) + (url-set-port urlobj (string-to-number (match-string 2 env-proxy)))) + ;; 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 scheme (format "%s:%d" (url-host urlobj) + (url-port urlobj))) + url-proxy-services)) + (message "Using a proxy for %s..." scheme))))) + +(defun url-scheme-get-property (scheme property) + "Get property of a URL SCHEME. +Will automatically try to load a backend from url-SCHEME.el if +it has not already been loaded." + (setq scheme (downcase scheme)) + (let ((desc (gethash scheme url-scheme-registry))) + (if (not desc) + (let* ((stub (concat "url-" scheme)) + (loader (intern stub))) + (condition-case () + (require loader) + (error nil)) + (if (fboundp loader) + (progn + ;; Found the module to handle <scheme> URLs + (url-scheme-register-proxy scheme) + (setq desc (list 'name scheme + 'loader loader)) + (dolist (cell url-scheme-methods) + (let ((symbol (intern-soft (format "%s-%s" stub (car cell)))) + (type (cdr cell))) + (if symbol + (case type + (function + ;; Store the symbol name of a function + (if (fboundp symbol) + (setq desc (plist-put desc (car cell) symbol)))) + (variable + ;; Store the VALUE of a variable + (if (boundp symbol) + (setq desc (plist-put desc (car cell) + (symbol-value symbol))))) + (otherwise + (error "Malformed url-scheme-methods entry: %S" + cell)))))) + (puthash scheme desc url-scheme-registry))))) + (or (plist-get desc property) + (plist-get url-scheme-default-properties property)))) + +(provide 'url-methods) + +;; arch-tag: 336863f8-5a07-4906-9be5-b3c6bcebbe67 +;;; url-methods.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-misc.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,117 @@ +;;; url-misc.el --- Misc Uniform Resource Locator retrieval code +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996,1997,1998,1999,2002 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 'url-vars) +(require 'url-parse) +(autoload 'Info-goto-node "info" "" t) +(autoload 'man "man" nil t) + +;;;###autoload +(defun url-man (url) + "Fetch a Unix manual page URL." + (man (url-filename url)) + nil) + +;;;###autoload +(defun url-info (url) + "Fetch a GNU Info URL." + ;; Fetch an info node + (let* ((fname (url-filename url)) + (node (url-unhex-string (or (url-target url) "Top")))) + (if (and fname node) + (Info-goto-node (concat "(" fname ")" node)) + (error "Malformed url: %s" (url-recreate-url url))) + nil)) + +(defun url-do-terminal-emulator (type server port user) + (terminal-emulator + (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server)) + (case type + (rlogin "rlogin") + (telnet "telnet") + (tn3270 "tn3270") + (otherwise + (error "Unknown terminal emulator required: %s" type))) + (case type + (rlogin + (if user + (list server "-l" user) + (list server))) + (telnet + (if user (message "Please log in as user: %s" user)) + (if port + (list server port) + (list server))) + (tn3270 + (if user (message "Please log in as user: %s" user)) + (list server))))) + +;;;###autoload +(defun url-generic-emulator-loader (url) + (let* ((type (intern (downcase (url-type url)))) + (server (url-host url)) + (name (url-user url)) + (port (url-port url))) + (url-do-terminal-emulator type server port name)) + nil) + +;;;###autoload +(defalias 'url-rlogin 'url-generic-emulator-loader) +;;;###autoload +(defalias 'url-telnet 'url-generic-emulator-loader) +;;;###autoload +(defalias 'url-tn3270 'url-generic-emulator-loader) + +;; RFC 2397 +;;;###autoload +(defun url-data (url) + "Fetch a data URL (RFC 2397)." + (let ((mediatype nil) + ;; The mediatype may need to be hex-encoded too -- see the RFC. + (desc (url-unhex-string (url-filename url))) + (encoding "8bit") + (data nil)) + (save-excursion + (if (not (string-match "\\([^,]*\\)?," desc)) + (error "Malformed data URL: %s" desc) + (setq mediatype (match-string 1 desc)) + (if (and mediatype (string-match ";base64\\'" mediatype)) + (setq mediatype (substring mediatype 0 (match-beginning 0)) + encoding "base64")) + (if (or (null mediatype) + (eq ?\; (aref mediatype 0))) + (setq mediatype (concat "text/plain" mediatype))) + (setq data (url-unhex-string (substring desc (match-end 0))))) + (set-buffer (generate-new-buffer " *url-data*")) + (mm-disable-multibyte) + (insert (format "Content-Length: %d\n" (length data)) + "Content-Type: " mediatype "\n" + "Content-Encoding: " encoding "\n" + "\n") + (if data (insert data)) + (current-buffer)))) + +(provide 'url-misc) + +;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-news.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,135 @@ +;;; url-news.el --- News Uniform Resource Locator retrieval code +;; Keywords: comm, data, processes + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 - 1999, 2004 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 'url-vars) +(require 'url-util) +(require 'url-parse) +(require 'nntp) +(autoload 'url-warn "url") +(autoload 'gnus-group-read-ephemeral-group "gnus-group") +(eval-when-compile (require 'cl)) + +(defgroup url-news nil + "News related options" + :group 'url) + +(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-message-id (host message-id) + (let ((buf (generate-new-buffer " *url-news*"))) + (if (eq ?> (aref message-id (1- (length message-id)))) + nil + (setq message-id (concat "<" message-id ">"))) + (if (cdr-safe (nntp-request-article message-id nil host buf)) + ;; Successfully retrieved the article + nil + (save-excursion + (set-buffer buf) + (insert "Content-type: text/html\n\n" + "<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 mail</a>\n" + " </p>\n" + " </div>\n" + " </body>\n" + "</html>\n" + "<!-- Automatically generated by URL v" url-version " -->\n" + ))) + buf)) + +(defun url-news-fetch-newsgroup (newsgroup host) + (declare (special gnus-group-buffer)) + (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 us from checking new news if Gnus is already running + ;; FIXME - is it relatively safe to use gnus-alive-p here? FIXME + (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 + 'nntp-open-connection-function + nntp-open-connection-function) + nil + (cons (current-buffer) 'browse))) + +;;;###autoload +(defun url-news (url) + ;; Find a news reference + (let* ((host (or (url-host url) url-news-server)) + (port (url-port url)) + (article-brackets nil) + (buf nil) + (article (url-filename url))) + (url-news-open-host host port (url-user url) (url-password url)) + (setq article (url-unhex-string article)) + (cond + ((string-match "@" article) ; Its a specific article + (setq buf (url-news-fetch-message-id host article))) + ((string= article "") ; List all newsgroups + (gnus)) + (t ; Whole newsgroup + (url-news-fetch-newsgroup article host))) + buf)) + +;;;###autoload +(defun url-snews (url) + (let ((nntp-open-connection-function (if (eq 'tls url-gateway-method) + nntp-open-tls-stream + nntp-open-ssl-stream))) + (url-news url))) + +(provide 'url-news) + +;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311
--- a/lisp/url/url-nfs.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/url/url-nfs.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,7 +1,6 @@ ;;; url-nfs.el --- NFS URL interface -;; Copyright (c) 1996,97,98,1999,2004 Free Software Foundation, Inc. -;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu> +;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc. ;; Keywords: comm, data, processes
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-parse.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,210 @@ +;;; url-parse.el --- Uniform Resource Locator parser + +;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(require 'url-vars) + +(autoload 'url-scheme-get-property "url-methods") + +(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) + (url-scheme-get-property (url-type ,urlobj) 'default-port)))) + +(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)) + +;;;###autoload +(defun url-recreate-url (urlobj) + "Recreate a URL string from the parsed 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) + (url-scheme-get-property (url-type urlobj) 'default-port)))) + (format ":%d" (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) ";"))))) + +;;;###autoload +(defun url-generic-parse-url (url) + "Return a vector of the parts of URL. +Format is: +\[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]" + (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-parse-syntax-table) + (let ((save-pos nil) + (prot nil) + (user nil) + (pass nil) + (host nil) + (port nil) + (file nil) + (refs nil) + (attr nil) + (full nil) + (inhibit-read-only t)) + (erase-buffer) + (insert url) + (goto-char (point-min)) + (setq save-pos (point)) + (if (not (looking-at "//")) + (progn + (skip-chars-forward "a-zA-Z+.\\-") + (downcase-region save-pos (point)) + (setq prot (buffer-substring save-pos (point))) + (skip-chars-forward ":") + (setq save-pos (point)))) + + ;; We are doing a fully specified URL, with hostname and all + (if (looking-at "//") + (progn + (setq full t) + (forward-char 2) + (setq save-pos (point)) + (skip-chars-forward "^/") + (setq host (buffer-substring save-pos (point))) + (if (string-match "^\\([^@]+\\)@" host) + (setq user (match-string 1 host) + host (substring host (match-end 0) nil))) + (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user)) + (setq pass (match-string 2 user) + user (match-string 1 user))) + (if (string-match ":\\([0-9+]+\\)" host) + (setq port (string-to-int (match-string 1 host)) + host (substring host 0 (match-beginning 0)))) + (if (string-match ":$" host) + (setq host (substring host 0 (match-beginning 0)))) + (setq host (downcase host) + save-pos (point)))) + + (if (not port) + (setq port (url-scheme-get-property prot 'default-port))) + + ;; Gross hack to preserve ';' in data URLs + + (setq save-pos (point)) + + (if (string= "data" prot) + (goto-char (point-max)) + ;; Now check for references + (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 (url-parse-args (buffer-substring (point) (point-max)) t) + attr (nreverse attr)))) + + (setq file (buffer-substring save-pos (point))) + (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) + +;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403 +;;; url-parse.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-privacy.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,81 @@ +;;; url-privacy.el --- Global history tracking for URL package +;; Keywords: comm, data, processes, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. +;;; +;;; This file is part of GNU Emacs. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(eval-when-compile (require 'cl)) +(require 'url-vars) + +(if (fboundp 'device-type) + (defalias 'url-device-type 'device-type) + (defun url-device-type (&optional device) (or window-system 'tty))) + +;;;###autoload +(defun url-setup-privacy-info () + (interactive) + (setq url-system-type + (cond + ((or (eq url-privacy-level 'paranoid) + (and (listp url-privacy-level) + (memq 'os url-privacy-level))) + nil) + ;; First, we handle the inseparable OS/Windowing system + ;; combinations + ((eq system-type 'Apple-Macintosh) "Macintosh") + ((eq system-type 'next-mach) "NeXT") + ((eq system-type 'windows-nt) "Windows-NT; 32bit") + ((eq system-type 'ms-windows) "Windows; 16bit") + ((eq system-type 'ms-dos) "MS-DOS; 32bit") + ((memq (url-device-type) '(win32 w32)) "Windows; 32bit") + ((eq (url-device-type) 'pm) "OS/2; 32bit") + (t + (case (url-device-type) + (x "X11") + (ns "OpenStep") + (tty "TTY") + (otherwise nil))))) + + (setq url-personal-mail-address (or url-personal-mail-address + user-mail-address + (format "%s@%s" (user-real-login-name) + (system-name)))) + + (if (or (memq url-privacy-level '(paranoid high)) + (and (listp url-privacy-level) + (memq 'email url-privacy-level))) + (setq url-personal-mail-address nil)) + + (setq url-os-type + (cond + ((or (eq url-privacy-level 'paranoid) + (and (listp url-privacy-level) + (memq 'os url-privacy-level))) + nil) + ((boundp 'system-configuration) + system-configuration) + ((boundp 'system-type) + (symbol-name system-type)) + (t nil)))) + +(provide 'url-privacy) + +;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d
--- a/lisp/url/url-util.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/url/url-util.el Thu Oct 14 08:50:09 2004 +0000 @@ -1,7 +1,6 @@ ;;; url-util.el --- Miscellaneous helper routines for URL library -;; Copyright (c) 1996,97,98,99,2001,2004 Free Software Foundation, Inc. -;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu> +;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> ;; Keywords: comm, data, processes
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-vars.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,431 @@ +;;; url-vars.el --- Variables for Uniform Resource Locator tool +;; Keywords: comm, data, processes, hypermedia + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996,1997,1998,1999,2001,2004 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 'mm-util) + +(defconst url-version "Emacs" + "Version number of URL package.") + +(defgroup url nil + "Uniform Resource Locator tool" + :version "21.4" + :group 'hypermedia) + +(defgroup url-file nil + "URL storage" + :prefix "url-" + :group 'url) + +(defgroup url-cache nil + "URL cache" + :prefix "url-" + :prefix "url-cache-" + :group 'url) + +(defgroup url-mime nil + "MIME options of URL" + :prefix "url-" + :group 'url) + +(defgroup url-hairy nil + "Hairy options of URL" + :prefix "url-" + :group 'url) + + +(defvar url-current-object nil + "A parsed representation of the current url.") + +(defvar url-current-mime-headers nil + "A parsed representation of the MIME headers for the current url.") + +(mapcar 'make-variable-buffer-local + '( + url-current-object + url-current-referer + url-current-mime-headers + )) + +(defcustom url-honor-refresh-requests t + "*Whether to do automatic page reloads. +These are done at the request of the document author or the server via +the `Refresh' header in an HTTP response. If nil, no refresh +requests will be honored. If t, all refresh requests will be honored. +If non-nil and not t, the user will be asked for each refresh +request." + :type '(choice (const :tag "off" nil) + (const :tag "on" t) + (const :tag "ask" 'ask)) + :group 'url-hairy) + +(defcustom url-automatic-caching nil + "*If non-nil, all documents will be automatically cached to the local disk." + :type 'boolean + :group 'url-cache) + +;; Fixme: sanitize this. +(defcustom url-cache-expired + (lambda (t1 t2) (>= (- (car t2) (car t1)) 5)) + "*A function determining if a cached item has expired. +It takes two times (numbers) as its arguments, and returns non-nil if +the second time is 'too old' when compared to the first time." + :type 'function + :group 'url-cache) + +(defconst url-bug-address "bug-gnu-emacs@gnu.org" + "Where to send bug reports.") + +(defcustom url-personal-mail-address nil + "*Your full email address. +This is what is sent to HTTP servers as the FROM field in an HTTP +request." + :type '(choice (const :tag "Unspecified" nil) string) + :group 'url) + +(defcustom url-directory-index-file "index.html" + "*The filename to look for when indexing a directory. +If this file exists, and is readable, then it will be viewed instead of +using `dired' to view the directory." + :type 'string + :group 'url-file) + +;; Fixme: this should have a setter which calls url-setup-privacy-info. +(defcustom url-privacy-level '(email) + "*How private you want your requests to be. +HTTP has header fields for various information about the user, including +operating system information, email addresses, the last page you visited, etc. +This variable controls how much of this information is sent. + +This should a symbol or a list. +Valid values if a symbol are: +none -- Send all information +low -- Don't send the last location +high -- Don't send the email address or last location +paranoid -- Don't send anything + +If a list, this should be a list of symbols of what NOT to send. +Valid symbols are: +email -- the email address +os -- the operating system info +lastloc -- the last location +agent -- Do not send the User-Agent string +cookie -- never accept HTTP cookies + +Samples: + + (setq url-privacy-level 'high) + (setq url-privacy-level '(email lastloc)) ;; equivalent to 'high + (setq url-privacy-level '(os)) + +::NOTE:: +This variable controls several other variables and is _NOT_ automatically +updated. Call the function `url-setup-privacy-info' after modifying this +variable." + :type '(radio (const :tag "None (you believe in the basic goodness of humanity)" + :value none) + (const :tag "Low (do not reveal last location)" + :value low) + (const :tag "High (no email address or last location)" + :value high) + (const :tag "Paranoid (reveal nothing!)" + :value paranoid) + (checklist :tag "Custom" + (const :tag "Email address" :value email) + (const :tag "Operating system" :value os) + (const :tag "Last location" :value lastloc) + (const :tag "Browser identification" :value agent) + (const :tag "No cookies" :value cookie))) + :group 'url) + +(defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.") + +(defcustom url-uncompressor-alist '((".z" . "x-gzip") + (".gz" . "x-gzip") + (".uue" . "x-uuencoded") + (".hqx" . "x-hqx") + (".Z" . "x-compress") + (".bz2" . "x-bzip2")) + "*An alist of file extensions and appropriate content-transfer-encodings." + :type '(repeat (cons :format "%v" + (string :tag "Extension") + (string :tag "Encoding"))) + :group 'url-mime) + +(defcustom url-mail-command (if (fboundp 'compose-mail) + 'compose-mail + 'url-mail) + "*This function will be called whenever url needs to send mail. +It should enter a mail-mode-like buffer in the current window. +The commands `mail-to' and `mail-subject' should still work in this +buffer, and it should use `mail-header-separator' if possible." + :type 'function + :group 'url) + +(defcustom url-proxy-services nil + "*An alist of schemes and proxy servers that gateway them. +Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up +from the ACCESS_proxy environment variables." + :type '(repeat (cons :format "%v" + (string :tag "Protocol") + (string :tag "Proxy"))) + :group 'url) + +(defcustom url-passwd-entry-func nil + "*Symbol indicating which function to call to read in a password. +It will be set up depending on whether you are running EFS or ange-ftp +at startup if it is nil. This function should accept the prompt +string as its first argument, and the default value as its second +argument." + :type '(choice (const :tag "Guess" :value nil) + (const :tag "Use Ange-FTP" :value ange-ftp-read-passwd) + (const :tag "Use EFS" :value efs-read-passwd) + (const :tag "Use Password Package" :value read-passwd) + (function :tag "Other")) + :group 'url-hairy) + +(defcustom url-standalone-mode nil + "*Rely solely on the cache?" + :type 'boolean + :group 'url-cache) + +(defvar url-mime-separator-chars (mapcar 'identity + (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz" + "0123456789'()+_,-./=?")) + "Characters allowable in a MIME multipart separator.") + +(defcustom url-bad-port-list + '("25" "119" "19") + "*List of ports to warn the user about connecting to. +Defaults to just the mail, chargen, and NNTP ports so you cannot be +tricked into sending fake mail or forging messages by a malicious HTML +document." + :type '(repeat (string :tag "Port")) + :group 'url-hairy) + +(defvar url-mime-content-type-charset-regexp + ";[ \t]*charset=\"?\\([^\"]+\\)\"?" + "Regexp used in parsing `Content-Type' for a charset indication.") + +(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.") + +;; FIXME!! (RFC 2616 gives examples like `compress, gzip'.) +(defvar url-mime-encoding-string nil + "*String to send in the Accept-encoding: field in HTTP requests.") + +;; `mm-mime-mule-charset-alist' in Gnus 5.8/9 contains elements whose +;; cars aren't valid MIME charsets/coding systems, at least in Emacs. +;; This gets it correct by construction in Emacs. Fixme: DTRT for +;; XEmacs -- its `coding-system-list' doesn't have the BASE-ONLY arg. +(when (and (not (featurep 'xemacs)) + (fboundp 'coding-system-list)) + (setq mm-mime-mule-charset-alist + (apply + 'nconc + (mapcar + (lambda (cs) + (when (and (coding-system-get cs 'mime-charset) + (not (eq t (coding-system-get cs 'safe-charsets)))) + (list (cons (coding-system-get cs 'mime-charset) + (delq 'ascii + (coding-system-get cs 'safe-charsets)))))) + (coding-system-list 'base-only))))) + +;; Perhaps the first few should actually be given decreasing `q's and +;; the list should be trimmed significantly. +;; Fixme: do something sane if we don't have `sort-coding-systems' +;; (Emacs 20, XEmacs). +(defun url-mime-charset-string () + "Generate a list of preferred MIME charsets for HTTP requests. +Generated according to current coding system priorities." + (if (fboundp 'sort-coding-systems) + (let ((ordered (sort-coding-systems + (let (accum) + (dolist (elt mm-mime-mule-charset-alist) + (if (mm-coding-system-p (car elt)) + (push (car elt) accum))) + (nreverse accum))))) + (concat (format "%s;q=1, " (pop ordered)) + (mapconcat 'symbol-name ordered ";q=0.5, ") + ";q=0.5")))) + +(defvar url-mime-charset-string (url-mime-charset-string) + "*String to send in the Accept-charset: field in HTTP requests. +The MIME charset corresponding to the most preferred coding system is +given priority 1 and the rest are given priority 0.5.") + +(defun url-set-mime-charset-string () + (setq url-mime-charset-string (url-mime-charset-string))) +;; Regenerate if the language environment changes. +(add-hook 'set-language-environment-hook 'url-set-mime-charset-string) + +;; Fixme: set from the locale. +(defcustom url-mime-language-string nil + "*String to send in the Accept-language: field in HTTP requests. + +Specifies the preferred language when servers can serve documents in +several languages. Use RFC 1766 abbreviations, e.g.@: `en' for +English, `de' for German. A comma-separated specifies descending +order of preference. The ordering can be made explicit using `q' +factors defined by HTTP, e.g. `de,en-gb;q=0.8,en;q=0.7'. `*' means +get the first available language (as opposed to the default)." + :type '(radio + (const :tag "None (get default language version)" :value nil) + (const :tag "Any (get first available language version)" :value "*") + (string :tag "Other")) + :group 'url-mime + :group 'i18n) + +(defvar url-mime-accept-string nil + "String to send to the server in the Accept: field in HTTP requests.") + +(defvar url-package-version nil + "Version number of package using URL.") + +(defvar url-package-name nil "Version number of package using URL.") + +(defvar url-system-type nil + "What type of system we are on.") +(defvar url-os-type nil + "What OS we are on.") + +(defcustom url-max-password-attempts 5 + "*Maximum number of times a password will be prompted for. +Applies when a protected document is denied by the server." + :type 'integer + :group 'url) + +(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") + "*Where temporary files go." + :type 'directory + :group 'url-file) + +(defcustom url-show-status t + "*Whether to show a running total of bytes transferred. +Can cause a large hit if using a remote X display over a slow link, or +a terminal with a slow modem." + :type 'boolean + :group 'url) + +(defvar url-using-proxy nil + "Either nil or the fully qualified proxy URL in use, e.g. +http://www.domain.com/") + +(defcustom url-news-server nil + "*The default news server from which to get newsgroups/articles. +Applies if no server is specified in the URL. Defaults to the +environment variable NNTPSERVER or \"news\" if NNTPSERVER is +undefined." + :type '(choice (const :tag "None" :value nil) string) + :group 'url) + +(defvar url-nonrelative-link + "\\`\\([-a-zA-Z0-9+.]+:\\)" + "A regular expression that will match an absolute URL.") + +(defcustom url-confirmation-func 'y-or-n-p + "*What function to use for asking yes or no functions. +Possible values are `yes-or-no-p' or `y-or-n-p', or any function that +takes a single argument (the prompt), and returns t only if a positive +answer is given." + :type '(choice (const :tag "Short (y or n)" :value y-or-n-p) + (const :tag "Long (yes or no)" :value yes-or-no-p) + (function :tag "Other")) + :group 'url-hairy) + +(defcustom url-gateway-method 'native + "*The type of gateway support to use. +Should be a symbol specifying how to get a connection from the local machine. + +Currently supported methods: +`telnet': Run telnet in a subprocess to connect; +`rlogin': Rlogin to another machine to connect; +`socks': Connect through a socks server; +`tls': Connect with TLS; +`ssl': Connect with SSL (deprecated, use `tls' instead); +`native': Connect directy." + :type '(radio (const :tag "Telnet to gateway host" :value telnet) + (const :tag "Rlogin to gateway host" :value rlogin) + (const :tag "Use SOCKS proxy" :value socks) + (const :tag "Use SSL/TLS for all connections" :value tls) + (const :tag "Use SSL for all connections (obsolete)" :value ssl) + (const :tag "Direct connection" :value native)) + :group 'url-hairy) + +(defvar url-setup-done nil "Has setup configuration been done?") + +(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) + +;; Fixme: We may not be able to run SSL. +(defvar url-extensions-header "Security/Digest Security/SSL") + +(defvar url-parse-syntax-table + (copy-syntax-table emacs-lisp-mode-syntax-table) + "*A syntax table for parsing URLs.") + +(modify-syntax-entry ?' "\"" url-parse-syntax-table) +(modify-syntax-entry ?` "\"" url-parse-syntax-table) +(modify-syntax-entry ?< "(>" url-parse-syntax-table) +(modify-syntax-entry ?> ")<" url-parse-syntax-table) +(modify-syntax-entry ?/ " " url-parse-syntax-table) + +(defvar url-load-hook nil + "*Hooks to be run after initalizing the URL library.") + +;;; Make OS/2 happy - yeeks +;; (defvar tcp-binary-process-input-services nil +;; "*Make OS/2 happy with our CRLF pairs...") + +(defconst url-working-buffer " *url-work") + +(defvar url-gateway-unplugged nil + "Non-nil means don't open new network connexions. +This should be set, e.g. by mail user agents rendering HTML to avoid +`bugs' which call home.") + +(defun url-vars-unload-hook () + (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string)) + +(provide 'url-vars) + +;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49 +;;; url-vars.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url.el Thu Oct 14 08:50:09 2004 +0000 @@ -0,0 +1,269 @@ +;;; url.el --- Uniform Resource Locator retrieval tool + +;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. + +;; Author: Bill Perry <wmperry@gnu.org> +;; Keywords: comm, data, processes, hypermedia + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes + +;;; Code: + +(eval-when-compile (require 'cl)) +;; Don't require CL at runtime if we can avoid it (Emacs 21). +;; Otherwise we need it for hashing functions. `puthash' was never +;; defined in the Emacs 20 cl.el for some reason. +(if (fboundp 'puthash) + nil ; internal or CL is loaded + (defalias 'puthash 'cl-puthash) + (autoload 'cl-puthash "cl") + (autoload 'gethash "cl") + (autoload 'maphash "cl") + (autoload 'make-hash-table "cl")) + +(eval-when-compile + (require 'mm-decode) + (require 'mm-view)) + +(require 'mailcap) +(require 'url-vars) +(require 'url-cookie) +(require 'url-history) +(require 'url-expand) +(require 'url-privacy) +(require 'url-methods) +(require 'url-proxy) +(require 'url-parse) +(require 'url-util) + +;; Fixme: customize? convert-standard-filename? +;;;###autoload +(defvar url-configuration-directory "~/.url") + +(defun url-do-setup () + "Setup the url package. +This is to avoid conflict with user settings if URL is dumped with +Emacs." + (unless url-setup-done + + ;; Make OS/2 happy + ;;(push '("http" "80") tcp-binary-process-input-services) + + (mailcap-parse-mailcaps) + (mailcap-parse-mimetypes) + + ;; Register all the authentication schemes we can handle + (url-register-auth-scheme "basic" nil 4) + (url-register-auth-scheme "digest" nil 7) + + (setq url-cookie-file + (or url-cookie-file + (expand-file-name "cookies" url-configuration-directory))) + + (setq url-history-file + (or url-history-file + (expand-file-name "history" url-configuration-directory))) + + ;; Parse the global history file if it exists, so that it can be used + ;; for URL completion, etc. + (url-history-parse-history) + (url-history-setup-save-timer) + + ;; Ditto for cookies + (url-cookie-setup-save-timer) + (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 + (lambda (x) + (cond + ((= x ?,) "\\|") + ((= x ? ) "") + ((= x ?.) (regexp-quote ".")) + ((= x ?*) ".*") + ((= x ??) ".") + (t (char-to-string x)))) + noproxy "") "\\)")) + url-proxy-services)))) + + ;; Set the password entry funtion based on user defaults or guess + ;; based on which remote-file-access package they are using. + (cond + (url-passwd-entry-func nil) ; Already been set + ((fboundp 'read-passwd) ; Use secure password if available + (setq url-passwd-entry-func 'read-passwd)) + ((or (featurep 'efs) ; Using EFS + (featurep 'efs-auto)) ; or autoloading efs + (if (not (fboundp 'read-passwd)) + (autoload 'read-passwd "passwd" "Read in a password" nil)) + (setq url-passwd-entry-func 'read-passwd)) + ((or (featurep 'ange-ftp) ; Using ange-ftp + (and (boundp 'file-name-handler-alist) + (not (featurep 'xemacs)))) ; ?? + (setq url-passwd-entry-func 'ange-ftp-read-passwd)) + (t + (url-warn + 'security + "(url-setup): Can't determine how to read passwords, winging it."))) + + (url-setup-privacy-info) + (run-hooks 'url-load-hook) + (setq url-setup-done t))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Retrieval functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun url-retrieve (url callback &optional cbargs) + "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. +The callback is called when the object has been completely retrieved, with +the current buffer containing the object, and any MIME headers associated +with it. URL is either a string or a parsed URL. + +Return the buffer URL will load into, or nil if the process has +already completed." + (url-do-setup) + (url-gc-dead-buffers) + (if (stringp url) + (set-text-properties 0 (length url) nil url)) + (if (not (vectorp url)) + (setq url (url-generic-parse-url url))) + (if (not (functionp callback)) + (error "Must provide a callback function to url-retrieve")) + (unless (url-type url) + (error "Bad url: %s" (url-recreate-url url))) + (let ((loader (url-scheme-get-property (url-type url) 'loader)) + (url-using-proxy (if (url-host url) + (url-find-proxy-for-url url (url-host url)))) + (buffer nil) + (asynch (url-scheme-get-property (url-type url) 'asynchronous-p))) + (if url-using-proxy + (setq asynch t + loader 'url-proxy)) + (if asynch + (setq buffer (funcall loader url callback cbargs)) + (setq buffer (funcall loader url)) + (if buffer + (with-current-buffer buffer + (apply callback cbargs)))) + (url-history-update-url url (current-time)) + buffer)) + +(defun url-retrieve-synchronously (url) + "Retrieve URL synchronously. +Return the buffer containing the data, or nil if there are no data +associated with it (the case for dired, info, or mailto URLs that need +no further processing). URL is either a string or a parsed URL." + (url-do-setup) + + (lexical-let ((retrieval-done nil) + (asynch-buffer nil)) + (setq asynch-buffer + (url-retrieve url (lambda (&rest ignored) + (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) + (setq retrieval-done t + asynch-buffer (current-buffer))))) + (if (not asynch-buffer) + ;; We do not need to do anything, it was a mailto or something + ;; similar that takes processing completely outside of the URL + ;; package. + nil + (while (not retrieval-done) + (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" + retrieval-done asynch-buffer) + ;; Quoth Stef: + ;; It turns out that the problem seems to be that the (sit-for + ;; 0.1) below doesn't actually process the data: instead it + ;; returns immediately because there is keyboard input + ;; waiting, so we end up spinning endlessly waiting for the + ;; process to finish while not letting it finish. + + ;; However, raman claims that it blocks Emacs with Emacspeak + ;; for unexplained reasons. Put back for his benefit until + ;; someone can understand it. + ;; (sleep-for 0.1) + (sit-for 0.1)) + asynch-buffer))) + +(defun url-mm-callback (&rest ignored) + (let ((handle (mm-dissect-buffer t))) + (save-excursion + (url-mark-buffer-as-dead (current-buffer)) + (set-buffer (generate-new-buffer (url-recreate-url url-current-object))) + (if (eq (mm-display-part handle) 'external) + (progn + (set-process-sentinel + ;; Fixme: this shouldn't have to know the form of the + ;; undisplayer produced by `mm-display-part'. + (get-buffer-process (cdr (mm-handle-undisplayer handle))) + `(lambda (proc event) + (mm-destroy-parts (quote ,handle)))) + (message "Viewing externally") + (kill-buffer (current-buffer))) + (display-buffer (current-buffer)) + (mm-destroy-parts handle))))) + +(defun url-mm-url (url) + "Retrieve URL and pass to the appropriate viewing application." + (require 'mm-decode) + (require 'mm-view) + (url-retrieve url 'url-mm-callback nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Miscellaneous +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar url-dead-buffer-list nil) + +(defun url-mark-buffer-as-dead (buff) + (push buff url-dead-buffer-list)) + +(defun url-gc-dead-buffers () + (let ((buff)) + (while (setq buff (pop url-dead-buffer-list)) + (if (buffer-live-p buff) + (kill-buffer buff))))) + +(cond + ((fboundp 'display-warning) + (defalias 'url-warn 'display-warning)) + ((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) + (with-current-buffer (get-buffer-create "*URL-WARNINGS*") + (goto-char (point-max)) + (save-excursion + (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) + (display-buffer (current-buffer)))))) + +(provide 'url) + +;; arch-tag: bc182f1f-d187-4f10-b961-47af2066579a +;;; url.el ends here
--- a/lisp/vc.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/vc.el Thu Oct 14 08:50:09 2004 +0000 @@ -646,9 +646,6 @@ :group 'vc) ;; vc-annotate functionality (CVS only). -(defvar vc-annotate-mode nil - "Variable indicating if VC-Annotate mode is active.") - (defvar vc-annotate-mode-map (let ((m (make-sparse-keymap))) (define-key m [menu-bar] (make-sparse-keymap "VC-Annotate")) @@ -3004,7 +3001,7 @@ (when buffer (set-buffer buffer) (display-buffer buffer)) - (if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done + (if (not vc-annotate-parent-rev) (vc-annotate-mode)) (cond ((null vc-annotate-display-mode) (vc-annotate-display-default vc-annotate-ratio))
--- a/lisp/xml.el Wed Oct 13 02:40:50 2004 +0000 +++ b/lisp/xml.el Thu Oct 14 08:50:09 2004 +0000 @@ -598,8 +598,8 @@ nil) (t (if xml-validating-parser - error "XML: (Validity) Invalid element type in the DTD"))) - + (error "XML: (Validity) Invalid element type in the DTD")))) + ;; rule [45]: the element declaration must be unique (if (and (assoc element dtd) xml-validating-parser) @@ -727,14 +727,9 @@ (match-string 1 this-part))))))) (cond ((null children) - (if (stringp expansion) - (setq children (concat prev-part expansion)) - (if (stringp (car (last expansion))) - (progn - (setq children - (list (concat prev-part (car expansion)) - (cdr expansion)))) - (setq children (append expansion prev-part))))) + ;; FIXME: If we have an entity that expands into XML, this won't work. + (setq children + (concat prev-part expansion))) ((stringp children) (if (stringp expansion) (setq children (concat children prev-part expansion)) @@ -756,11 +751,15 @@ (cond ((stringp children) (concat children (substring string point))) ((stringp (car (last children))) - (concat (car children) (substring string point))) + (concat (car (last children)) (substring string point))) ((null children) string) (t - (nreverse children))))) + (concat (mapconcat 'identity + (nreverse children) + "") + (substring string point)))))) + ;;******************************************************************* ;;** ;;** Printing a tree.
--- a/lispintro/emacs-lisp-intro.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/lispintro/emacs-lisp-intro.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1,6 +1,7 @@ -@c \input texinfo @c -*-texinfo-*- +\input texinfo @c -*-texinfo-*- @comment %**start of header @setfilename ../info/eintr +@c setfilename emacs-lisp-intro.info @c sethtmlfilename emacs-lisp-intro.html @settitle Programming in Emacs Lisp @syncodeindex vr cp @@ -21,8 +22,8 @@ @comment %**end of header -@set edition-number 2.12 -@set update-date 2003 Nov 19 +@set edition-number 2.14 +@set update-date 2004 Oct 12 @ignore ## Summary of shell commands to create various output formats: @@ -61,6 +62,8 @@ ## View Info output with standalone reader info emacs-lisp-intro.info + ## popd + @end ignore @c ================ Included Figures ================ @@ -180,7 +183,7 @@ Edition @value{edition-number}, @value{update-date} @sp 1 Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1997, 2001, -2002, 2003 Free Software Foundation, Inc. +2002, 2003, 2004 Free Software Foundation, Inc. @sp 1 @iftex @@ -1050,13 +1053,16 @@ @chapter List Processing To the untutored eye, Lisp is a strange programming language. In Lisp -code there are parentheses everywhere. Some people even claim that the -name stands for `Lots of Isolated Silly Parentheses'. But the claim is -unwarranted. Lisp stands for LISt Processing, and the programming -language handles @emph{lists} (and lists of lists) by putting them -between parentheses. The parentheses mark the boundaries of the list. -Sometimes a list is preceded by a single apostrophe or quotation mark, -@samp{'}. Lists are the basis of Lisp. +code there are parentheses everywhere. Some people even claim that +the name stands for `Lots of Isolated Silly Parentheses'. But the +claim is unwarranted. Lisp stands for LISt Processing, and the +programming language handles @emph{lists} (and lists of lists) by +putting them between parentheses. The parentheses mark the boundaries +of the list. Sometimes a list is preceded by a single apostrophe or +quotation mark, @samp{'}@footnote{The single apostrophe or quotation +mark is an abbreviation for the function @code{quote}; you need not +think about functions now; functions are defined in @ref{Making +Errors, , Generate an Error Message}.} Lists are the basis of Lisp. @menu * Lisp Lists:: What are lists? @@ -2135,7 +2141,8 @@ @need 1250 As usual, the error message tries to be helpful and makes sense after you -learn how to read it. +learn how to read it.@footnote{@code{(quote hello)} is an expansion of +the abbreviation @code{'hello}.} The first part of the error message is straightforward; it says @samp{wrong type argument}. Next comes the mysterious jargon word @@ -4002,7 +4009,7 @@ false. When this happens, the second argument or then-part of the overall @code{if} expression is @emph{not} evaluated, but the third or else-part @emph{is} evaluated. You might think of this as the cloudy -day alternative for the decision `if it is warm and sunny, then go to +day alternative for the decision ``if it is warm and sunny, then go to the beach, else read a book!''. The word ``else'' is not written in the Lisp code; the else-part of an @@ -14924,10 +14931,10 @@ ((eq t (car (cdr (car current-directory-list)))) ;; decide whether to skip or recurse (if - (equal (or "." "..") + (equal "." (substring (car (car current-directory-list)) -1)) - ;; then do nothing if filename is that of - ;; current directory or parent + ;; then do nothing since filename is that of + ;; current directory or parent, "." or ".." () @end group @group @@ -17118,7 +17125,7 @@ @item Ignore case when using `grep'@* @samp{-n}@w{ } Prefix each line of output with line number@* @samp{-i}@w{ } Ignore case distinctions@* -@samp{-e}@w{ } Protect patterns beginning with a hyphen character, @samp{-} +@samp{-e}@w{ } Protect patterns beginning with a hyphen character, @samp{-} @smallexample (setq grep-command "grep -n -i -e ") @@ -17159,7 +17166,7 @@ @end itemize @subsubheading Fixing Unpleasant Key Bindings -@cindex Key bindings, fixing +@cindex Key bindings, fixing @cindex Bindings, key, fixing unpleasant Some systems bind keys unpleasantly. Sometimes, for example, the @@ -18018,7 +18025,7 @@ Sometimes when you you write text, you duplicate words---as with ``you you'' near the beginning of this sentence. I find that most -frequently, I duplicate ``the'; hence, I call the function for +frequently, I duplicate ``the''; hence, I call the function for detecting duplicated words, @code{the-the}. @need 1250 @@ -20638,6 +20645,7 @@ @end smallexample @end ifnottex +@c qqq @ignore Graphing Definitions Re-listed @@ -21137,6 +21145,7 @@ (print-X-axis numbers-list horizontal-step))) @end group @end smallexample +@c qqq @end ignore @page
--- a/lispref/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/lispref/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,21 @@ +2004-10-09 Luc Teirlinck <teirllm@auburn.edu> + + * text.texi (Filling): Add anchor for definition of + `sentence-end-double-space'. + + * searching.texi (Regexp Example): Update description of how + Emacs currently recognizes the end of a sentence. + (Standard Regexps): Update definition of the variable + `sentence-end'. Add definition of the function `sentence-end'. + +2004-10-08 Paul Pogonyshev <pogonyshev@gmx.net> + + * display.texi (Progress): New node. + +2004-10-05 Kim F. Storm <storm@cua.dk> + + * display.texi (Fringe Bitmaps): Update fringe-bitmaps-at-pos. + 2004-09-29 Kim F. Storm <storm@cua.dk> * display.texi (Fringe Bitmaps): Use symbols rather than numbers
--- a/lispref/display.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/lispref/display.texi Thu Oct 14 08:50:09 2004 +0000 @@ -16,6 +16,7 @@ * Truncation:: Folding or wrapping long text lines. * The Echo Area:: Where messages are displayed. * Warnings:: Displaying warning messages for the user. +* Progress:: Informing user about progress of a long operation. * Invisible Text:: Hiding part of the buffer text. * Selective Display:: Hiding part of the buffer text (the old way). * Overlay Arrow:: Display of an arrow to indicate position. @@ -533,6 +534,104 @@ that warning is not logged. @end defopt +@node Progress +@section Reporting Operation Progress +@cindex progress reporting + +When an operation can take a while to finish, you should inform the +user about the progress it makes. This way the user can estimate +remaining time and clearly see that Emacs is busy working, not hung. + +Functions listed in this section provide simple and efficient way of +reporting operation progress. Here is a working example that does +nothing useful: + +@example +(let ((progress-reporter + (make-progress-reporter "Collecting some mana for Emacs..." + 0 500))) + (dotimes (k 500) + (sit-for 0.01) + (progress-reporter-update progress-reporter k)) + (progress-reporter-done progress-reporter)) +@end example + +@defun make-progress-reporter message min-value max-value &optional current-value min-change min-time +This function creates a progress reporter---the object you will use as +an argument for all other functions listed here. The idea is to +precompute as much data as possible to make progress reporting very +fast. + +The @var{message} will be displayed in the echo area, followed by +progress percentage. @var{message} is treated as a simple string. If +you need it to depend on a filename, for instance, use @code{format} +before calling this function. + +@var{min-value} and @var{max-value} arguments stand for starting and +final states of your operation. For instance, if you scan a buffer, +they should be the results of @code{point-min} and @code{point-max} +correspondingly. It is required that @var{max-value} is greater than +@var{min-value}. If you create progress reporter when some part of +the operation has already been completed, then specify +@var{current-value} argument. But normally you should omit it or set +it to @code{nil}---it will default to @var{min-value} then. + +Remaining arguments control the rate of echo area updates. Progress +reporter will wait for at least @var{min-change} more percents of the +operation to be completed before printing next message. +@var{min-time} specifies the minimum time in seconds to pass between +successive prints. It can be fractional. Depending on Emacs and +system capabilities, progress reporter may or may not respect this +last argument or do it with varying precision. Default value for +@var{min-change} is 1 (one percent), for @var{min-time}---0.2 +(seconds.) + +This function calls @code{progress-reporter-update}, so the first +message is printed immediately. +@end defun + +@defun progress-reporter-update reporter value +This function does the main work of reporting progress of your +operation. It print the message of @var{reporter} followed by +progress percentage determined by @var{value}. If percentage is zero, +then it is not printed at all. + +@var{reporter} must be the result of a call to +@code{make-progress-reporter}. @var{value} specifies the current +state of your operation and must be between @var{min-value} and +@var{max-value} (inclusive) as passed to +@code{make-progress-reporter}. For instance, if you scan a buffer, +then @var{value} should be the result of a call to @code{point}. + +This function respects @var{min-change} and @var{min-time} as passed +to @code{make-progress-reporter} and so does not output new messages +on every invocation. It is thus very fast and normally you should not +try to reduce the number of calls to it: resulting overhead will most +likely negate your effort. +@end defun + +@defun progress-reporter-force-update reporter value &optional new-message +This function is similar to @code{progress-reporter-update} except +that it prints a message in the echo area unconditionally. + +The first two arguments have the same meaning as for +@code{progress-reporter-update}. Optional @var{new-message} allows +you to change the message of the @var{reporter}. Since this functions +always updates the echo area, such a change will be immediately +presented to the user. +@end defun + +@defun progress-reporter-done reporter +This function should be called when the operation is finished. It +prints the message of @var{reporter} followed by word ``done'' in the +echo area. + +You should always call this function and not hope for +@code{progress-reporter-update} to print ``100%.'' Firstly, it may +never print it, there are many good reasons for this not to happen. +Secondly, ``done'' is more explicit. +@end defun + @node Invisible Text @section Invisible Text @@ -2655,9 +2754,10 @@ @defun fringe-bitmaps-at-pos &optional pos window This function returns the fringe bitmaps of the display line containing position @var{pos} in window @var{window}. The return -value has the form @code{(@var{left} . @var{right})}, where @var{left} +value has the form @code{(@var{left} @var{right} @var{ov})}, where @var{left} is the symbol for the fringe bitmap in the left fringe (or @code{nil} -if no bitmap), and @var{right} is similar for the right fringe. +if no bitmap), @var{right} is similar for the right fringe, and @var{ov} +is non-@code{nil} if there is an overlay arrow in the left fringe. The value is @code{nil} if @var{pos} is not visible in @var{window}. If @var{window} is @code{nil}, that stands for the selected window.
--- a/lispref/searching.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/lispref/searching.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999 +@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2004 @c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../info/searching @@ -694,9 +694,9 @@ Here is a complicated regexp which was formerly used by Emacs to recognize the end of a sentence together with any whitespace that -follows. It was used as the variable @code{sentence-end}. (Its value -nowadays contains alternatives for @samp{.}, @samp{?} and @samp{!} in -other character sets.) +follows. (Nowadays Emacs uses a similar but more complex default +regexp constructed by the function @code{sentence-end}. +@xref{Standard Regexps}.) First, we show the regexp as a string in Lisp syntax to distinguish spaces from tab characters. The string constant begins and ends with a @@ -730,9 +730,9 @@ The first part of the pattern is a character alternative that matches any one of three characters: period, question mark, and exclamation mark. The match must begin with one of these three characters. (This -is the one point where the new value of @code{sentence-end} differs -from the old. The new value also lists sentence ending -non-@acronym{ASCII} characters.) +is one point where the new default regexp used by Emacs differs from +the old. The new value also allows some non-@acronym{ASCII} +characters that end a sentence without any following whitespace.) @item []\"')@}]* The second part of the pattern matches any closing braces and quotation @@ -1698,22 +1698,24 @@ @end defvar @defvar sentence-end -This is the regular expression describing the end of a sentence. (All -paragraph boundaries also end sentences, regardless.) The (slightly -simplified) default value is: - -@example -"[.?!][]\"')@}]*\\($\\| $\\|\t\\|@ @ \\)[ \t\n]*" -@end example +If non-@code{nil}, the value should be a regular expression describing +the end of a sentence, including the whitespace following the +sentence. (All paragraph boundaries also end sentences, regardless.) -This means a period, question mark or exclamation mark (the actual -default value also lists their alternatives in other character sets), -followed optionally by closing parenthetical characters, followed by -tabs, spaces or new lines. +If the value is @code{nil}, the default, then the function +@code{sentence-end} has to construct the regexp. That is why you +should always call the function @code{sentence-end} to obtain the +regexp to be used to recognize the end of a sentence. +@end defvar -For a detailed explanation of this regular expression, see @ref{Regexp -Example}. -@end defvar +@defun sentence-end +This function returns the value of the variable @code{sentence-end}, +if non-@code{nil}. Otherwise it returns a default value based on the +values of the variables @code{sentence-end-double-space} +(@pxref{Definition of sentence-end-double-space}), +@code{sentence-end-without-period} and +@code{sentence-end-without-space}. +@end defun @ignore arch-tag: c2573ca2-18aa-4839-93b8-924043ef831f
--- a/lispref/text.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/lispref/text.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1,6 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2000, 2001 +@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, +@c 2000, 2001, 2004 @c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../info/text @@ -1448,6 +1449,7 @@ @end defun @defopt sentence-end-double-space +@anchor{Definition of sentence-end-double-space} If this variable is non-@code{nil}, a period followed by just one space does not count as the end of a sentence, and the filling functions avoid breaking the line at such a place.
--- a/man/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/man/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,90 @@ +2004-10-12 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-faq.texi ([5.9]): Improve code for reply-in-news. + +2004-10-12 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.0.45. + + * tramp.texi (Frequently Asked Questions): Comment paragraph about + plink link. The URL is outdated. Originator contacted for + clarification. + +2004-10-10 Juri Linkov <juri@jurta.org> + + * gnus.texi (Top, Marking Articles): Join two menus in one node + because a node can have only one menu. + +2004-10-09 Luc Teirlinck <teirllm@auburn.edu> + + * files.texi (Misc File Ops): View mode is a minor mode. + +2004-10-09 Juri Linkov <juri@jurta.org> + + * gnus.texi (Fancy Mail Splitting): Remove backslash in the + example of nnmail-split-fancy. + +2004-10-08 Glenn Morris <gmorris@ast.cam.ac.uk> + + * calendar.texi (iCalendar): Style changes. + +2004-10-07 Luc Teirlinck <teirllm@auburn.edu> + + * search.texi (Regexps): The regexp described in the example is no + longer stored in the variable `sentence-end'. + +2004-10-06 Karl Berry <karl@gnu.org> + + * info.texi (@kbd{1}--@kbd{9}): no space around --, for + consistency with other uses of dashes. + +2004-10-06 Nick Roberts <nickrob@snap.net.nz> + + * building.texi (Starting GUD): Note that multiple debugging + sessions requires `gdb --fullname'. + +2004-10-05 Ulf Jasper <ulf.jasper@web.de> + + * calendar.texi (iCalendar): New section for a new package. + +2004-10-05 Karl Berry <karl@gnu.org> + + * info.texi: consistently use --- throughout, periods at end of + menu descriptions, and a couple typos. + +2004-10-05 Luc Teirlinck <teirllm@auburn.edu> + + * text.texi: Various small changes in addition to the following. + (Text): Replace xref for autotype with inforef. + (Sentences): Explain nil value for `sentence-end'. + (Paragraphs): Update default values for `paragraph-start' and + `paragraph-separate'. + (Text Mode): Correct description of Text mode's effect on the + syntax table. + (Outline Visibility): `hide-other' does not hide top level headings. + `selective-display-ellipses' no longer has an effect on Outline mode. + (TeX Misc): Add missing @cindex. + Replace xref for RefTeX with inforef. + (Requesting Formatted Text): the variable + `enriched-fill-after-visiting' no longer exists. + (Editing Format Info): Update names of menu items and commands. + (Format Faces): Mention special effect of specifying the default face. + Describe inheritance of text properties. + Correct description of `fixed' face. + (Format Indentation): Correct description of effect of setting + margins. Mention `set-left-margin' and `set-right-margin'. + (Format Justification): Update names of menu items. + `set-justification-full' is now bound to `M-j b'. + Mention that `default-justification' is a per buffer variable. + (Format Properties): Update name of menu item. + (Forcing Enriched Mode): `format-decode-buffer' automatically + turns on Enriched mode if the buffer is in text/enriched format. + + +2004-10-05 Emilio C. Lopes <eclig@gmx.net> + + * calendar.texi (From Other Calendar): Add calendar-goto-iso-week. + 2004-09-28 Kim F. Storm <storm@cua.dk> * display.texi (Display Custom) <indicate-buffer-boundaries>: @@ -893,7 +980,7 @@ * misc.texi: Section "Saving Emacs Sessions" rewritten. -2003-09-29 Jan D. <jhd@gaffa.gaia.swipnet.se> +2003-09-29 Jan Dj,Ad(Brv. <jan.h.d@swipnet.se> * xresources.texi (GTK names in Emacs): Correct typo.
--- a/man/building.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/building.texi Thu Oct 14 08:50:09 2004 +0000 @@ -336,11 +336,13 @@ @findex gdb Run GDB as a subprocess of Emacs. If the variable @code{gud-gdb-command-name} is ``gdb --annotate=3'' (the default -value) then GDB starts as for @kbd{M-x gdba} below. If you want to -GDB to start as in Emacs 21.3 and earlier then set -@code{gud-gdb-command-name} to ``gdb --fullname''. In this case, the -command creates a buffer for input and output to GDB, and switches to -it. If a GDB buffer already exists, it just switches to that buffer. +value) then GDB starts as for @kbd{M-x gdba} below. If you want GDB +to start as in Emacs 21.3 and earlier then edit the string in the +minibuffer or set @code{gud-gdb-command-name} to ``gdb --fullname''. +You need to do this if you want to run multiple debugging sessions +within one Emacs session. In this case, the command creates a buffer +for input and output to GDB, and switches to it. If a GDB buffer +already exists, it just switches to that buffer. @item M-x gdba @key{RET} @var{file} @key{RET} Run GDB as a subprocess of Emacs, providing a graphical interface
--- a/man/calc.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/calc.texi Thu Oct 14 08:50:09 2004 +0000 @@ -10026,19 +10026,17 @@ @kindex h f @pindex calc-describe-function The @kbd{h f} (@code{calc-describe-function}) command looks up an -algebraic function or a command name in the Calc manual. The -prompt initially contains @samp{calcFunc-}; follow this with an +algebraic function or a command name in the Calc manual. Enter an algebraic function name to look up that function in the Function -Index. Or, backspace and enter a command name beginning with -@samp{calc-} to look it up in the Command Index. This command -will also look up operator symbols that can appear in algebraic -formulas, like @samp{%} and @samp{=>}. +Index or enter a command name beginning with @samp{calc-} to look it +up in the Command Index. This command will also look up operator +symbols that can appear in algebraic formulas, like @samp{%} and +@samp{=>}. @kindex h v @pindex calc-describe-variable The @kbd{h v} (@code{calc-describe-variable}) command looks up a -variable in the Calc manual. The prompt initially contains the -@samp{var-} prefix; just add a variable name like @code{pi} or +variable in the Calc manual. Enter a variable name like @code{pi} or @code{PlotRejects}. @kindex h b @@ -21981,7 +21979,7 @@ The most basic default simplification is the evaluation of functions. For example, @cite{2 + 3} is evaluated to @cite{5}, and @cite{@t{sqrt}(9)} is evaluated to @cite{3}. Evaluation does not occur if the arguments -to a function are somehow of the wrong type (@cite{@t{tan}([2,3,4])}, +to a function are somehow of the wrong type (@cite{@t{tan}([2,3,4])}), range (@cite{@t{tan}(90)}), or number (@cite{@t{tan}(3,5)}), or if the function name is not recognized (@cite{@t{f}(5)}), or if ``symbolic'' mode (@pxref{Symbolic Mode}) prevents evaluation (@cite{@t{sqrt}(2)}).
--- a/man/calendar.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/calendar.texi Thu Oct 14 08:50:09 2004 +0000 @@ -37,6 +37,7 @@ * Other Calendars:: Converting dates to other calendar systems. * Diary:: Displaying events from your diary. * Appointments:: Reminders when it's time to do something. +* iCalendar:: Converting diary events to/from iCalendar format. * Daylight Savings:: How to specify when daylight savings time is active. * Time Intervals:: Keeping track of time intervals. @end menu @@ -754,6 +755,7 @@ @kindex g @var{char} @r{(Calendar mode)} @findex calendar-goto-iso-date +@findex calendar-goto-iso-week @findex calendar-goto-julian-date @findex calendar-goto-astro-day-number @findex calendar-goto-hebrew-date @@ -767,6 +769,9 @@ @item g c Move to a date specified in the ISO commercial calendar (@code{calendar-goto-iso-date}). +@item g w +Move to a week specified in the ISO commercial calendar +(@code{calendar-goto-iso-week}). @item g j Move to a date specified in the Julian calendar (@code{calendar-goto-julian-date}). @@ -1379,6 +1384,55 @@ list without affecting your diary file. You delete entries from the appointment list with @kbd{M-x appt-delete}. +@node iCalendar +@section iCalendar +@cindex iCalendar support + + The icalendar package aims at providing an implementation of the +iCalendar standard, as defined in ``RFC 2445 -- Internet Calendaring and +Scheduling Core Object Specification (iCalendar)''. It provides a means +for importing iCalendar (and the earlier vCalendar format) data into +Emacs diary files and vice versa. + + Importing works for ``ordinary'' (i.e. non-recurring) events, but (at +present) may not work correctly (if at all) for recurring events. +Exporting of diary files into iCalendar files should work correctly for +most diary entries. Please note that @file{icalendar.el} is work in +progress, so usage may evolve in future. + + To activate the package, use @code{(require 'icalendar)}. + +@findex icalendar-extract-ical-from-buffer + The command @code{icalendar-extract-ical-from-buffer} extracts +iCalendar data from the current buffer and adds it to your (default) +diary file. This function is also suitable for automatic extraction of +iCalendar data; for example with the Rmail mail client one could use: + +@example +(add-hook 'rmail-show-message-hook 'icalendar-extract-ical-from-buffer) +@end example + +@findex icalendar-import-file + The command @code{icalendar-import-file} imports an iCalendar file. +@strong{Caution:} the contents of the target diary file are +@emph{deleted} by default! It is highly recommended to use a dedicated +diary file for importing. For example: + +@example +(icalendar-import-file "/here/is/calendar.ics" "/there/goes/ical-diary") +@end example + +@noindent +You can use an @code{#include} directive to add the import file contents +to the diary. @xref{Fancy Diary Display,,, elisp, The Emacs Lisp +Reference Manual}. + +@findex icalendar-convert-diary-to-ical + The command @code{icalendar-convert-diary-to-ical} exports an Emacs +diary file to iCalendar format. @strong{Caution:} the contents of the +target file are @emph{deleted} by default! + + @node Daylight Savings @section Daylight Savings Time @cindex daylight savings time
--- a/man/files.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/files.texi Thu Oct 14 08:50:09 2004 +0000 @@ -2858,7 +2858,7 @@ for moving around in the file, but none for changing it; type @kbd{?} while viewing for a list of them. They are mostly the same as normal Emacs cursor motion commands. To exit from viewing, type @kbd{q}. -The commands for viewing are defined by a special major mode called View +The commands for viewing are defined by a special minor mode called View mode. A related command, @kbd{M-x view-buffer}, views a buffer already present
--- a/man/gnus-faq.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/gnus-faq.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1776,11 +1776,14 @@ @example -(defadvice gnus-summary-reply (around reply-in-news activate) +(eval-after-load "gnus-msg" + '(unless (boundp 'gnus-confirm-mail-reply-to-news) + (defadvice gnus-summary-reply (around reply-in-news activate) + "Request confirmation when replying to news." (interactive) - (when (or (not (gnus-news-group-p gnus-newsgroup-name)) - (y-or-n-p "Really reply? ")) - ad-do-it)) + (when (or (not (gnus-news-group-p gnus-newsgroup-name)) + (y-or-n-p "Really reply by mail to article author? ")) + ad-do-it)))) @end example @ifnottex
--- a/man/gnus.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/gnus.texi Thu Oct 14 08:50:09 2004 +0000 @@ -535,12 +535,9 @@ * Unread Articles:: Marks for unread articles. * Read Articles:: Marks for read articles. * Other Marks:: Marks that do not affect readedness. - -Marking Articles - -* Setting Marks:: How to set and remove marks. -* Generic Marking Commands:: How to customize the marking. -* Setting Process Marks:: How to mark articles for later processing. +* Setting Marks:: How to set and remove marks. +* Generic Marking Commands:: How to customize the marking. +* Setting Process Marks:: How to mark articles for later processing. Threading @@ -5686,20 +5683,17 @@ In addition, you also have marks that do not affect readedness. +@ifinfo +There's a plethora of commands for manipulating these marks. +@end ifinfo + @menu * Unread Articles:: Marks for unread articles. * Read Articles:: Marks for read articles. * Other Marks:: Marks that do not affect readedness. -@end menu - -@ifinfo -There's a plethora of commands for manipulating these marks: -@end ifinfo - -@menu -* Setting Marks:: How to set and remove marks. -* Generic Marking Commands:: How to customize the marking. -* Setting Process Marks:: How to mark articles for later processing. +* Setting Marks:: How to set and remove marks. +* Generic Marking Commands:: How to customize the marking. +* Setting Process Marks:: How to mark articles for later processing. @end menu @@ -14002,7 +13996,7 @@ ;; @r{the bugs- list, but allow cross-posting when the} ;; @r{message was really cross-posted.} (any "bugs-mypackage@@somewhere" "mypkg.bugs") - (any "mypackage@@somewhere\" - "bugs-mypackage" "mypkg.list") + (any "mypackage@@somewhere" - "bugs-mypackage" "mypkg.list") ;; @r{People@dots{}} (any "larsi@@ifi\\.uio\\.no" "people.Lars_Magne_Ingebrigtsen")) ;; @r{Unmatched mail goes to the catch all group.}
--- a/man/info.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/info.texi Thu Oct 14 08:50:09 2004 +0000 @@ -130,15 +130,15 @@ @end ifnotinfo @menu -* Help-Small-Screen:: Starting Info on a Small Screen -* Help:: How to use Info -* Help-P:: Returning to the Previous node +* Help-Small-Screen:: Starting Info on a Small Screen. +* Help:: How to use Info. +* Help-P:: Returning to the Previous node. * Help-^L:: The Space, DEL, B and ^L commands. * Help-Inv:: Invisible text in Emacs Info. -* Help-M:: Menus -* Help-Xref:: Following cross-references -* Help-Int:: Some intermediate Info commands -* Help-Q:: Quitting Info +* Help-M:: Menus. +* Help-Xref:: Following cross-references. +* Help-Int:: Some intermediate Info commands. +* Help-Q:: Quitting Info. @end menu @node Help-Small-Screen @@ -212,8 +212,8 @@ If you have managed to get here, go back to the beginning with @kbd{DEL} (or @key{BACKSPACE}), and come back here again, then you understand the about the @samp{Space} and @samp{Backspace} keys. So -now type an @kbd{n} ---just one character; don't type the quotes and -don't type the Return key afterward--- to get to the normal start of +now type an @kbd{n}---just one character; don't type the quotes and +don't type the Return key afterward---to get to the normal start of the course. @end ifinfo @@ -243,8 +243,8 @@ and the duplicate remains at the top of the window all the time even if you scroll through the node. - Besides a @samp{Next}, a node can have a @samp{Previous} or an -@samp{Up} links, or both. As you can see, this node has all of these + Besides a @samp{Next}, a node can have a @samp{Previous} link, or an +@samp{Up} link, or both. As you can see, this node has all of these links. @kindex n @r{(Info mode)} @@ -375,7 +375,7 @@ @kindex C-l @r{(Info mode)} If your screen is ever garbaged, you can tell Info to display it -again by typing @kbd{C-l} (@kbd{Control-L}, that is---hold down +again by typing @kbd{C-l} (@kbd{Control-L}---that is, hold down @key{CTRL} and type @kbd{L} or @kbd{l}). @format @@ -414,8 +414,8 @@ (If you are using the stand-alone Info reader, type @kbd{C-x 0} to return here, that is---press and hold @key{CTRL}, type an @kbd{x}, -then release @key{CTRL} and @kbd{x}, and press @kbd{0}---a zero, not -the letter ``o''.) +then release @key{CTRL} and @kbd{x}, and press @kbd{0}; that's a zero, +not the letter ``o''.) From now on, you will encounter large nodes without warning, and will be expected to know how to use @key{SPC} and @key{BACKSPACE} to @@ -971,7 +971,7 @@ all of the current file by typing @kbd{g*@key{RET}} or all of any other file with @kbd{g(@var{filename})@key{RET}}. -@subheading @kbd{1} -- @kbd{9} choose a menu subtopic by its number +@subheading @kbd{1}--@kbd{9} choose a menu subtopic by its number @kindex 1 @r{through} 9 @r{(Info mode)} @findex Info-nth-menu-item @@ -1061,7 +1061,7 @@ echo area the full index entry it found. Often, the text of the full index entry already gives you enough information to decide whether it is relevant to what you are looking for, so we recommend that you read -what Emacs shows in the echo area before looking at the node it +what Info shows in the echo area before looking at the node it displays. Since @kbd{i} looks for a substring, you can search for subjects even @@ -1205,7 +1205,7 @@ A menu begins with a line starting with @w{@samp{* Menu:}}. The rest of the line is a comment. After the starting line, every line that begins with a @samp{* } lists a single topic. The name of the -topic--what the user must type at the @kbd{m}'s command prompt to +topic---what the user must type at the @kbd{m}'s command prompt to select this topic---comes right after the star and space, and is followed by a colon, spaces and tabs, and the name of the node which discusses that topic. The node name, like node names following
--- a/man/msdog.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/msdog.texi Thu Oct 14 08:50:09 2004 +0000 @@ -840,7 +840,7 @@ subsequent commands. Many users find this frustrating. @vindex w32-pass-alt-to-system -You can reenable Windows's default handling of tapping the @key{ALT} key +You can re-enable Windows' default handling of tapping the @key{ALT} key by setting @code{w32-pass-alt-to-system} to a non-@code{nil} value. @ignore
--- a/man/sc.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/sc.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1565,7 +1565,7 @@ @vindex sc-use-only-preference-p @vindex use-only-preference-p (sc-) Also, if the preferred attribution, which you specified in your -@code{sc-preferred-attribution-alist} variable cannot be found, a +@code{sc-preferred-attribution-list} variable cannot be found, a secondary method can be employed to find a valid attribution string. The variable @code{sc-use-only-preference-p} controls what happens in this case. If the variable's value is non-@code{nil}, then
--- a/man/search.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/search.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 2000, 2001 +@c Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 2000, 2001, 2004 @c Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Search, Fixit, Display, Top @@ -193,9 +193,11 @@ character or word. @kbd{C-y} is similar to @kbd{C-w} but copies all the rest of the -current line into the search string. Both @kbd{C-y} and @kbd{C-w} -convert the text they copy to lower case if the search is currently -not case-sensitive; this is so the search remains case-insensitive. +current line into the search string. If point is already at the end +of a line, it grabs the entire next line. Both @kbd{C-y} and +@kbd{C-w} convert the text they copy to lower case if the search is +currently not case-sensitive; this is so the search remains +case-insensitive. @kbd{C-M-w} and @kbd{C-M-y} modify the search string by only one character at a time: @kbd{C-M-w} deletes the last character from the @@ -777,13 +779,13 @@ The constructs that pertain to words and syntax are controlled by the setting of the syntax table (@pxref{Syntax}). - Here is a complicated regexp, stored in @code{sentence-end} and used -by Emacs to recognize the end of a sentence together with any -whitespace that follows. We show its Lisp syntax to distinguish the -spaces from the tab characters. In Lisp syntax, the string constant -begins and ends with a double-quote. @samp{\"} stands for a -double-quote as part of the regexp, @samp{\\} for a backslash as part -of the regexp, @samp{\t} for a tab, and @samp{\n} for a newline. + Here is a complicated regexp. It is a simplified version of the +regexp that Emacs uses, by default, to recognize the end of a sentence +together with any whitespace that follows. We show its Lisp syntax to +distinguish the spaces from the tab characters. In Lisp syntax, the +string constant begins and ends with a double-quote. @samp{\"} stands +for a double-quote as part of the regexp, @samp{\\} for a backslash as +part of the regexp, @samp{\t} for a tab, and @samp{\n} for a newline. @example "[.?!][]\"')]*\\($\\| $\\|\t\\| \\)[ \t\n]*"
--- a/man/text.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/text.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 1985,86,87,93,94,95,97,2000,2001, 2002 +@c Copyright (C) 1985,86,87,93,94,95,97,2000,2001, 2002, 2004 @c Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Text, Programs, Indentation, Top @@ -55,7 +55,7 @@ @cindex autotyping @cindex automatic typing The ``automatic typing'' features may be useful when writing text. -@xref{Top,, Autotyping, autotype, Features for Automatic Typing}. +@inforef{Top,, autotype}. @menu * Words:: Moving over and killing words. @@ -215,10 +215,12 @@ A sentence also begins or ends wherever a paragraph begins or ends. @vindex sentence-end - The variable @code{sentence-end} controls recognition of the end of a -sentence. It is a regexp that matches the last few characters of a -sentence, together with the whitespace following the sentence. Its -normal value is + The variable @code{sentence-end} controls recognition of the end of +a sentence. If non-@code{nil}, it is a regexp that matches the last +few characters of a sentence, together with the whitespace following +the sentence. If the value is @code{nil}, the default, then Emacs +computes the regexp according to various criteria. The result is +normally similar to the following regexp: @example "[.?!][]\"')]*\\($\\| $\\|\t\\| \\)[ \t\n]*" @@ -298,9 +300,10 @@ that separate paragraphs without being part of any paragraph (for example, blank lines). Lines that start a new paragraph and are contained in it must match only @code{paragraph-start}, not -@code{paragraph-separate}. For example, in Fundamental mode, -@code{paragraph-start} is @w{@code{"[ \t\n\f]"}}, and -@code{paragraph-separate} is @w{@code{"\f\\|[ \t]*$"}}. +@code{paragraph-separate}. Each regular expression must match at the +left margin. For example, in Fundamental mode, @code{paragraph-start} +is @w{@code{"\f\\|[ \t]*$"}}, and @code{paragraph-separate} is +@w{@code{"[ \t\f]*$"}}. Normally it is desirable for page boundaries to separate paragraphs. The default values of these variables recognize the usual separator for @@ -312,9 +315,9 @@ @cindex pages @cindex formfeed Files are often thought of as divided into @dfn{pages} by the -@dfn{formfeed} character (@acronym{ASCII} control-L, octal code 014). When you -print hardcopy for a file, this character forces a page break; thus, -each page of the file goes on a separate page on paper. Most Emacs +@dfn{formfeed} character (@acronym{ASCII} control-L, octal code 014). +When you print hardcopy for a file, this character forces a page break; +thus, each page of the file goes on a separate page on paper. Most Emacs commands treat the page-separator character just like any other character: you can insert it with @kbd{C-q C-l}, and delete it with @key{DEL}. Thus, you are free to paginate your file or not. However, @@ -575,7 +578,7 @@ conditions for where line-breaking is allowed. Its value is either @code{nil} or a Lisp function; the function is called with no arguments, and if it returns a non-@code{nil} value, then point is not -a good place to break the line. The standard functions you can use +a good place to break the line. Two standard functions you can use are @code{fill-single-word-nobreak-p} (don't break after the first word of a sentence or before the last) and @code{fill-french-nobreak-p} (don't break after @samp{(} or before @samp{)}, @samp{:} or @samp{?}). @@ -606,11 +609,12 @@ @kindex C-x . @findex set-fill-prefix - To specify a fill prefix, move to a line that starts with the desired -prefix, put point at the end of the prefix, and give the command -@w{@kbd{C-x .}}@: (@code{set-fill-prefix}). That's a period after the -@kbd{C-x}. To turn off the fill prefix, specify an empty prefix: type -@w{@kbd{C-x .}}@: with point at the beginning of a line.@refill + To specify a fill prefix for the current buffer, move to a line that +starts with the desired prefix, put point at the end of the prefix, +and give the command @w{@kbd{C-x .}}@: (@code{set-fill-prefix}). +That's a period after the @kbd{C-x}. To turn off the fill prefix, +specify an empty prefix: type @w{@kbd{C-x .}}@: with point at the +beginning of a line.@refill When a fill prefix is in effect, the fill commands remove the fill prefix from each line before filling and insert it on each line after @@ -824,14 +828,14 @@ @kindex TAB @r{(Text mode)} Text mode defines @key{TAB} to run @code{indent-relative} (@pxref{Indentation}), so that you can conveniently indent a line like -the previous line. When the previous line is not indented, -@code{indent-relative} runs @code{tab-to-tab-stop}, which uses Emacs tab -stops that you can set (@pxref{Tab Stops}). +the previous line. Text mode turns off the features concerned with comments except when -you explicitly invoke them. It changes the syntax table so that periods -are not considered part of a word, while apostrophes, backspaces and -underlines are considered part of words. +you explicitly invoke them. It changes the syntax table so that +single-quotes are considered part of words. However, if a word starts +with single-quotes, then these are treated as a prefix for purposes +such as capitalization. That is, @kbd{M-c} will convert +@samp{'hello'} into @samp{'Hello'}, as expected. @cindex Paragraph-Indent Text mode @cindex mode, Paragraph-Indent Text @@ -896,8 +900,8 @@ Editing commands that operate on lines, such as @kbd{C-n} and @kbd{C-p}, treat the text of the invisible line as part of the previous -visible line. Killing an entire visible line, including its terminating -newline, really kills all the following invisible lines along with it. +visible line. Killing the ellipsis at the end of a visible line +really kills all the following invisible lines. Outline minor mode provides the same commands as the major mode, Outline mode, but you can use it in conjunction with other major modes. @@ -1137,12 +1141,9 @@ @findex hide-other @kindex C-c C-o @r{(Outline mode)} The command @kbd{C-c C-o} (@code{hide-other}) hides everything except -the heading or body text that point is in, plus its parents (the headers -leading up from there to top level in the outline). - - You can turn off the use of ellipses at the ends of visible lines by -setting @code{selective-display-ellipses} to @code{nil}. Then there is -no visible indication of the presence of invisible lines. +the heading and body text that point is in, plus its parents (the headers +leading up from there to top level in the outline) and the top level +headings. @findex reveal-mode When incremental search finds text that is hidden by Outline mode, @@ -1180,7 +1181,7 @@ nested portion of the outline, while hiding its relatives at higher levels. - Consider an Outline mode buffer all the text and subheadings under + Consider an Outline mode buffer with all the text and subheadings under level-1 headings hidden. To look at what is hidden under one of these headings, you could use @kbd{C-c C-e} (@kbd{M-x show-entry}) to expose the body, or @kbd{C-c C-i} to expose the child (level-2) headings. @@ -1215,8 +1216,8 @@ To unzoom (exit) a fold, use @kbd{C-c C-x} (@kbd{M-x foldout-exit-fold}). This hides all the text and subheadings under the top-level heading and returns you to the previous view of the buffer. Specifying a numeric -argument exits that many levels of folds. Specifying a zero argument exits all -folds. +argument exits that many levels of folds. Specifying a zero argument +exits all folds. To cancel the narrowing of a fold without hiding the text and subheadings, specify a negative argument. For example, @kbd{M--2 C-c @@ -1633,7 +1634,7 @@ @findex iso-iso2gtex @findex iso-gtex2iso @cindex Latin-1 @TeX{} encoding -@TeX{} encoding +@cindex @TeX{} encoding The commands @kbd{M-x iso-iso2tex}, @kbd{M-x iso-tex2iso}, @kbd{M-x iso-iso2gtex} and @kbd{M-x iso-gtex2iso} can be used to convert between Latin-1 encoded files and @TeX{}-encoded equivalents. @@ -1659,7 +1660,7 @@ @cindex references, La@TeX{} @cindex La@TeX{} references For managing all kinds of references for La@TeX{}, you can use -Ref@TeX{}. @xref{Top, , RefTeX, reftex}. +Ref@TeX{}. @inforef{Top,, reftex}. @node HTML Mode @section SGML, XML, and HTML Modes @@ -1880,16 +1881,6 @@ recognize the format, reconvert the text, and turn on Enriched mode again. -@vindex enriched-fill-after-visiting - Normally, after visiting a file in text/enriched format, Emacs refills -each paragraph to fit the specified right margin. You can turn off this -refilling, to save time, by setting the variable -@code{enriched-fill-after-visiting} to @code{nil} or to @code{ask}. - - However, when visiting a file that was saved from Enriched mode, there -is no need for refilling, because Emacs saves the right margin settings -along with the text. - @vindex enriched-translations You can add annotations for saving additional text properties, which Emacs normally does not save, by adding to @code{enriched-translations}. @@ -1951,22 +1942,22 @@ @table @code @findex facemenu-remove-face-props @item Remove Face Properties -Delete from the region all the text properties that the Text Properties -menu works with (@code{facemenu-remove-face-props}). +Delete from the region all face and color text properties +(@code{facemenu-remove-face-props}). @findex facemenu-remove-all -@item Remove All +@item Remove Text Properties Delete @emph{all} text properties from the region (@code{facemenu-remove-all}). -@findex describe-text-at +@findex describe-text-properties @cindex text properties of characters @cindex overlays at character position @cindex widgets at buffer position @cindex buttons at buffer position -@item Describe Text +@item Describe Properties List all the text properties, widgets, buttons, and overlays of the -character following point (@code{describe-text-at}). +character following point (@code{describe-text-properties}). @item Display Faces Display a list of all the defined faces (@code{list-faces-display}). @@ -2018,8 +2009,20 @@ If you use these commands with a prefix argument---or, in Transient Mark mode, if the region is not active---then these commands specify a face -to use for your next self-inserting input. @xref{Transient Mark}. This -applies to both the keyboard commands and the menu commands. +to use for any immediately following self-inserting input. +@xref{Transient Mark}. This applies to both the keyboard commands and +the menu commands. + + Specifying the @code{default} face also resets foreground and +background color to their defaults.(@pxref{Format Colors}). + + Any self-inserting character you type inherits, by default, the face +properties (as well as most other text properties) of the preceding +character. Specifying any face property, including foreground or +background color, for your next self-inserting character will prevent +it from inheriting any face properties from the preceding character, +although it will still inherit other text properties. Characters +inserted by yanking do not inherit text properties. Enriched mode defines two additional faces: @code{excerpt} and @code{fixed}. These correspond to codes used in the text/enriched file @@ -2029,20 +2032,17 @@ same as @code{italic} unless you customize it (@pxref{Face Customization}). The @code{fixed} face means, ``Use a fixed-width font for this part -of the text.'' This makes a visible difference only if you have -specified a variable-width font in the default face; however, even if -the default font is fixed-width, applying the @code{fixed} face to a -part of the text will cause that part of the text to appear in a -fixed-width font, if the file is ever displayed with a variable-width -default font. This applies to Emacs and to other systems that display -text/enriched format. So if you specifically want a certain part of -the text to use a fixed-width font, you should specify the -@code{fixed} face for that part. +of the text.'' Applying the @code{fixed} face to a part of the text +will cause that part of the text to appear in a fixed-width font, even +if the default font is variable-width. This applies to Emacs and to +other systems that display text/enriched format. So if you +specifically want a certain part of the text to use a fixed-width +font, you should specify the @code{fixed} face for that part. - The @code{fixed} face is normally set up to use a different font -from the default, even if the default face is also fixed-width. -Different systems have different fonts installed, so you may need to -customize this. @xref{Face Customization}. + By default, the @code{fixed} face looks the same as @code{bold}. +This is an attempt to distinguish it from @code{default}. You may +wish to customize @code{fixed} to some other fixed-width medium font. +@xref{Face Customization}. If your terminal cannot display different faces, you will not be able to see them, but you can still edit documents containing faces, @@ -2058,20 +2058,20 @@ for specifying the background color. Each color menu lists all the colors that you have used in Enriched mode in the current Emacs session. - If you specify a color with a prefix argument---or, in Transient Mark -mode, if the region is not active---then it applies to your next -self-inserting input. @xref{Transient Mark}. Otherwise, the command -applies to the region. + If you specify a color with a prefix argument---or, in Transient +Mark mode, if the region is not active---then it applies to any +immediately following self-inserting input. @xref{Transient Mark}. +Otherwise, the command applies to the region. Each color menu contains one additional item: @samp{Other}. You can use this item to specify a color that is not listed in the menu; it reads -the color name with the minibuffer. To display list of available colors +the color name with the minibuffer. To display a list of available colors and their names, use the @samp{Display Colors} menu item in the Text Properties menu (@pxref{Editing Format Info}). Any color that you specify in this way, or that is mentioned in a -formatted text file that you read in, is added to both color menus for -the duration of the Emacs session. +formatted text file that you read in, is added to the corresponding +color menu for the duration of the Emacs session. @findex facemenu-set-foreground @findex facemenu-set-background @@ -2113,33 +2113,42 @@ You can use these commands repeatedly to increase or decrease the indentation. - The most common way to use these commands is to change the indentation -of an entire paragraph. However, that is not the only use. You can -change the margins at any point; the new values take effect at the end -of the line (for right margins) or the beginning of the next line (for -left margins). + The most common way to use them is to change the indentation of an +entire paragraph. For other uses, the effects of refilling can be +hard to predict, except in some special cases like the one described +next. - This makes it possible to format paragraphs with @dfn{hanging indents}, -which means that the first line is indented less than subsequent lines. -To set up a hanging indent, increase the indentation of the region -starting after the first word of the paragraph and running until the end -of the paragraph. + The most common other use is to format paragraphs with @dfn{hanging +indents}, which means that the first line is indented less than +subsequent lines. To set up a hanging indent, increase the +indentation of the region starting after the first word of the +paragraph and running until the end of the paragraph. Indenting the first line of a paragraph is easier. Set the margin for the whole paragraph where you want it to be for the body of the paragraph, then indent the first line by inserting extra spaces or tabs. - Sometimes, as a result of editing, the filling of a paragraph becomes -messed up---parts of the paragraph may extend past the left or right -margins. When this happens, use @kbd{M-q} (@code{fill-paragraph}) to -refill the paragraph. - @vindex standard-indent The variable @code{standard-indent} specifies how many columns these commands should add to or subtract from the indentation. The default value is 4. The overall default right margin for Enriched mode is controlled by the variable @code{fill-column}, as usual. +@kindex C-c [ @r{(Enriched mode)} +@kindex C-c ] @r{(Enriched mode)} +@findex set-left-margin +@findex set-right-margin + There are also two commands for setting the left or right margin of +the region absolutely: @code{set-left-margin} and +@code{set-right-margin}. Enriched mode binds these commands to +@kbd{C-c [} and @kbd{C-c ]}, respectively. You can specify the +margin width either with a numeric argument or in the minibuffer. + + Sometimes, as a result of editing, the filling of a paragraph becomes +messed up---parts of the paragraph may extend past the left or right +margins. When this happens, use @kbd{M-q} (@code{fill-paragraph}) to +refill the paragraph. + The fill prefix, if any, works in addition to the specified paragraph indentation: @kbd{C-x .} does not include the specified indentation's whitespace in the new value for the fill prefix, and the fill commands @@ -2157,11 +2166,11 @@ the style. The submenu contains five items: @table @code -@item Flush Left +@item Left This is the most common style of justification (at least for English). Lines are aligned at the left margin but left uneven at the right. -@item Flush Right +@item Right This aligns each line with the right margin. Spaces and tabs are added on the left, if necessary, to make lines line up on the right. @@ -2175,7 +2184,7 @@ @item Center This centers every line between the current margins. -@item None +@item Unfilled This turns off filling entirely. Each line will remain as you wrote it; the fill and auto-fill functions will have no effect on text which has this setting. You can, however, still indent the left margin. In @@ -2195,9 +2204,9 @@ @findex set-justification-right @item M-j r Make the region right-filled (@code{set-justification-right}). -@kindex M-j f @r{(Enriched mode)} +@kindex M-j b @r{(Enriched mode)} @findex set-justification-full -@item M-j f +@item M-j b Make the region fully justified (@code{set-justification-full}). @kindex M-j c @r{(Enriched mode)} @kindex M-S @r{(Enriched mode)} @@ -2220,11 +2229,15 @@ The default justification style is specified by the variable @code{default-justification}. Its value should be one of the symbols @code{left}, @code{right}, @code{full}, @code{center}, or @code{none}. +This is a per-buffer variable. Setting the variable directly affects +only the current buffer. However, customizing it in a Custom buffer +sets (as always) the default value for buffers that do not override it. +@xref{Locals}, and @ref{Easy Customization}. @node Format Properties @subsection Setting Other Text Properties - The Other Properties menu lets you add or remove three other useful text + The Special Properties menu lets you add or remove three other useful text properties: @code{read-only}, @code{invisible} and @code{intangible}. The @code{intangible} property disallows moving point within the text, the @code{invisible} text property hides text from display, and the @@ -2253,10 +2266,10 @@ not recognize the file as being in the text/enriched format. In this case, when you visit the file you will see the formatting commands rather than the formatted text. Type @kbd{M-x format-decode-buffer} to -translate it. +translate it. This also automatically turns on Enriched mode. @item -When you @emph{insert} a file into a buffer, rather than visiting it. +When you @emph{insert} a file into a buffer, rather than visiting it, Emacs does the necessary conversions on the text which you insert, but it does not enable Enriched mode. If you wish to do that, type @kbd{M-x enriched-mode}. @@ -2268,7 +2281,7 @@ tells Emacs to guess the format. @findex format-find-file - If you wish to look at text/enriched file in its raw form, as a + If you wish to look at a text/enriched file in its raw form, as a sequence of characters rather than as formatted text, use the @kbd{M-x find-file-literally} command. This visits a file, like @code{find-file}, but does not do format conversion. It also inhibits
--- a/man/tramp.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/tramp.texi Thu Oct 14 08:50:09 2004 +0000 @@ -1952,9 +1952,12 @@ many thanks to Joe Stoy for providing the information: @uref{ftp://ftp.comlab.ox.ac.uk/tmp/Joe.Stoy/} +@c The link is broken. I've contacted Tom for clarification. Michael. +@ignore The above mostly contains patches to old ssh versions; Tom Roche has a Web page with instructions: @uref{http://www4.ncsu.edu/~tlroche/plinkTramp.html} +@end ignore ??? Is the XEmacs info correct?
--- a/man/trampver.texi Wed Oct 13 02:40:50 2004 +0000 +++ b/man/trampver.texi Thu Oct 14 08:50:09 2004 +0000 @@ -4,7 +4,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.0.44 +@set trampver 2.0.45 @c Other flags from configuration @set prefix /usr/local
--- a/msdos/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/msdos/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,8 @@ +2004-10-06 Eli Zaretskii <eliz@gnu.org> + + * sed1v2.inp (LC_ALL=C): Fix src/Makefile breakage caused by + recent (2004-09-24) changes in src/Makefile.in. + 2004-08-14 Eli Zaretskii <eliz@gnu.org> * sedleim.inp: Remove the lines which say "<TAB>@true", to avoid
--- a/msdos/sed1v2.inp Wed Oct 13 02:40:50 2004 +0000 +++ b/msdos/sed1v2.inp Thu Oct 14 08:50:09 2004 +0000 @@ -20,9 +20,9 @@ s/^[ \f\t][ \f\t]*$// s/^ / / s/\.h\.in/.h-in/ -/^ LC_ALL=C \.\/temacs/i\ +/^ LC_ALL=C \$(RUN_TEMACS)/i\ stubedit temacs.exe minstack=100k -/^ LC_ALL=C.*temacs/s/LC_ALL=C/set &;/ +/^ LC_ALL=C.*\$(RUN_TEMACS)/s/LC_ALL=C/set &;/ /^MAKE *=/s/^/# / /^SHELL *=/s/^/# / /^srcdir *=/s/@[^@\n]*@/./
--- a/nt/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/nt/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -77,7 +77,7 @@ * multi-install-info.bat: New file. -2003-06-27 Jan D. <jan.h.d@swipnet.se> +2003-06-27 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * config.nt (my_strftime): New define.
--- a/src/.gdbinit Wed Oct 13 02:40:50 2004 +0000 +++ b/src/.gdbinit Thu Oct 14 08:50:09 2004 +0000 @@ -60,6 +60,16 @@ Works only when an inferior emacs is executing. end +# Print out s-expressions +define pp + set $tmp = $arg0 + set debug_print ($tmp) +end +document pp +Print the argument as an emacs s-expression +Works only when an inferior emacs is executing. +end + define xtype xgettype $ output $type @@ -452,6 +462,16 @@ end xreload +# Flush display (X only) +define ff + set x_flush (0) +end +document ff +Flush pending X window display updates to screen. +Works only when an inferior emacs is executing. +end + + define hook-run xreload end
--- a/src/ChangeLog Wed Oct 13 02:40:50 2004 +0000 +++ b/src/ChangeLog Thu Oct 14 08:50:09 2004 +0000 @@ -1,3 +1,157 @@ +2004-10-14 Kim F. Storm <storm@cua.dk> + + * xterm.h: Include Xutil.h after keysym.h to work around bug + (incorrectly recognising AltGr key) in some X versions. + +2004-10-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * keymap.c (get_keymap): An autoload form is not a keymap. + + * textprop.c (syms_of_textprop): Make `syntax-table' nonsticky. + +2004-10-13 Kim F. Storm <storm@cua.dk> + + * callproc.c (Fcall_process): Simplify handling of display arg. + Resume `display_on_the_fly' once a coding system is determined. + + * xdisp.c (redisplay_preserve_echo_area): Fix last change. + +2004-10-12 Kim F. Storm <storm@cua.dk> + + * xdisp.c (redisplay_preserve_echo_area): Flush display in case + caller, such as call-process, is not going to poll for input. + (calc_line_height_property): Handle case where it->object is nil. + + * xterm.c (x_redisplay_interface): Fix flush_display_optional. + +2004-10-12 Kenichi Handa <handa@m17n.org> + + * xdisp.c (get_next_display_element): + If unibyte_display_via_language_environment is zero, display 8-bit + chars in octal in unibyte buffer. + +2004-10-12 Kim F. Storm <storm@cua.dk> + + * doc.c (Fsubstitute_command_keys): Ignore remappings unless there + are no ordinary bindings. + +2004-10-11 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xfns.c (syms_of_xfns): Defsubr x-file-dialog for GTK also. + +2004-10-10 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (x_raise_frame): Add BLOCK_INPUT around SelectWindow. + (x_lower_frame): Add BLOCK_INPUT around SendBehind. + (make_mac_frame): Add BLOCK_INPUT around the making of a + terminal frame. + (mac_initialize): Add BLOCK_INPUT around carbon initialization. + * macgui.h (mktime): Use emacs_mktime. + * macfns.c (Fx_file_dialog): Add BLOCK_INPUT around more code. + Make a cancel file-open dialog be like C-g. + * mac.c (mktime): Use emacs_mktime. + (Fdo_applescript): Add BLOCK_INPUT around do_applescript. + (Fmac_paste_function): Add better error handling for carbon cut/paste. + +2004-10-10 Kim F. Storm <storm@cua.dk> + + * keyboard.c (timer_resume_idle): New function to resume idle + timer without resetting timers on the idle list. + (read_char): Use timer_resume_idle. Remove local var last_idle_start. + (timer_start_idle, timer_stop_idle): Declare static. + (read_key_sequence): Use timer_resume_idle instead of timer_start_idle. + + * keyboard.h (timer_start_idle, timer_stop_idle): Remove prototypes. + +2004-10-08 Steven Tamm <steventamm@mac.com> + + * config.in (HAVE_MALLOC_MALLOC_H): Regenerate. + * macterm.c (mac_check_for_quit_char): Remove warning for using + NULL where 0 should be used. + * unexmacosx.c: Use malloc/malloc.h on Tiger instead of + objc/malloc.h + * mac.c: Include time.h for Tiger compatibility. + +2004-10-07 Kim F. Storm <storm@cua.dk> + + * xdisp.c (redisplay_window): Fix flicker on vertical line between + windows. Update vertical line after drawing window fringes, but + only if actually drawing any bitmaps--or there is no fringe. + + * xterm.c (x_update_window_end): Likewise. + * macterm.c (x_update_window_end): Likewise. + * w32term.c (x_update_window_end): Likewise. + + * fringe.c (draw_window_fringes): Return value now indicates if + any fringe bitmaps were redrawn (or there are no fringes). + + * dispextern.h (draw_window_fringes): Update prototype. + +2004-10-06 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macfns.c (mac_get_window_bounds): Add extern. + (x_real_positions): Use mac_get_window_bounds. + + * macmenu.c (update_submenu_strings): Apply 2004-09-07 change for + xmenu.c (YAILOM). + + * macterm.c [!MAC_OSX]: Include Windows.h. + (front_emacs_window): Rename from mac_front_window. All uses + changed. Return the frontmost non-tooltip emacs window. + (mac_get_window_bounds): New function. + (x_calc_absolute_position): Use the difference of width and height + between the inner and outer window. + (x_set_offset): Specify window position by the coordinae of the + outer window. Adjust the position if the title bar is completely + outside the screen. + (app_is_suspended, app_sleep_time): Remove unused variables. + (do_app_resume, do_app_suspend): Remove their contents because + window-activate/deactivate events will do the job. + (do_zoom_window): Remove unused variables. Make compliant to the + standard way of zooming. Set f->left_pos and f->top_pos. + (XTread_socket): Don't use argument `expected'. Don't use + FrontWindow to determine the clicked window. Exclude unprocessed + mouseUp cases in the early stage. Add parentheses to fix operator + precedence. + (XTread_socket) [TARGET_API_MAC_CARBON]: Don't specify drag area. + + +2004-10-05 Jan Dj,Ad(Brv. <jan.h.d@swipnet.se> + + * config.in: Regenerate. + + * Makefile.in (RUN_TEMACS): Check HAVE_RANDOM_HEAPSTART instead of + HAVE_EXECSHIELD. + +2004-10-05 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xterm.c (x_find_modifier_meanings): Ignore any Super or Hyper for + a row if Alt or Meta has been found for that row. Also stop scanning + for Keysyms for that row. + +2004-10-04 Kim F. Storm <storm@cua.dk> + + * fringe.c (Ffringe_bitmaps_at_pos): Change return value from cons + to list. Include overlay arrow bitmap in return value. + + * xterm.c (XTset_vertical_scroll_bar): Improve handling of scroll + bars with fractional column width. If scroll bar separates two + windows, move it towards the window it belongs to. Only update + the padding area below the scroll bar widget when necessary, + i.e. when scroll bar widget is created, moved, or resized. + + * xdisp.c (define_frame_cursor1): Do not change frame cursor + while tracking/dragging mouse. + (x_draw_vertical_border): Do not draw line if frame has scroll bars. + + * window.c (coordinates_in_window): Relax check for cursor + on vertial border between mode lines. + (Fset_window_fringes): Do not allow negative widths. + (Fset_window_scroll_bars): Likewise. + + * .gdbinit (pp): Shorthand for p ARG + pr. + (ff): New command: flush frame updates (X only). + 2004-10-03 Michael Albinus <michael.albinus@gmx.de> * fileio.c (auto_save_1) Call Ffile_modes for remote files. @@ -62,8 +216,8 @@ Change arg to Lisp_Object and fail if not an integer. (get_fringe_bitmap_name, resolve_fringe_bitmap) (destroy_fringe_bitmap): New functions. - (Fdestroy_fringe_bitmap): Change arg to bitmap symbol. Use - destroy_fringe_bitmap. Remove symbol from Vfringe_bitmaps and + (Fdestroy_fringe_bitmap): Change arg to bitmap symbol. + Use destroy_fringe_bitmap. Remove symbol from Vfringe_bitmaps and clear its fringe property. (init_fringe_bitmap): Use destroy_fringe_bitmap instead of Fdestroy_fringe_bitmap. @@ -88,7 +242,7 @@ 2004-09-25 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> - * config.in: Rebuild + * config.in: Rebuild. 2004-09-24 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> @@ -108,7 +262,7 @@ Handle the case where we reach the old displayed text, out of sync with the old line boundary. -2004-09-14 Stefan <monnier@iro.umontreal.ca> +2004-09-14 Stefan Monnier <monnier@iro.umontreal.ca> * fileio.c (Finsert_file_contents): Fix case of replacement in a narrowed buffer. @@ -130,7 +284,7 @@ (Fbyte_code): Remove dead code after `wrong_type_argument'. * alloc.c (Fgarbage_collect): Mark keyboards, gtk data, and specpdl - before doing the mark_stack_check_gcpros since they are not on the stack. + before doing the mark_stack_check_gcpros since they're not on the stack. 2004-09-12 Kim F. Storm <storm@cua.dk> @@ -149,8 +303,7 @@ blockinput.h. (dosfns.o): Depend on blockinput.h, window.h, dispextern.h, charset.h, and coding.h - (w16select.o): Depend on buffer.h, charset.h, coding.h, and - composite.h. + (w16select.o): Depend on buffer.h, charset.h, coding.h, and composite.h. (term.o): Depend on window.h and keymap.h. (abbrev.o): Depend on syntax.h. (callint.o): Depend on keymap.h. @@ -183,8 +336,8 @@ (lread.o): Depend on $(INTERVALS_SRC), termhooks.h, and coding.h. (intervals.o): Depend on keymap.h. - * msdos.c (msdos_set_cursor_shape, IT_display_cursor): Add - debugging print-out to termscript. + * msdos.c (msdos_set_cursor_shape, IT_display_cursor): + Add debugging print-out to termscript. 2004-09-09 Richard M. Stallman <rms@gnu.org> @@ -210,8 +363,8 @@ 2004-09-07 Luc Teirlinck <teirllm@auburn.edu> * buffer.h (struct buffer): Add auto_save_file_format field. - * buffer.c (reset_buffer, init_buffer_once): Handle - auto_save_file_format field. + * buffer.c (reset_buffer, init_buffer_once): + Handle auto_save_file_format field. (syms_of_buffer): Add DEFVAR_PER_BUFFER for `buffer-auto-save-file-format'. * fileio.c: Delete declaration for removed Vauto_save_file_format. @@ -224,15 +377,15 @@ * w32term.h (AppendMenuW_Proc): Move declaration from w32menu.c. - * w32fns.c (w32_wnd_proc) [WM_MEASUREITEM, WM_DRAWITEM]: Handle - Unicode menu titles. + * w32fns.c (w32_wnd_proc) [WM_MEASUREITEM, WM_DRAWITEM]: + Handle Unicode menu titles. 2004-09-07 Kim F. Storm <storm@cua.dk> * xdisp.c (set_cursor_from_row): Fix last change. Only use 'cursor' property from text property or overlay strings at point. -2004-09-07 Stefan <monnier@iro.umontreal.ca> +2004-09-07 Stefan Monnier <monnier@iro.umontreal.ca> * xmenu.c (update_submenu_strings): YAILOM. (set_frame_menubar): Make sure last_i is initialized. @@ -721,7 +874,7 @@ * w32select.c (Fw32_set_clipboard_data): Update `nbytes' correctly after getting a new string by pre-write-conversion. -2004-06-30 Stefan <monnier@iro.umontreal.ca> +2004-06-30 Stefan Monnier <monnier@iro.umontreal.ca> * xterm.c (x_detect_focus_change): Remove unused var `nr_events'. (x_calc_absolute_position): Remove unused var `child'.
--- a/src/Makefile.in Wed Oct 13 02:40:50 2004 +0000 +++ b/src/Makefile.in Thu Oct 14 08:50:09 2004 +0000 @@ -887,7 +887,7 @@ #define OBJECTS_MACHINE #endif -#ifdef HAVE_EXECSHIELD +#ifdef HAVE_RANDOM_HEAPSTART #undef i386 RUN_TEMACS = @SETARCH@ i386 ./temacs #else
--- a/src/callproc.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/callproc.c Thu Oct 14 08:50:09 2004 +0000 @@ -216,7 +216,8 @@ int nargs; register Lisp_Object *args; { - Lisp_Object infile, buffer, current_dir, display, path; + Lisp_Object infile, buffer, current_dir, path; + int display_p; int fd[2]; int filefd; register int pid; @@ -372,7 +373,7 @@ UNGCPRO; } - display = nargs >= 4 ? args[3] : Qnil; + display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]); filefd = emacs_open (SDATA (infile), O_RDONLY, 0); if (filefd < 0) @@ -739,7 +740,7 @@ int first = 1; int total_read = 0; int carryover = 0; - int display_on_the_fly = !NILP (display) && INTERACTIVE; + int display_on_the_fly = display_p; struct coding_system saved_coding; saved_coding = process_coding; @@ -803,6 +804,9 @@ display_on_the_fly = 0; process_coding = saved_coding; carryover = nread; + /* This is to make the above condition always + fails in the future. */ + saved_coding.type = coding_type_no_conversion; continue; } @@ -832,12 +836,16 @@ bufptr = tempptr; } - if (!NILP (display) && INTERACTIVE) + if (display_p) { if (first) prepare_menu_bars (); first = 0; redisplay_preserve_echo_area (1); + /* This variable might have been set to 0 for code + detection. In that case, we set it back to 1 because + we should have already detected a coding system. */ + display_on_the_fly = 1; } immediate_quit = 1; QUIT;
--- a/src/config.in Wed Oct 13 02:40:50 2004 +0000 +++ b/src/config.in Thu Oct 14 08:50:09 2004 +0000 @@ -136,9 +136,6 @@ /* Define to 1 if you have the `euidaccess' function. */ #undef HAVE_EUIDACCESS -/* Define to 1 if this OS has exec shield and we can handle it. */ -#undef HAVE_EXECSHIELD - /* Define to 1 if you have the <fcntl.h> header file. */ #undef HAVE_FCNTL_H @@ -355,6 +352,9 @@ /* Define to 1 if you have the <maillock.h> header file. */ #undef HAVE_MAILLOCK_H +/* Define to 1 if you have the <malloc/malloc.h> header file. */ +#undef HAVE_MALLOC_MALLOC_H + /* Define to 1 if you have the `mblen' function. */ #undef HAVE_MBLEN @@ -432,6 +432,9 @@ /* Define to 1 if you have the `random' function. */ #undef HAVE_RANDOM +/* Define to 1 if this OS randomizes the start address of the heap. */ +#undef HAVE_RANDOM_HEAPSTART + /* Define to 1 if you have the `recvfrom' function. */ #undef HAVE_RECVFROM @@ -754,9 +757,9 @@ /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. - STACK_DIRECTION > 0 => grows toward higher addresses - STACK_DIRECTION < 0 => grows toward lower addresses - STACK_DIRECTION = 0 => direction of growth unknown */ + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ #undef STACK_DIRECTION /* Define to 1 if you have the ANSI C header files. */
--- a/src/dispextern.h Wed Oct 13 02:40:50 2004 +0000 +++ b/src/dispextern.h Thu Oct 14 08:50:09 2004 +0000 @@ -1961,8 +1961,8 @@ /* Object and position where the current display element came from. Object can be a Lisp string in case the current display element - comes from an overlay string, or it is buffer. Position is - a position in object. */ + comes from an overlay string, or it is buffer. It may also be nil + during mode-line update. Position is a position in object. */ Lisp_Object object; struct text_pos position; @@ -2637,7 +2637,7 @@ int lookup_fringe_bitmap (Lisp_Object); void draw_fringe_bitmap P_ ((struct window *, struct glyph_row *, int)); void draw_row_fringe_bitmaps P_ ((struct window *, struct glyph_row *)); -void draw_window_fringes P_ ((struct window *)); +int draw_window_fringes P_ ((struct window *, int)); int update_window_fringes P_ ((struct window *, int)); void compute_fringe_widths P_ ((struct frame *, int));
--- a/src/doc.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/doc.c Thu Oct 14 08:50:09 2004 +0000 @@ -776,9 +776,13 @@ idx = strp - SDATA (string); tem = Fintern (make_string (start, length_byte), Qnil); + /* Ignore remappings unless there are no ordinary bindings. */ + tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qt); + if (NILP (tem)) + tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil); + /* Note the Fwhere_is_internal can GC, so we have to take relocation of string contents into account. */ - tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil); strp = SDATA (string) + idx; start = SDATA (string) + start_idx;
--- a/src/fringe.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/fringe.c Thu Oct 14 08:50:09 2004 +0000 @@ -722,19 +722,35 @@ } /* Draw the fringes of window W. Only fringes for rows marked for - update in redraw_fringe_bitmaps_p are drawn. */ + update in redraw_fringe_bitmaps_p are drawn. + + Return >0 if left or right fringe was redrawn in any way. + + If NO_FRINGE is non-zero, also return >0 if either fringe has zero width. -void -draw_window_fringes (w) + A return value >0 indicates that the vertical line between windows + needs update (as it may be drawn in the fringe). +*/ + +int +draw_window_fringes (w, no_fringe) struct window *w; + int no_fringe; { struct glyph_row *row; int yb = window_text_bottom_y (w); int nrows = w->current_matrix->nrows; int y = 0, rn; + int updated = 0; if (w->pseudo_window_p) - return; + return 0; + + /* Must draw line if no fringe */ + if (no_fringe + && (WINDOW_LEFT_FRINGE_WIDTH (w) == 0 + || WINDOW_RIGHT_FRINGE_WIDTH (w) == 0)) + updated++; for (y = 0, rn = 0, row = w->current_matrix->rows; y < yb && rn < nrows; @@ -744,7 +760,10 @@ continue; draw_row_fringe_bitmaps (w, row); row->redraw_fringe_bitmaps_p = 0; + updated++; } + + return updated; } @@ -950,11 +969,7 @@ Typically, we add an equal amount (+/- 1 pixel) to each fringe, but a negative width value is taken literally (after negating it). - We never make the fringes narrower than specified. It is planned - to make fringe bitmaps customizable and expandable, and at that - time, the user will typically specify the minimum number of pixels - needed for his bitmaps, so we shouldn't select anything less than - what is specified. + We never make the fringes narrower than specified. */ void @@ -1343,9 +1358,10 @@ 0, 2, 0, doc: /* Return fringe bitmaps of row containing position POS in window WINDOW. If WINDOW is nil, use selected window. If POS is nil, use value of point -in that window. Return value is a cons (LEFT . RIGHT) where LEFT and RIGHT -are the fringe bitmap numbers for the bitmaps in the left and right fringe, -resp. If left or right fringe is empty, the corresponding element is nil. +in that window. Return value is a list (LEFT RIGHT OV), where LEFT +is the symbol for the bitmap in the left fringe (or nil if no bitmap), +RIGHT is similar for the right fringe, and OV is non-nil if there is an +overlay arrow in the left fringe. Return nil if POS is not visible in WINDOW. */) (pos, window) Lisp_Object pos, window; @@ -1373,8 +1389,9 @@ row = MATRIX_FIRST_TEXT_ROW (w->current_matrix); row = row_containing_pos (w, textpos, row, NULL, 0); if (row) - return Fcons (get_fringe_bitmap_name (row->left_fringe_bitmap), - get_fringe_bitmap_name (row->right_fringe_bitmap)); + return list3 (get_fringe_bitmap_name (row->left_fringe_bitmap), + get_fringe_bitmap_name (row->right_fringe_bitmap), + (row->overlay_arrow_p ? Qt : Qnil)); else return Qnil; }
--- a/src/keyboard.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/keyboard.c Thu Oct 14 08:50:09 2004 +0000 @@ -676,6 +676,9 @@ static void clear_event P_ ((struct input_event *)); static void any_kboard_state P_ ((void)); static SIGTYPE interrupt_signal P_ ((int signalnum)); +static void timer_start_idle P_ ((void)); +static void timer_stop_idle P_ ((void)); +static void timer_resume_idle P_ ((void)); /* Nonzero means don't try to suspend even if the operating system seems to support it. */ @@ -2387,7 +2390,6 @@ volatile Lisp_Object also_record; volatile int reread; struct gcpro gcpro1, gcpro2; - EMACS_TIME last_idle_start; int polling_stopped_here = 0; also_record = Qnil; @@ -2894,9 +2896,6 @@ non_reread: - /* Record the last idle start time so that we can reset it - should the next event read be a help-echo. */ - last_idle_start = timer_idleness_start_time; timer_stop_idle (); RESUME_POLLING; @@ -2936,7 +2935,7 @@ prevents automatic window selection (under mouse_autoselect_window from acting as a real input event, for example banishing the mouse under mouse-avoidance-mode. */ - timer_idleness_start_time = last_idle_start; + timer_resume_idle (); /* Resume allowing input from any kboard, if that was true before. */ if (!was_locked) @@ -3134,7 +3133,7 @@ show_help_echo (help, window, object, position, 0); /* We stopped being idle for this event; undo that. */ - timer_idleness_start_time = last_idle_start; + timer_resume_idle (); goto retry; } @@ -4251,7 +4250,7 @@ /* Record the start of when Emacs is idle, for the sake of running idle-time timers. */ -void +static void timer_start_idle () { Lisp_Object timers; @@ -4279,12 +4278,23 @@ /* Record that Emacs is no longer idle, so stop running idle-time timers. */ -void +static void timer_stop_idle () { EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1); } +/* Resume idle timer from last idle start time. */ + +static void +timer_resume_idle () +{ + if (! EMACS_TIME_NEG_P (timer_idleness_start_time)) + return; + + timer_idleness_start_time = timer_last_idleness_start_time; +} + /* This is only for debugging. */ struct input_event last_timer_event; @@ -8846,14 +8856,7 @@ keymap may have changed, so replay the sequence. */ if (BUFFERP (key)) { - EMACS_TIME initial_idleness_start_time; - EMACS_SET_SECS_USECS (initial_idleness_start_time, - EMACS_SECS (timer_last_idleness_start_time), - EMACS_USECS (timer_last_idleness_start_time)); - - /* Resume idle state, using the same start-time as before. */ - timer_start_idle (); - timer_idleness_start_time = initial_idleness_start_time; + timer_resume_idle (); mock_input = t; /* Reset the current buffer from the selected window
--- a/src/keyboard.h Wed Oct 13 02:40:50 2004 +0000 +++ b/src/keyboard.h Thu Oct 14 08:50:09 2004 +0000 @@ -326,8 +326,6 @@ extern int help_char_p P_ ((Lisp_Object)); extern void quit_throw_to_read_char P_ ((void)) NO_RETURN; extern void cmd_error_internal P_ ((Lisp_Object, char *)); -extern void timer_start_idle P_ ((void)); -extern void timer_stop_idle P_ ((void)); extern int lucid_event_type_list_p P_ ((Lisp_Object)); extern void kbd_buffer_store_event P_ ((struct input_event *)); extern void kbd_buffer_store_event_hold P_ ((struct input_event *,
--- a/src/keymap.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/keymap.c Thu Oct 14 08:50:09 2004 +0000 @@ -268,7 +268,8 @@ /* Should we do an autoload? Autoload forms for keymaps have Qkeymap as their fifth element. */ - if ((autoload || !error) && EQ (XCAR (tem), Qautoload)) + if ((autoload || !error) && EQ (XCAR (tem), Qautoload) + && SYMBOLP (object)) { Lisp_Object tail;
--- a/src/mac.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/mac.c Thu Oct 14 08:50:09 2004 +0000 @@ -24,6 +24,7 @@ #include <stdio.h> #include <errno.h> +#include <time.h> #include <utime.h> #include <dirent.h> #include <sys/types.h> @@ -46,6 +47,8 @@ #undef realloc #undef init_process #include <Carbon/Carbon.h> +#undef mktime +#define mktime emacs_mktime #undef free #define free unexec_free #undef malloc @@ -72,6 +75,7 @@ #include "process.h" #include "sysselect.h" #include "systime.h" +#include "blockinput.h" Lisp_Object QCLIPBOARD; @@ -2547,7 +2551,9 @@ CHECK_STRING (script); + BLOCK_INPUT; status = do_applescript (SDATA (script), &result); + UNBLOCK_INPUT; if (status) { if (!result) @@ -2617,26 +2623,23 @@ () { #if TARGET_API_MAC_CARBON + OSStatus err; ScrapRef scrap; ScrapFlavorFlags sff; Size s; int i; char *data; - if (GetCurrentScrap (&scrap) != noErr) - return Qnil; - - if (GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff) != noErr) - return Qnil; - - if (GetScrapFlavorSize (scrap, kScrapFlavorTypeText, &s) != noErr) - return Qnil; - - if ((data = (char*) alloca (s)) == NULL) - return Qnil; - - if (GetScrapFlavorData (scrap, kScrapFlavorTypeText, &s, data) != noErr - || s == 0) + BLOCK_INPUT; + err = GetCurrentScrap (&scrap); + if (err == noErr) + err = GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff); + if (err == noErr) + err = GetScrapFlavorSize (scrap, kScrapFlavorTypeText, &s); + if (err == noErr && (data = (char*) alloca (s))) + err = GetScrapFlavorData (scrap, kScrapFlavorTypeText, &s, data); + UNBLOCK_INPUT; + if (err != noErr || s == 0) return Qnil; /* Emacs expects clipboard contents have Unix-style eol's */ @@ -2701,13 +2704,22 @@ #if TARGET_API_MAC_CARBON { ScrapRef scrap; + + BLOCK_INPUT; ClearCurrentScrap (); if (GetCurrentScrap (&scrap) != noErr) - error ("cannot get current scrap"); + { + UNBLOCK_INPUT; + error ("cannot get current scrap"); + } if (PutScrapFlavor (scrap, kScrapFlavorTypeText, kScrapFlavorMaskNone, len, buf) != noErr) - error ("cannot put to scrap"); + { + UNBLOCK_INPUT; + error ("cannot put to scrap"); + } + UNBLOCK_INPUT; } #else /* not TARGET_API_MAC_CARBON */ ZeroScrap (); @@ -2742,9 +2754,11 @@ ScrapRef scrap; ScrapFlavorFlags sff; + BLOCK_INPUT; if (GetCurrentScrap (&scrap) == noErr) if (GetScrapFlavorFlags (scrap, kScrapFlavorTypeText, &sff) == noErr) val = Qt; + UNBLOCK_INPUT; #else /* not TARGET_API_MAC_CARBON */ Handle my_handle; long rc, scrap_offset; @@ -2769,8 +2783,6 @@ extern int inhibit_window_system; extern int noninteractive; -#include "blockinput.h" - /* When Emacs is started from the Finder, SELECT always immediately returns as if input is present when file descriptor 0 is polled for input. Strangely, when Emacs is run as a GUI application from the
--- a/src/macfns.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/macfns.c Thu Oct 14 08:50:09 2004 +0000 @@ -312,6 +312,9 @@ Lisp_Object, char *, char *, int)); + +extern void mac_get_window_bounds P_ ((struct frame *, Rect *, Rect *)); + /* Store the screen positions of frame F into XPTR and YPTR. These are the positions of the containing window manager window, not Emacs's own window. */ @@ -321,33 +324,15 @@ FRAME_PTR f; int *xptr, *yptr; { - Point pt; - GrafPtr oldport; - - GetPort (&oldport); - SetPortWindowPort (FRAME_MAC_WINDOW (f)); - -#if TARGET_API_MAC_CARBON - { - Rect r; - - GetWindowPortBounds (FRAME_MAC_WINDOW (f), &r); - SetPt (&pt, r.left, r.top); - } -#else /* not TARGET_API_MAC_CARBON */ - SetPt (&pt, - FRAME_MAC_WINDOW (f)->portRect.left, - FRAME_MAC_WINDOW (f)->portRect.top); -#endif /* not TARGET_API_MAC_CARBON */ - LocalToGlobal (&pt); - SetPort (oldport); - - /* MAC has no frame pixel diff. */ - f->x_pixels_diff = 0; - f->y_pixels_diff = 0; - - *xptr = pt.h; - *yptr = pt.v; + Rect inner, outer; + + mac_get_window_bounds (f, &inner, &outer); + + f->x_pixels_diff = inner.left - outer.left; + f->y_pixels_diff = inner.top - outer.top; + + *xptr = outer.left; + *yptr = outer.top; } @@ -4262,6 +4247,7 @@ NavUserAction userAction; CFStringRef message=NULL, client=NULL, saveName = NULL; + BLOCK_INPUT; /* No need for a callback function because we are modal */ NavGetDefaultDialogCreationOptions(&options); options.modality = kWindowModalityAppModal; @@ -4332,9 +4318,7 @@ AEDisposeDesc(&defLocAed); } - BLOCK_INPUT; status = NavDialogRun(dialogRef); - UNBLOCK_INPUT; } if (saveName) CFRelease(saveName); @@ -4347,9 +4331,7 @@ { case kNavUserActionNone: case kNavUserActionCancel: - NavDialogDispose(dialogRef); - Fsignal (Qquit, Qnil); /* Treat cancel like C-g */ - return; + break; /* Treat cancel like C-g */ case kNavUserActionOpen: case kNavUserActionChoose: case kNavUserActionSaveAs: @@ -4384,6 +4366,7 @@ dir, mustmatch, dir, Qfile_name_history, default_filename, Qnil); } + UNBLOCK_INPUT; } UNGCPRO;
--- a/src/macgui.h Wed Oct 13 02:40:50 2004 +0000 +++ b/src/macgui.h Thu Oct 14 08:50:09 2004 +0000 @@ -42,6 +42,8 @@ #undef min #undef init_process #include <Carbon/Carbon.h> +#undef mktime +#define mktime emacs_mktime #undef Z #define Z (current_buffer->text->z) #undef free
--- a/src/macmenu.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/macmenu.c Thu Oct 14 08:50:09 2004 +0000 @@ -1322,7 +1322,7 @@ for (wv = first_wv; wv; wv = wv->next) { - if (wv->lname && ! NILP (wv->lname)) + if (STRINGP (wv->lname)) { wv->name = SDATA (wv->lname); @@ -1336,7 +1336,7 @@ } } - if (wv->lkey && ! NILP (wv->lkey)) + if (STRINGP (wv->lkey)) wv->key = SDATA (wv->lkey); if (wv->contents)
--- a/src/macterm.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/macterm.c Thu Oct 14 08:50:09 2004 +0000 @@ -50,6 +50,7 @@ #include <TextUtils.h> #include <LowMem.h> #include <Controls.h> +#include <Windows.h> #if defined (__MRC__) || (__MSL__ >= 0x6000) #include <ControlDefinitions.h> #endif @@ -1292,9 +1293,8 @@ output_cursor.vpos, output_cursor.x, output_cursor.y); - x_draw_vertical_border (w); - - draw_window_fringes (w); + if (draw_window_fringes (w, 1)) + x_draw_vertical_border (w); UNBLOCK_INPUT; } @@ -3893,18 +3893,21 @@ static WindowPtr -mac_front_window () +front_emacs_window () { #if TARGET_API_MAC_CARBON - return GetFrontWindowOfClass (kDocumentWindowClass, true); + WindowPtr wp = GetFrontWindowOfClass (kDocumentWindowClass, true); + + while (wp && !is_emacs_window (wp)) + wp = GetNextWindowOfClass (wp, kDocumentWindowClass, true); #else - WindowPtr front_window = FrontWindow (); - - if (tip_window && front_window == tip_window) - return GetNextWindow (front_window); - else - return front_window; + WindowPtr wp = FrontWindow (); + + while (wp && (wp == tip_window || !is_emacs_window (wp))) + wp = GetNextWindow (wp); #endif + + return wp; } #define mac_window_to_frame(wp) (((mac_output *) GetWRefCon (wp))->mFP) @@ -3940,7 +3943,7 @@ { Point mouse_pos; int ignore1, ignore2; - WindowPtr wp = mac_front_window (); + WindowPtr wp = front_emacs_window (); struct frame *f; Lisp_Object frame, tail; @@ -4557,7 +4560,7 @@ unsigned long *time; { struct scroll_bar *bar = XSCROLL_BAR (last_mouse_scroll_bar); - WindowPtr wp = mac_front_window (); + WindowPtr wp = front_emacs_window (); Point mouse_pos; struct frame *f = mac_window_to_frame (wp); int win_y, top_range; @@ -5053,6 +5056,26 @@ */ +void +mac_get_window_bounds (f, inner, outer) + struct frame *f; + Rect *inner, *outer; +{ +#if TARGET_API_MAC_CARBON + GetWindowBounds (FRAME_MAC_WINDOW (f), kWindowContentRgn, inner); + GetWindowBounds (FRAME_MAC_WINDOW (f), kWindowStructureRgn, outer); +#else /* not TARGET_API_MAC_CARBON */ + RgnHandle region = NewRgn (); + + GetWindowRegion (FRAME_MAC_WINDOW (f), kWindowContentRgn, region); + *inner = (*region)->rgnBBox; + GetWindowRegion (FRAME_MAC_WINDOW (f), kWindowStructureRgn, region); + *outer = (*region)->rgnBBox; + DisposeRgn (region); +#endif /* not TARGET_API_MAC_CARBON */ +} + + /* Calculate the absolute position in frame F from its current recorded position values and gravity. */ @@ -5060,47 +5083,36 @@ x_calc_absolute_position (f) struct frame *f; { - Point pt; + int width_diff = 0, height_diff = 0; int flags = f->size_hint_flags; - - pt.h = pt.v = 0; - - /* Find the position of the outside upper-left corner of + Rect inner, outer; + + /* We have nothing to do if the current position + is already for the top-left corner. */ + if (! ((flags & XNegative) || (flags & YNegative))) + return; + + /* Find the offsets of the outside upper-left corner of the inner window, with respect to the outer window. */ - if (f->output_data.mac->parent_desc != FRAME_MAC_DISPLAY_INFO (f)->root_window) - { - GrafPtr savePort; - GetPort (&savePort); - - SetPortWindowPort (FRAME_MAC_WINDOW (f)); - -#if TARGET_API_MAC_CARBON - { - Rect r; - - GetWindowPortBounds (FRAME_MAC_WINDOW (f), &r); - SetPt(&pt, r.left, r.top); - } -#else /* not TARGET_API_MAC_CARBON */ - SetPt(&pt, FRAME_MAC_WINDOW (f)->portRect.left, FRAME_MAC_WINDOW (f)->portRect.top); -#endif /* not TARGET_API_MAC_CARBON */ - LocalToGlobal (&pt); - SetPort (savePort); - } + mac_get_window_bounds (f, &inner, &outer); + + width_diff = (outer.right - outer.left) - (inner.right - inner.left); + height_diff = (outer.bottom - outer.top) - (inner.bottom - inner.top); /* Treat negative positions as relative to the leftmost bottommost position that fits on the screen. */ if (flags & XNegative) f->left_pos = (FRAME_MAC_DISPLAY_INFO (f)->width - - 2 * f->border_width - pt.h + - width_diff - FRAME_PIXEL_WIDTH (f) + f->left_pos); - /* NTEMACS_TODO: Subtract menubar height? */ + if (flags & YNegative) f->top_pos = (FRAME_MAC_DISPLAY_INFO (f)->height - - 2 * f->border_width - pt.v + - height_diff - FRAME_PIXEL_HEIGHT (f) + f->top_pos); + /* The left_pos and top_pos are now relative to the top and left screen edges, so the flags should correspond. */ @@ -5119,8 +5131,6 @@ register int xoff, yoff; int change_gravity; { - int modified_top, modified_left; - if (change_gravity > 0) { f->top_pos = yoff; @@ -5137,11 +5147,55 @@ BLOCK_INPUT; x_wm_set_size_hint (f, (long) 0, 0); - modified_left = f->left_pos; - modified_top = f->top_pos; - - MoveWindow (FRAME_MAC_WINDOW (f), modified_left + 6, - modified_top + 42, false); +#if TARGET_API_MAC_CARBON + MoveWindowStructure (FRAME_MAC_WINDOW (f), f->left_pos, f->top_pos); + /* If the title bar is completely outside the screen, adjust the + position. */ + ConstrainWindowToScreen (FRAME_MAC_WINDOW (f), kWindowTitleBarRgn, + kWindowConstrainMoveRegardlessOfFit + | kWindowConstrainAllowPartial, NULL, NULL); + x_real_positions (f, &f->left_pos, &f->top_pos); +#else + { + Rect inner, outer, screen_rect, dummy; + RgnHandle region = NewRgn (); + + mac_get_window_bounds (f, &inner, &outer); + f->x_pixels_diff = inner.left - outer.left; + f->y_pixels_diff = inner.top - outer.top; + MoveWindow (FRAME_MAC_WINDOW (f), f->left_pos + f->x_pixels_diff, + f->top_pos + f->y_pixels_diff, false); + + /* If the title bar is completely outside the screen, adjust the + position. The variable `outer' holds the title bar rectangle. + The variable `inner' holds slightly smaller one than `outer', + so that the calculation of overlapping may not become too + strict. */ + GetWindowRegion (FRAME_MAC_WINDOW (f), kWindowTitleBarRgn, region); + outer = (*region)->rgnBBox; + DisposeRgn (region); + inner = outer; + InsetRect (&inner, 8, 8); + screen_rect = qd.screenBits.bounds; + screen_rect.top += GetMBarHeight (); + + if (!SectRect (&inner, &screen_rect, &dummy)) + { + if (inner.right <= screen_rect.left) + f->left_pos = screen_rect.left; + else if (inner.left >= screen_rect.right) + f->left_pos = screen_rect.right - (outer.right - outer.left); + + if (inner.bottom <= screen_rect.top) + f->top_pos = screen_rect.top; + else if (inner.top >= screen_rect.bottom) + f->top_pos = screen_rect.bottom - (outer.bottom - outer.top); + + MoveWindow (FRAME_MAC_WINDOW (f), f->left_pos + f->x_pixels_diff, + f->top_pos + f->y_pixels_diff, false); + } + } +#endif UNBLOCK_INPUT; } @@ -5280,7 +5334,11 @@ struct frame *f; { if (f->async_visible) - SelectWindow (FRAME_MAC_WINDOW (f)); + { + BLOCK_INPUT; + SelectWindow (FRAME_MAC_WINDOW (f)); + UNBLOCK_INPUT; + } } /* Lower frame F. */ @@ -5289,7 +5347,11 @@ struct frame *f; { if (f->async_visible) - SendBehind (FRAME_MAC_WINDOW (f), nil); + { + BLOCK_INPUT; + SendBehind (FRAME_MAC_WINDOW (f), nil); + UNBLOCK_INPUT; + } } static void @@ -6926,6 +6988,7 @@ /* true when cannot handle any Mac OS events */ static int handling_window_update = 0; +#if 0 /* the flag appl_is_suspended is used both for determining the sleep time to be passed to WaitNextEvent and whether the cursor should be drawn when updating the display. The cursor is turned off when @@ -6935,6 +6998,7 @@ suspended. */ static Boolean app_is_suspended = false; static long app_sleep_time = WNE_SLEEP_AT_RESUME; +#endif #define EXTRA_STACK_ALLOC (256 * 1024) @@ -7261,11 +7325,13 @@ static void do_app_resume () { + /* Window-activate events will do the job. */ +#if 0 WindowPtr wp; struct frame *f; - wp = mac_front_window (); - if (is_emacs_window (wp)) + wp = front_emacs_window (); + if (wp) { f = mac_window_to_frame (wp); @@ -7278,16 +7344,19 @@ app_is_suspended = false; app_sleep_time = WNE_SLEEP_AT_RESUME; +#endif } static void do_app_suspend () { + /* Window-deactivate events will do the job. */ +#if 0 WindowPtr wp; struct frame *f; - wp = mac_front_window (); - if (is_emacs_window (wp)) + wp = front_emacs_window (); + if (wp) { f = mac_window_to_frame (wp); @@ -7300,6 +7369,7 @@ app_is_suspended = true; app_sleep_time = WNE_SLEEP_AT_SUSPEND; +#endif } @@ -7308,10 +7378,10 @@ Point mouse_pos; FRAME_PTR *f; { - WindowPtr wp = mac_front_window (); + WindowPtr wp = front_emacs_window (); struct x_display_info *dpyinfo; - if (is_emacs_window (wp)) + if (wp) { *f = mac_window_to_frame (wp); dpyinfo = FRAME_MAC_DISPLAY_INFO (*f); @@ -7373,7 +7443,7 @@ default: { - struct frame *f = mac_window_to_frame (mac_front_window ()); + struct frame *f = mac_window_to_frame (front_emacs_window ()); MenuHandle menu = GetMenuHandle (menu_id); if (menu) { @@ -7426,41 +7496,43 @@ GrafPtr save_port; Rect zoom_rect, port_rect; Point top_left; - int w_title_height, columns, rows, width, height, dummy, x, y; + int w_title_height, columns, rows; struct frame *f = mac_window_to_frame (w); +#if TARGET_API_MAC_CARBON + { + Point standard_size; + + standard_size.h = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, DEFAULT_NUM_COLS); + standard_size.v = FRAME_MAC_DISPLAY_INFO (f)->height; + + if (IsWindowInStandardState (w, &standard_size, &zoom_rect)) + zoom_in_or_out = inZoomIn; + else + { + /* Adjust the standard size according to character boundaries. */ + + columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, zoom_rect.right - zoom_rect.left); + rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, zoom_rect.bottom - zoom_rect.top); + standard_size.h = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, columns); + standard_size.v = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, rows); + GetWindowBounds (w, kWindowContentRgn, &port_rect); + if (IsWindowInStandardState (w, &standard_size, &zoom_rect) + && port_rect.left == zoom_rect.left + && port_rect.top == zoom_rect.top) + zoom_in_or_out = inZoomIn; + else + zoom_in_or_out = inZoomOut; + } + + ZoomWindowIdeal (w, zoom_in_or_out, &standard_size); + } +#else /* not TARGET_API_MAC_CARBON */ GetPort (&save_port); SetPortWindowPort (w); /* Clear window to avoid flicker. */ -#if TARGET_API_MAC_CARBON - { - Rect r; - BitMap bm; - - GetWindowPortBounds (w, &r); - EraseRect (&r); - - if (zoom_in_or_out == inZoomOut) - { - /* calculate height of window's title bar (hard card it for now). */ - w_title_height = 20 + GetMBarHeight (); - - /* get maximum height of window into zoom_rect.bottom - - zoom_rect.top */ - GetQDGlobalsScreenBits (&bm); - zoom_rect = bm.bounds; - zoom_rect.top += w_title_height; - InsetRect (&zoom_rect, 8, 4); /* not too tight */ - - zoom_rect.right = zoom_rect.left - + FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, DEFAULT_NUM_COLS); - - SetWindowStandardState (w, &zoom_rect); - } - } -#else /* not TARGET_API_MAC_CARBON */ EraseRect (&(w->portRect)); if (zoom_in_or_out == inZoomOut) { @@ -7479,13 +7551,20 @@ zoom_rect.right = zoom_rect.left + FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, DEFAULT_NUM_COLS); + /* Adjust the standard size according to character boundaries. */ + rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, zoom_rect.bottom - zoom_rect.top); + zoom_rect.bottom = + zoom_rect.top + FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, rows); + (**((WStateDataHandle) ((WindowPeek) w)->dataHandle)).stdState = zoom_rect; } + + ZoomWindow (w, zoom_in_or_out, w == front_emacs_window ()); + + SetPort (save_port); #endif /* not TARGET_API_MAC_CARBON */ - ZoomWindow (w, zoom_in_or_out, w == mac_front_window ()); - /* retrieve window size and update application values */ #if TARGET_API_MAC_CARBON GetWindowPortBounds (w, &port_rect); @@ -7495,8 +7574,7 @@ rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, port_rect.bottom - port_rect.top); columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, port_rect.right - port_rect.left); x_set_window_size (f, 0, columns, rows); - - SetPort (save_port); + x_real_positions (f, &f->left_pos, &f->top_pos); } /* Initialize Drag And Drop to allow files to be dropped onto emacs frames */ @@ -8046,19 +8124,15 @@ if (NILP (Fboundp (Qmac_ready_for_drag_n_drop))) event_mask -= highLevelEventMask; - while (WaitNextEvent (event_mask, &er, - (expected ? app_sleep_time : 0L), NULL)) -#else - while (!ReceiveNextEvent (0, NULL, - (expected ? TicksToEventTime (app_sleep_time) : 0), + while (WaitNextEvent (event_mask, &er, 0L, NULL)) +#else /* USE_CARBON_EVENTS */ + while (!ReceiveNextEvent (0, NULL, kEventDurationNoWait, kEventRemoveFromQueue, &eventRef)) -#endif /* !USE_CARBON_EVENTS */ +#endif /* USE_CARBON_EVENTS */ { int do_help = 0; struct frame *f; - expected = 0; - /* It is necessary to set this (additional) argument slot of an event to nil because keyboard.c protects incompletely processed event from being garbage collected by placing them @@ -8073,7 +8147,7 @@ switch (GetEventClass (eventRef)) { case kEventClassWindow: - if (GetEventKind (eventRef) == kEventWindowBoundsChanged) + if (GetEventKind (eventRef) == kEventWindowBoundsChanged) { WindowPtr window_ptr; GetEventParameter(eventRef, kEventParamDirectObject, @@ -8081,13 +8155,7 @@ NULL, &window_ptr); f = mac_window_to_frame (window_ptr); if (f && !f->async_iconified) - { - int x, y; - - x_real_positions (f, &x, &y); - f->left_pos = x; - f->top_pos = y; - } + x_real_positions (f, &f->left_pos, &f->top_pos); SendEventToEventTarget (eventRef, toolbox_dispatcher); } break; @@ -8096,7 +8164,7 @@ { SInt32 delta; Point point; - WindowPtr window_ptr = mac_front_window (); + WindowPtr window_ptr = front_emacs_window (); if (!IsValidWindowPtr (window_ptr)) { @@ -8158,33 +8226,28 @@ } else { - window_ptr = FrontWindow (); + part_code = FindWindow (er.where, &window_ptr); if (tip_window && window_ptr == tip_window) { HideWindow (tip_window); - window_ptr = FrontWindow (); + part_code = FindWindow (er.where, &window_ptr); } - - if (!is_emacs_window (window_ptr)) - break; - - part_code = FindWindow (er.where, &window_ptr); } + if (er.what != mouseDown && part_code != inContent) + break; + switch (part_code) { case inMenuBar: - if (er.what == mouseDown) - { - f = mac_window_to_frame (mac_front_window ()); - saved_menu_event_location = er.where; - inev.kind = MENU_BAR_ACTIVATE_EVENT; - XSETFRAME (inev.frame_or_window, f); - } + f = mac_window_to_frame (front_emacs_window ()); + saved_menu_event_location = er.where; + inev.kind = MENU_BAR_ACTIVATE_EVENT; + XSETFRAME (inev.frame_or_window, f); break; case inContent: - if (window_ptr != mac_front_window ()) + if (window_ptr != front_emacs_window ()) SelectWindow (window_ptr); else { @@ -8281,7 +8344,7 @@ } else { - if (dpyinfo->grabbed & (1 << inev.code) == 0) + if ((dpyinfo->grabbed & (1 << inev.code)) == 0) /* If a button is released though it was not previously pressed, that would be because of multi-button emulation. */ @@ -8304,27 +8367,16 @@ case inDrag: #if TARGET_API_MAC_CARBON - if (er.what == mouseDown) - { - BitMap bm; - - GetQDGlobalsScreenBits (&bm); - DragWindow (window_ptr, er.where, &bm.bounds); - } + DragWindow (window_ptr, er.where, NULL); #else /* not TARGET_API_MAC_CARBON */ DragWindow (window_ptr, er.where, &qd.screenBits.bounds); #endif /* not TARGET_API_MAC_CARBON */ /* Update the frame parameters. */ { struct frame *f = mac_window_to_frame (window_ptr); + if (f && !f->async_iconified) - { - int x, y; - - x_real_positions (f, &x, &y); - f->left_pos = x; - f->top_pos = y; - } + x_real_positions (f, &f->left_pos, &f->top_pos); } break; @@ -8339,11 +8391,8 @@ /* window resize handling added --ben */ case inGrow: - if (er.what == mouseDown) - { - do_grow_window(window_ptr, &er); - break; - } + do_grow_window (window_ptr, &er); + break; /* window zoom handling added --ben */ case inZoomIn: @@ -8415,7 +8464,7 @@ if (!is_emacs_window (window_ptr)) break; - + f = mac_window_to_frame (window_ptr); if ((er.modifiers & activeFlag) != 0) @@ -8486,7 +8535,7 @@ #endif #if TARGET_API_MAC_CARBON - if (!IsValidWindowPtr (mac_front_window ())) + if (!IsValidWindowPtr (front_emacs_window ())) { SysBeep (1); break; @@ -8590,7 +8639,7 @@ inev.modifiers = mac_to_emacs_modifiers (er.modifiers); #endif XSETFRAME (inev.frame_or_window, - mac_window_to_frame (mac_front_window ())); + mac_window_to_frame (front_emacs_window ())); inev.timestamp = er.when * (1000 / 60); /* ticks to milliseconds */ break; @@ -8607,16 +8656,16 @@ WindowPtr wp; Lisp_Object frame; - wp = mac_front_window (); + wp = front_emacs_window (); if (!wp) { struct frame *f = XFRAME (XCAR (Vframe_list)); CollapseWindow (FRAME_MAC_WINDOW (f), false); - wp = mac_front_window (); + wp = front_emacs_window (); } - if (wp && is_emacs_window (wp)) + if (wp) f = mac_window_to_frame (wp); inev.kind = DRAG_N_DROP_EVENT; @@ -8742,6 +8791,7 @@ mwp = fp->output_data.mac; + BLOCK_INPUT; if (making_terminal_window) { if (!(mwp->mWP = GetNewCWindow (TERM_WINDOW_RESOURCE, NULL, @@ -8769,9 +8819,8 @@ /* so that update events can find this mac_output struct */ mwp->mFP = fp; /* point back to emacs frame */ - SetPortWindowPort (mwp->mWP); - SizeWindow (mwp->mWP, FRAME_PIXEL_WIDTH (fp), FRAME_PIXEL_HEIGHT (fp), false); + UNBLOCK_INPUT; } @@ -9073,7 +9122,7 @@ e.arg = Qnil; e.modifiers = NULL; e.timestamp = EventTimeToTicks (GetEventTime (event)) * (1000/60); - XSETFRAME (e.frame_or_window, mac_window_to_frame (mac_front_window ())); + XSETFRAME (e.frame_or_window, mac_window_to_frame (front_emacs_window ())); /* Remove event from queue to prevent looping. */ RemoveEventFromQueue (GetMainEventQueue (), event); ReleaseEvent (event); @@ -9194,6 +9243,7 @@ signal (SIGPIPE, x_connection_signal); #endif + BLOCK_INPUT; mac_initialize_display_info (); #if TARGET_API_MAC_CARBON @@ -9212,6 +9262,7 @@ if (!inhibit_window_system) MakeMeTheFrontProcess (); #endif + UNBLOCK_INPUT; }
--- a/src/textprop.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/textprop.c Thu Oct 14 08:50:09 2004 +0000 @@ -1,5 +1,5 @@ /* Interface code for dealing with text properties. - Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003 + Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -2233,7 +2233,9 @@ the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil, inherits it if NONSTICKINESS is nil. The front-sticky and rear-nonsticky properties of the character overrides NONSTICKINESS. */); - Vtext_property_default_nonsticky = Qnil; + /* Text property `syntax-table' should be nonsticky by default. */ + Vtext_property_default_nonsticky + = Fcons (Fcons (intern ("syntax-table"), Qt), Qnil); staticpro (&interval_insert_behind_hooks); staticpro (&interval_insert_in_front_hooks);
--- a/src/unexmacosx.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/unexmacosx.c Thu Oct 14 08:50:09 2004 +0000 @@ -99,7 +99,12 @@ #if defined (__ppc__) #include <mach-o/ppc/reloc.h> #endif +#if defined (HAVE_MALLOC_MALLOC_H) +#include <malloc/malloc.h> +#else #include <objc/malloc.h> +#endif + #define VERBOSE 1
--- a/src/w32term.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/w32term.c Thu Oct 14 08:50:09 2004 +0000 @@ -567,9 +567,8 @@ output_cursor.vpos, output_cursor.x, output_cursor.y); - x_draw_vertical_border (w); - - draw_window_fringes (w); + if (draw_window_fringes (w, 1)) + x_draw_vertical_border (w); UNBLOCK_INPUT; }
--- a/src/window.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/window.c Thu Oct 14 08:50:09 2004 +0000 @@ -607,9 +607,6 @@ int grabbable_width = ux; int lmargin_width, rmargin_width, text_left, text_right; - if (*x < x0 || *x >= x1) - return ON_NOTHING; - /* In what's below, we subtract 1 when computing right_x because we want the rightmost pixel, which is given by left_pixel+width-1. */ if (w->pseudo_window_p) @@ -659,6 +656,9 @@ return ON_VERTICAL_BORDER; } + if (*x < x0 || *x >= x1) + return ON_NOTHING; + /* Convert X and Y to window relative coordinates. Mode line starts at left edge of window. */ *x -= x0; @@ -673,6 +673,9 @@ goto header_vertical_border_check; } + if (*x < x0 || *x >= x1) + return ON_NOTHING; + /* Outside any interesting column? */ if (*x < left_x || *x > right_x) return ON_SCROLL_BAR; @@ -6034,9 +6037,9 @@ struct window *w = decode_window (window); if (!NILP (left)) - CHECK_NUMBER (left); + CHECK_NATNUM (left); if (!NILP (right)) - CHECK_NUMBER (right); + CHECK_NATNUM (right); if (!EQ (w->left_fringe_width, left) || !EQ (w->right_fringe_width, right) @@ -6096,7 +6099,7 @@ struct window *w = decode_window (window); if (!NILP (width)) - CHECK_NUMBER (width); + CHECK_NATNUM (width); if (XINT (width) == 0) vertical_type = Qnil;
--- a/src/xdisp.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/xdisp.c Thu Oct 14 08:50:09 2004 +0000 @@ -216,6 +216,8 @@ extern int interrupt_input; extern int command_loop_level; +extern Lisp_Object do_mouse_tracking; + extern int minibuffer_auto_raise; extern Lisp_Object Vminibuffer_list; @@ -10517,6 +10519,9 @@ } else redisplay_internal (1); + + if (rif != NULL && rif->flush_display_optional) + rif->flush_display_optional (NULL); } @@ -12320,7 +12325,8 @@ { update_begin (f); BLOCK_INPUT; - draw_window_fringes (w); + if (draw_window_fringes (w, 1)) + x_draw_vertical_border (w); UNBLOCK_INPUT; update_end (f); } @@ -18800,8 +18806,10 @@ if (STRINGP (it->object)) position = make_number (IT_STRING_CHARPOS (*it)); - else + else if (BUFFERP (it->object)) position = make_number (IT_CHARPOS (*it)); + else + return Qnil; val = Fget_char_property (position, prop, it->object); @@ -20912,6 +20920,10 @@ Cursor cursor; Lisp_Object pointer; { + /* Do not change cursor shape while dragging mouse. */ + if (!NILP (do_mouse_tracking)) + return; + if (!NILP (pointer)) { if (EQ (pointer, Qarrow)) @@ -21773,6 +21785,9 @@ do it for frames with vertical scroll bars because either the right scroll bar of a window, or the left scroll bar of its neighbor will suffice as a border. */ + if (FRAME_HAS_VERTICAL_SCROLL_BARS (XFRAME (w->frame))) + return; + if (!WINDOW_RIGHTMOST_P (w) && !WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)) {
--- a/src/xfns.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/xfns.c Thu Oct 14 08:50:09 2004 +0000 @@ -5551,7 +5551,7 @@ last_show_tip_args = Qnil; staticpro (&last_show_tip_args); -#ifdef USE_MOTIF +#if defined (USE_MOTIF) || defined (USE_GTK) defsubr (&Sx_file_dialog); #endif }
--- a/src/xterm.c Wed Oct 13 02:40:50 2004 +0000 +++ b/src/xterm.c Thu Oct 14 08:50:09 2004 +0000 @@ -572,9 +572,8 @@ output_cursor.vpos, output_cursor.x, output_cursor.y); - x_draw_vertical_border (w); - - draw_window_fringes (w); + if (draw_window_fringes (w, 1)) + x_draw_vertical_border (w); UNBLOCK_INPUT; } @@ -3389,12 +3388,14 @@ Alt keysyms are on. */ { int row, col; /* The row and column in the modifier table. */ + int found_alt_or_meta; for (row = 3; row < 8; row++) + { + found_alt_or_meta = 0; for (col = 0; col < mods->max_keypermod; col++) { - KeyCode code - = mods->modifiermap[(row * mods->max_keypermod) + col]; + KeyCode code = mods->modifiermap[(row * mods->max_keypermod) + col]; /* Zeroes are used for filler. Skip them. */ if (code == 0) @@ -3412,33 +3413,44 @@ { case XK_Meta_L: case XK_Meta_R: + found_alt_or_meta = 1; dpyinfo->meta_mod_mask |= (1 << row); break; case XK_Alt_L: case XK_Alt_R: + found_alt_or_meta = 1; dpyinfo->alt_mod_mask |= (1 << row); break; case XK_Hyper_L: case XK_Hyper_R: - dpyinfo->hyper_mod_mask |= (1 << row); + if (!found_alt_or_meta) + dpyinfo->hyper_mod_mask |= (1 << row); + code_col = syms_per_code; + col = mods->max_keypermod; break; case XK_Super_L: case XK_Super_R: - dpyinfo->super_mod_mask |= (1 << row); + if (!found_alt_or_meta) + dpyinfo->super_mod_mask |= (1 << row); + code_col = syms_per_code; + col = mods->max_keypermod; break; case XK_Shift_Lock: /* Ignore this if it's not on the lock modifier. */ - if ((1 << row) == LockMask) + if (!found_alt_or_meta && ((1 << row) == LockMask)) dpyinfo->shift_lock_mask = LockMask; + code_col = syms_per_code; + col = mods->max_keypermod; break; } } } } + } } /* If we couldn't find any meta keys, accept any alt keys as meta keys. */ @@ -5052,9 +5064,15 @@ /* Compute the left edge of the scroll bar. */ #ifdef USE_TOOLKIT_SCROLL_BARS if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)) - sb_left = left + width - sb_width - (width - sb_width) / 2; + sb_left = (left + + (WINDOW_RIGHTMOST_P (w) + ? width - sb_width - (width - sb_width) / 2 + : 0)); else - sb_left = left + (width - sb_width) / 2; + sb_left = (left + + (WINDOW_LEFTMOST_P (w) + ? (width - sb_width) / 2 + : width - sb_width)); #else if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)) sb_left = left + width - sb_width; @@ -5107,19 +5125,20 @@ width); #else /* not USE_GTK */ - /* Since toolkit scroll bars are smaller than the space reserved - for them on the frame, we have to clear "under" them. */ - if (width > 0 && height > 0) - x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - left, top, width, height, False); /* Move/size the scroll bar widget. */ if (mask) + { + /* Since toolkit scroll bars are smaller than the space reserved + for them on the frame, we have to clear "under" them. */ + if (width > 0 && height > 0) + x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + left, top, width, height, False); XtConfigureWidget (SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar), sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM, top, sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2, max (height, 1), 0); - + } #endif /* not USE_GTK */ #else /* not USE_TOOLKIT_SCROLL_BARS */ @@ -10918,7 +10937,7 @@ x_update_window_end, x_cursor_to, x_flush, -#ifndef XFlush +#ifdef XFlush x_flush, #else 0, /* flush_display_optional */