diff options
134 files changed, 7874 insertions, 1443 deletions
@@ -1,3 +1,18 @@ +2004-10-08 Steven Tamm <[email protected]> + + * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h + * configure: Rebuild + +2004-10-06 Jan Dj,Ad(Brv <[email protected]> + + * 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. <[email protected]> + + * configure.in (HAVE_RANDOM_HEAPSTART): Renamed HAVE_EXECSHIELD. + Run test to see if heap start address is random. + 2004-09-29 Miles Bader <[email protected]> * configure.in (HAVE_EXECSHIELD): Test correct env variable to see diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index 19f06efa4a..1898cf4dea 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -28,8 +28,6 @@ isearch faces. ** 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/rmail.texi 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 @@ -310,7 +310,7 @@ ac_includes_default="\ # 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 @@ esac 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ rm -f conftest* -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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ _ACEOF 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 @@ fi 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 @@ ac_x_header_dirs=' /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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ else # 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 @@ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 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 -lpng? ${HAVE_PNG}" 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,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@INSTALL_INFO@,$INSTALL_INFO,;t t s,@EGREP@,$EGREP,;t t -s,@SETARCH@,$SETARCH,;t t s,@LIBSOUND@,$LIBSOUND,;t t +s,@SETARCH@,$SETARCH,;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 @@ esac *) 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 @@ echo "$as_me: error: cannot find input file: $f" >&2;} 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 diff --git a/configure.in b/configure.in index 1f899a0808..519f826f27 100644 --- a/configure.in +++ b/configure.in @@ -1286,25 +1286,6 @@ AC_LINK_IFELSE([main(){return 0;}], 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 @@ AH_TEMPLATE(POINTER_TYPE, [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 @@ if test "${with_carbon}" != "no"; then 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 -lpng? ${HAVE_PNG}" 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,'` diff --git a/etc/CENSORSHIP b/etc/CENSORSHIP index 24bca11479..ca949aa6b6 100644 --- a/etc/CENSORSHIP +++ b/etc/CENSORSHIP @@ -54,7 +54,7 @@ rules. 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. diff --git a/etc/ChangeLog b/etc/ChangeLog index 981fd88ba3..08e72c60c2 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,16 @@ +2004-10-08 Fr,Ai(Bd,Ai(Bric Bothamy <[email protected]> (tiny change) + + * TUTORIAL.fr: Minor wording fix. + +2004-10-04 Luc Teirlinck <[email protected]> + + * enriched.doc: Update for new bindings of `set-left-margin' and + `set-right-margin'. + +2004-10-04 Kim F. Storm <[email protected]> + + * DEBUG: Mention pp and ff commands. + 2004-09-26 Luc Teirlinck <[email protected]> * enriched.doc: `enriched-annotation-alist' is now called @@ -69,9 +69,11 @@ fatal error, you can use the GDB command `pr'. First print the value 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 @@ Several more functions for debugging display code are available in 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 @@ -174,6 +174,21 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types. * 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 @@ to new-kill-line, these commands now report: 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 @@ controls whether or not the function `make-auto-save-file-name' will 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 @@ appointments, paydays or anything else using a sexp. 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 @@ symbol identifying a fringe bitmap, either built-in or defined with `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 @@ If either property is not set, the default `overlay-arrow-string' or 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 @@ -34,6 +34,9 @@ to the FSF. ** 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". diff --git a/etc/TUTORIAL.fr b/etc/TUTORIAL.fr index ae88ff4a24..38853c608b 100644 --- a/etc/TUTORIAL.fr +++ b/etc/TUTORIAL.fr @@ -17,7 +17,7 @@ Tapez C-x C-c (deux caract�res) pour terminer une session Emacs. 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 @@ touche META, EDIT ou ALT). >> 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 @@ avant la position courante du curseur. 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 @@ espaces, les effacent (vous ne pouvez donc pas r�cup�rer ce texte). 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 @@ sauvegardez, Emacs garde le fichier original sous un nom modifi� au 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 @@ l'�diter. Vous pouvez �galement trouver un fichier qui n'existe pas 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 @@ non. * 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 @@ param�tre par <Entr�e>. 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 @@ zone d'�cho �. La zone d'�cho contient la derni�re ligne de l'�cran. 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 @@ Emacs poss�de de nombreux modes majeurs diff�rents. Certains sont 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 @@ haut dans le texte, faites plut�t C-r. Tout ce que nous avons dit sur 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 diff --git a/etc/enriched.doc b/etc/enriched.doc index 55e11004f0..122652f005 100644 --- a/etc/enriched.doc +++ b/etc/enriched.doc @@ -98,8 +98,8 @@ direct request, such as using the return key or the <fixed>C-o <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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 29abaaf21b..41606eb7e9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,4 +1,233 @@ -2004-10-03 Stefan <[email protected]> +2004-10-13 Daniel Pfeiffer <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + 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 <[email protected]>. + (tramp-perl-decode): Fix an error in Perl implementation. + $pending must be cleared every loop. Reported by Benjamin Place + + * 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 <[email protected]>. + +2004-10-12 Stefan Monnier <[email protected]> + + * 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 <[email protected]> + + * recentf.el (recentf-edit-list): Update the menu when the recentf + list has been modified. + +2004-10-12 Simon Josefsson <[email protected]> + + * net/tls.el (tls-certtool-program): New variable. + (tls-certificate-information): New function, based on + ssl-certificate-information. + +2004-10-12 Kenichi Handa <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * emacs-lisp/byte-opt.el (byte-optimize-backward-word): Optimize + `(backward-word)' to `(forward-word -1)', not `(forward-char -1)'. + Reported by <[email protected]>. + +2004-10-10 Benjamin Rutt <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * subr.el (progress-reporter-update): Define before first usage. + (make-progress-reporter): Doc fix. + +2004-10-09 Luc Teirlinck <[email protected]> + + * textmodes/paragraphs.el (sentence-end-double-space) + (sentence-end-without-period, sentence-end-without-space) + (sentence-end): Doc fixes. + +2004-10-08 Peter Seibel <[email protected]> (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 <[email protected]> (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 <[email protected]> + + * 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 <[email protected]> + + * isearch.el (isearch-yank-line): C-y yanks to next EOL, not end + of current line. + +2004-10-08 Masatake YAMATO <[email protected]> + + * 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 <[email protected]> + + * xml.el (xml-substitute-special): Limit handling of external entities. + +2004-10-06 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-ann3): (Re-)initialise gdb-input-queue. + +2004-10-06 John Paul Wallington <[email protected]> + + * xml.el (xml-parse-dtd): Fix `error' call. + +2004-10-05 Mark A. Hershberger <[email protected]> + + * 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 <[email protected]> + + * calendar/icalendar.el: New file. + +2004-10-05 Juri Linkov <[email protected]> + + * isearch.el (isearch-done): Set mark after running hook. + Suggested by Drew Adams <[email protected]>. + + * 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 <[email protected]>: + + * 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 <[email protected]> + + * 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 <[email protected]>. + +2004-10-04 Luc Teirlinck <[email protected]> + + * 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 <[email protected]> * 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 <[email protected]> +2004-09-28 Stefan Monnier <[email protected]> * 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 <[email protected]>. -2004-09-26 Stefan <[email protected]> +2004-09-26 Stefan Monnier <[email protected]> * 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 <[email protected]> +2004-09-25 Stefan Monnier <[email protected]> * 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 <[email protected]> +2004-09-19 Stefan Monnier <[email protected]> * subr.el (event-basic-type): Fix mask (extend to 22bits). diff --git a/lisp/button.el b/lisp/button.el index 35905b9e1e..dcd26846d1 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -78,6 +78,7 @@ Mode-specific keymaps may want to use this as their parent keymap.") (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 @@ changes to a supertype are not reflected in its subtypes)." 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 @@ instead of starting at the next button." (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. diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index e66f50bd40..c24a13b91d 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -93,18 +93,15 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." (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 @@ C-w Describe how there is no warranty for Calc." 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) diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 772b39ffed..c01d37e684 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -160,21 +160,25 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)." (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) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 5c7e24ed64..c17449a845 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -942,7 +942,8 @@ If nil, selections displayed but ignored.") 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 diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el index 0d9ad45c7d..058bdf071d 100644 --- a/lisp/calendar/cal-iso.el +++ b/lisp/calendar/cal-iso.el @@ -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 <[email protected]> +;; Maintainer: Glenn Morris <[email protected]> ;; Keywords: calendar ;; Human-Keywords: ISO calendar, calendar, diary @@ -96,27 +97,39 @@ Defaults to today's date if DATE is not given." (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))) diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index a652e7ca76..ceb4c56f7f 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -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 <[email protected]> ;; Lara Rios <[email protected]> +;; Maintainer: Glenn Morris <[email protected]> ;; 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] diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 9d38cde21c..aa0b3005fa 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1769,6 +1769,10 @@ Driven by the variable `calendar-date-display-form'.") "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 @@ the inserted text. Value is always t." (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) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el new file mode 100644 index 0000000000..e83e8e980b --- /dev/null +++ b/lisp/calendar/icalendar.el @@ -0,0 +1,1299 @@ +;;; icalendar.el --- iCalendar implementation + +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. + +;; Author: Ulf Jasper <[email protected]> +;; 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 diff --git a/lisp/comint.el b/lisp/comint.el index 8b5a107c7d..8b2c779ecd 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -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 <[email protected]> ;; Simon Marshall <[email protected]> @@ -185,10 +185,10 @@ the remaining prompts will be accidentally messed up. You may 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 @@ Takes one argument, the input. If non-nil, the input may be saved on the input 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 @@ See `comint-send-input'." (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 @@ executed once when the buffer is created." :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 @@ Entry to this mode runs the hooks on `comint-mode-hook'." ;; 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 @@ buffer. The hook `comint-exec-hook' is run after each exec." (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 @@ buffer. The hook `comint-exec-hook' is run after each exec." ;; 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 @@ Make backspaces delete the previous character." (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 @@ This command also kills the pending input 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 @@ preceding newline is removed." (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 @@ Provides a default, if there is one, and returns the result filename. 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 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." (provide 'comint) -;;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164 +;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164 ;;; comint.el ends here diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index 0a7f1a1950..c945a6a722 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -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 <[email protected]> ;; Keywords: convenience patch diff @@ -171,75 +172,73 @@ when editing big diffs)." (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 @@ For use in `add-log-current-defun-function'." (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 @@ For use in `add-log-current-defun-function'." ;; 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 diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 825df2526c..1891389364 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1152,7 +1152,7 @@ of FORM by signalling the error at compile-time." (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) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 700fc5f80a..f4364c38e8 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -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 @@ paragraph of it that point is in, preserving the comment's indentation 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 @@ and initial semicolons." ;; 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 @@ means don't indent that line." (provide 'lisp-mode) -;;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf +;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf ;;; lisp-mode.el ends here diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 63d9f759ce..87b3fcff96 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -75,17 +75,19 @@ The place mark goes is the same place \\[forward-sexp] would 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)))) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index f5b68a3c24..2a2777d102 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1324,6 +1324,12 @@ HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'." (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) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 907ad5f341..292d36ce9e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,55 @@ +2004-10-13 Katsumi Yamaoka <[email protected]> + + * message.el (message-tokenize-header): Fix 2004-09-06 change + which used point-min in the wrong place. + +2004-10-12 Simon Josefsson <[email protected]> + + * net/tls.el (tls-certtool-program): New variable. + (tls-certificate-information): New function, based on + ssl-certificate-information. + +2004-10-10 Reiner Steib <[email protected]> + + * 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 <[email protected]>. + + * 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 <[email protected]>. + + * mml.el (mml-minibuffer-read-disposition): Require match. + Suggested by Dave Love <[email protected]>. + +2004-10-06 Katsumi Yamaoka <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> * gnus-sum.el (gnus-summary-toggle-header): Make it work even if diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 9f7b259e06..435acb1d6c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1046,7 +1046,8 @@ The following commands are available: (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) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 33531e7f8a..7dcef4b813 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1534,7 +1534,8 @@ The source file has to be in the Emacs load path." ;; 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)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 40278da471..42c699ef55 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -428,6 +428,9 @@ this variable specifies group names." (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 @@ buffer that was in action when the last article was fetched." [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 @@ the subject line on." ;; 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 diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 979ee2a7c2..bff1c3bba2 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -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." diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el index 754473fa8e..326c998c5d 100644 --- a/lisp/gnus/imap.el +++ b/lisp/gnus/imap.el @@ -2421,7 +2421,7 @@ Return nil if no complete line has arrived." (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 @@ Return nil if no complete line has arrived." (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 @@ Return nil if no complete line has arrived." (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 @@ Return nil if no complete line has arrived." (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 @@ Return nil if no complete line has arrived." (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))))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 8e5edbc048..c9d05d1a0f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1615,11 +1615,11 @@ is used by default." (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 @@ Otherwise, generate and save a value for `canlock-password' first." 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)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 1843cf2068..221e171261 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -945,8 +945,7 @@ See Info node `(emacs-mime)Composing'. "attachment"))) (disposition (completing-read "Disposition: " '(("attachment") ("inline") ("")) - nil - nil))) + nil t))) (if (not (equal disposition "")) disposition default))) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 1b6ec63673..7df5ecae20 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -74,7 +74,15 @@ Integer values will in effect be rounded up to the nearest multiple of (defvar nnheader-read-timeout (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" (symbol-name system-type)) - 1.0 ; why? + ;; http://thread.gmane.org/[email protected] + ;; + ;; 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.") diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 567ab24e00..e288f6cace 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -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.") - -(defvar pop3-password-required t - "*Non-nil if a password is required when connecting to POP server.") +(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) + +(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.") - -(defvar pop3-leave-mail-on-server nil - "*Non-nil if the mail is to be left on the POP server after fetching.") +values are 'apop." + :version "21.4" ;; Oort Gnus + :type '(choice (const :tag "USER/PASS" pass) + (const :tag "APOP" apop)) + :group 'pop3) + +(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 @@ Used for APOP authentication.") (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 @@ Used for APOP authentication.") "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 @@ Returns the process associated with the connection." (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 @@ This function currently does nothing.") (while (not (re-search-forward "^\\.\r\n" nil t)) ;; Fixme: Shouldn't depend on nnheader. (nnheader-accept-process-output process) - ;; [email protected] ... 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)) - ;; [email protected] - ;; 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) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d193ad344f..57b0b39767 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -552,9 +552,15 @@ it is displayed along with the global value." (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)) diff --git a/lisp/help.el b/lisp/help.el index bf0df4358a..5a2867bdc1 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -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 @@ whose documentation describes the minor mode." (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)))) diff --git a/lisp/imenu.el b/lisp/imenu.el index 1c82fcacf3..6859c0c74c 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -317,9 +317,12 @@ The function in this variable is called when selecting a normal index-item.") ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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 @@ A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).") (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 @@ depending on PATTERNS." (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 @@ Returns t for rescan and otherwise a position number." 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 @@ The returned value is of the form (INDEX-NAME . INDEX-POSITION)." (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 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook." 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 @@ for more information." (provide 'imenu) -;;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7 +;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7 ;;; imenu.el ends here diff --git a/lisp/info-look.el b/lisp/info-look.el index 644ee3d6c2..3f3ea7c2fd 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -245,6 +245,7 @@ system." (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 @@ With prefix arg a query for the symbol help mode is offered." (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. diff --git a/lisp/info.el b/lisp/info.el index b779bb41ca..386f5b612e 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -79,8 +79,8 @@ The Lisp code is executed when the node is selected.") :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 @@ Do the right thing if the file has been compressed or zipped." ;;;###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 @@ If SAME-FILE is non-nil, do not move to a different Info file." (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 @@ If SAME-FILE is non-nil, do not move to a different Info file." "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 @@ Table of contents is created from the tree structure of menus." (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 @@ The locations are of the format used in `Info-history', i.e. (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)) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 6fc3477fd3..2199420fd3 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -870,6 +870,18 @@ like `mime-charset' as well as the current style like `:mime-charset'." (and (not (> (downcase c1) (downcase c2))) (< c1 c2))))))) +(defun coding-system-equal (coding-system-1 coding-system-2) + "Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical. +Two coding systems are identical if two symbols are equal +or one is an alias of the other." + (or (eq coding-system-1 coding-system-2) + (and (equal (coding-system-spec coding-system-1) + (coding-system-spec coding-system-2)) + (let ((eol-type-1 (coding-system-eol-type coding-system-1)) + (eol-type-2 (coding-system-eol-type coding-system-2))) + (or (eq eol-type-1 eol-type-2) + (and (vectorp eol-type-1) (vectorp eol-type-2))))))) + (defun add-to-coding-system-list (coding-system) "Add CODING-SYSTEM to `coding-system-list' while keeping it sorted." (if (or (null coding-system-list) diff --git a/lisp/isearch.el b/lisp/isearch.el index 1e8e0f6586..0d1d7e32cd 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -676,16 +676,7 @@ is treated as a regexp. See \\[isearch-forward] for more info." (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 @@ is treated as a regexp. See \\[isearch-forward] for more info." (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 @@ might return the position of the end of the line." (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. diff --git a/lisp/kmacro.el b/lisp/kmacro.el index b2226d4a89..2b4cbcaf32 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -248,7 +248,9 @@ macro to be executed before appending to it." "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 @@ With \\[universal-argument], insert previous kmacro-counter (but do not modify c "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 @@ Optional arg EMPTY is message to print if no macros are defined." (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")))) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 675444d7ba..b7521ad8e9 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -234,6 +234,13 @@ we will act as though we couldn't find a full name in the address." :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 <[email protected]>\" +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 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL "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 @@ consing a string.)" (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)) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 84a6135014..d356979ea2 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -471,26 +471,32 @@ This is relative to `smtpmail-queue-dir'.") (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) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index c1f3c0a8d5..16a4826b8a 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4514,9 +4514,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") 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 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") 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. diff --git a/lisp/net/tls.el b/lisp/net/tls.el index d7c8a47a2c..5f57c084f9 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -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 <[email protected]> ;; Keywords: comm, tls, gnutls, ssl @@ -76,6 +76,35 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." :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. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 6a888d9d75..4628af8817 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1087,7 +1087,7 @@ Return the difference in the format of a time value." ;; `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 @@ Return the difference in the format of a time value." ;; 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: diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index cda0d41fd8..a30280dbd4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1668,6 +1668,7 @@ while (my $data = <STDIN>) { 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 @@ If VAR is nil, then we bind `v' to the structure and `multi-method', (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 @@ as default." (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) ...)." diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 46b33b2d50..7456bc1660 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -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 "[email protected]" diff --git a/lisp/pcvs-defs.el b/lisp/pcvs-defs.el index 16e2ff8255..cd379afab7 100644 --- a/lisp/pcvs-defs.el +++ b/lisp/pcvs-defs.el @@ -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 <[email protected]> ;; Keywords: pcl-cvs @@ -249,9 +249,6 @@ Output from cvs is placed here for asynchronous commands.") :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 @@ message and replace it with a message tell you to change this variable.") ;; (provide 'pcvs-defs) -;;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e +;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e ;;; pcvs-defs.el ends here diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el index 84dbf21858..7ab6c53b4a 100644 --- a/lisp/pcvs-parse.el +++ b/lisp/pcvs-parse.el @@ -511,15 +511,19 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (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 diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index ddbd2ce6f3..0569d26db6 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1229,10 +1229,10 @@ where they were found." (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 @@ where they were found." (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 @@ where they were found." (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 diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 612a2034e0..d8f2cf3486 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -188,6 +188,7 @@ detailed description of this mode. (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) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 4ea4fcb6ea..37fe13ce58 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3027,6 +3027,27 @@ class of the file (using s to separate nested class ids)." (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 @@ class of the file (using s to separate nested class ids)." (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 diff --git a/lisp/recentf.el b/lisp/recentf.el index efe4ebc63a..4ef55d4e1b 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1032,7 +1032,8 @@ Click on Cancel or type \"q\" to quit.\n") (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 " ") diff --git a/lisp/server.el b/lisp/server.el index fe2fc0f59f..3a330f07a3 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -343,7 +343,11 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (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)) diff --git a/lisp/subr.el b/lisp/subr.el index e5a967310d..eb4577b1a8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -367,15 +367,6 @@ but optional second arg NODIGITS non-nil treats them like other chars." (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 @@ but optional second arg NODIGITS non-nil treats them like other chars." "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 @@ in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP." ;; 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 @@ even when EVENT actually has modifiers." (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 @@ in the current Emacs session, then this function may return nil." (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 @@ Use a MESSAGE of \"\" to temporarily clear the echo area." 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 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (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 diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index a2e9ac8fff..181fc9baca 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -405,11 +405,12 @@ MODE should be an integer which is a file mode value." 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 @@ is visible (and the real data of the buffer is hidden)." (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 @@ is visible (and the real data of the buffer is hidden)." ;; 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)) diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index c2ed47cb48..71bb6cf137 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -258,8 +258,8 @@ Commands: (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 diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 868dcb2d10..206f7a42f7 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -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 @@ This is relevant for filling. See also `sentence-end-without-period' 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 @@ For example, a sentence in Thai text ends with double space but 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 @@ and `sentence-end-without-space'. The default value specifies 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)}]*" diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 24347479e5..5a8d0df40d 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -500,6 +500,11 @@ An alternative value is \" . \", if you use a font with a narrow period." 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 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; ;; 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 @@ An alternative value is \" . \", if you use a font with a narrow period." (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 "\"")))) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 69851ac504..91a6c869a2 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,64 @@ +2004-10-12 Simon Josefsson <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> * url-handlers.el (url-insert-file-contents): Decode contents. diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el new file mode 100644 index 0000000000..39bb730beb --- /dev/null +++ b/lisp/url/url-auth.el @@ -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 diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el new file mode 100644 index 0000000000..1e3374639e --- /dev/null +++ b/lisp/url/url-cache.el @@ -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 diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el new file mode 100644 index 0000000000..9f7db86759 --- /dev/null +++ b/lisp/url/url-cookie.el @@ -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 diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el new file mode 100644 index 0000000000..73307412e1 --- /dev/null +++ b/lisp/url/url-dired.el @@ -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 diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 77c2e74555..0aa23acc0e 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -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 <[email protected]> ;; Keywords: comm, data, processes diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el new file mode 100644 index 0000000000..4346f3910b --- /dev/null +++ b/lisp/url/url-ftp.el @@ -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 diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el new file mode 100644 index 0000000000..608827d7ce --- /dev/null +++ b/lisp/url/url-gw.el @@ -0,0 +1,268 @@ +;;; url-gw.el --- Gateway munging for URL loading +;; Author: Bill Perry <[email protected]> +;; 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 diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 56497b0011..db961b9c27 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -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 <[email protected]> ;; Keywords: comm, data, processes, hypermedia @@ -208,7 +207,7 @@ accessible." ;; 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) diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el new file mode 100644 index 0000000000..6a2d87cfbc --- /dev/null +++ b/lisp/url/url-history.el @@ -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 diff --git a/lisp/url/url-https.el b/lisp/url/url-https.el index 11b2593ea8..9631aeb18e 100644 --- a/lisp/url/url-https.el +++ b/lisp/url/url-https.el @@ -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)) diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el new file mode 100644 index 0000000000..a4b195f253 --- /dev/null +++ b/lisp/url/url-irc.el @@ -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 diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el new file mode 100644 index 0000000000..24a3ade492 --- /dev/null +++ b/lisp/url/url-ldap.el @@ -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 diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el new file mode 100644 index 0000000000..bcb6bad417 --- /dev/null +++ b/lisp/url/url-mailto.el @@ -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://[email protected] instead of + ;; mailto:[email protected] + (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 diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el new file mode 100644 index 0000000000..75d746f3e3 --- /dev/null +++ b/lisp/url/url-methods.el @@ -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 diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el new file mode 100644 index 0000000000..ff2f128213 --- /dev/null +++ b/lisp/url/url-misc.el @@ -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 diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el new file mode 100644 index 0000000000..59364c9ccd --- /dev/null +++ b/lisp/url/url-news.el @@ -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 diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el index d068341b1c..3b834bba75 100644 --- a/lisp/url/url-nfs.el +++ b/lisp/url/url-nfs.el @@ -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 <[email protected]> +;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc. ;; Keywords: comm, data, processes diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el new file mode 100644 index 0000000000..97348ab5db --- /dev/null +++ b/lisp/url/url-parse.el @@ -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 diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el new file mode 100644 index 0000000000..cb64cfbd4f --- /dev/null +++ b/lisp/url/url-privacy.el @@ -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 diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index d4a3733eab..5d1f73e0d5 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -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 <[email protected]> +;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc. ;; Author: Bill Perry <[email protected]> ;; Keywords: comm, data, processes diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el new file mode 100644 index 0000000000..a33d8ba43e --- /dev/null +++ b/lisp/url/url-vars.el @@ -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 "[email protected]" + "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 diff --git a/lisp/url/url.el b/lisp/url/url.el new file mode 100644 index 0000000000..f7b1b71768 --- /dev/null +++ b/lisp/url/url.el @@ -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 <[email protected]> +;; 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 diff --git a/lisp/vc.el b/lisp/vc.el index 663c45fd46..a0d3d1cd4b 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -646,9 +646,6 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'." :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 @@ use; you may override this using the second optional arg MODE." (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)) diff --git a/lisp/xml.el b/lisp/xml.el index 993ef59b27..b0d5d45f98 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -598,8 +598,8 @@ This follows the rule [28] in the XML specifications." 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 @@ This follows the rule [28] in the XML specifications." (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 @@ This follows the rule [28] in the XML specifications." (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. diff --git a/lispintro/emacs-lisp-intro.texi b/lispintro/emacs-lisp-intro.texi index 2096a60928..3714e010d1 100644 --- a/lispintro/emacs-lisp-intro.texi +++ b/lispintro/emacs-lisp-intro.texi @@ -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 @@ people who are not programmers. 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 @@ Robert J. Chassell @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 @@ Debugger entered--Lisp error: @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 @@ the @dfn{else-part}, for the case when the true-or-false-test returns 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 @@ Here is the function: ((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 @@ problem recently.) @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 @@ If you want to write with Chinese `GB' characters, set this instead: @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 @@ beginning. 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 @@ each column." @end smallexample @end ifnottex +@c qqq @ignore Graphing Definitions Re-listed @@ -21137,6 +21145,7 @@ each column." (print-X-axis numbers-list horizontal-step))) @end group @end smallexample +@c qqq @end ignore @page diff --git a/lispref/ChangeLog b/lispref/ChangeLog index b568e99fb5..c33e49ca77 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,21 @@ +2004-10-09 Luc Teirlinck <[email protected]> + + * 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 <[email protected]> + + * display.texi (Progress): New node. + +2004-10-05 Kim F. Storm <[email protected]> + + * display.texi (Fringe Bitmaps): Update fringe-bitmaps-at-pos. + 2004-09-29 Kim F. Storm <[email protected]> * display.texi (Fringe Bitmaps): Use symbols rather than numbers diff --git a/lispref/display.texi b/lispref/display.texi index 00b91fe1fd..d7e1303aba 100644 --- a/lispref/display.texi +++ b/lispref/display.texi @@ -16,6 +16,7 @@ that Emacs presents to the user. * 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 @@ symbols. If it matches the first few elements in a warning type, then 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 @@ symbols have their own name space. @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. diff --git a/lispref/searching.texi b/lispref/searching.texi index 93a152fbbe..ee6cb06b1e 100644 --- a/lispref/searching.texi +++ b/lispref/searching.texi @@ -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 @@ an @code{invalid-regexp} error is signaled. 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 @@ deciphered as follows: 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,23 +1698,25 @@ whitespace or starting with a form feed (after its left margin). @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 - -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. - -For a detailed explanation of this regular expression, see @ref{Regexp -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.) + +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 +@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 @end ignore diff --git a/lispref/text.texi b/lispref/text.texi index caa3f21b7b..00aa235f51 100644 --- a/lispref/text.texi +++ b/lispref/text.texi @@ -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 @@ the text around point. @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. diff --git a/man/ChangeLog b/man/ChangeLog index fc0bd61497..8aec01712e 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,90 @@ +2004-10-12 Reiner Steib <[email protected]> + + * gnus-faq.texi ([5.9]): Improve code for reply-in-news. + +2004-10-12 Michael Albinus <[email protected]> + + 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 <[email protected]> + + * gnus.texi (Top, Marking Articles): Join two menus in one node + because a node can have only one menu. + +2004-10-09 Luc Teirlinck <[email protected]> + + * files.texi (Misc File Ops): View mode is a minor mode. + +2004-10-09 Juri Linkov <[email protected]> + + * gnus.texi (Fancy Mail Splitting): Remove backslash in the + example of nnmail-split-fancy. + +2004-10-08 Glenn Morris <[email protected]> + + * calendar.texi (iCalendar): Style changes. + +2004-10-07 Luc Teirlinck <[email protected]> + + * search.texi (Regexps): The regexp described in the example is no + longer stored in the variable `sentence-end'. + +2004-10-06 Karl Berry <[email protected]> + + * info.texi (@kbd{1}--@kbd{9}): no space around --, for + consistency with other uses of dashes. + +2004-10-06 Nick Roberts <[email protected]> + + * building.texi (Starting GUD): Note that multiple debugging + sessions requires `gdb --fullname'. + +2004-10-05 Ulf Jasper <[email protected]> + + * calendar.texi (iCalendar): New section for a new package. + +2004-10-05 Karl Berry <[email protected]> + + * info.texi: consistently use --- throughout, periods at end of + menu descriptions, and a couple typos. + +2004-10-05 Luc Teirlinck <[email protected]> + + * 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 <[email protected]> + + * calendar.texi (From Other Calendar): Add calendar-goto-iso-week. + 2004-09-28 Kim F. Storm <[email protected]> * display.texi (Display Custom) <indicate-buffer-boundaries>: @@ -893,7 +980,7 @@ * misc.texi: Section "Saving Emacs Sessions" rewritten. -2003-09-29 Jan D. <[email protected]> +2003-09-29 Jan Dj,Ad(Brv. <[email protected]> * xresources.texi (GTK names in Emacs): Correct typo. diff --git a/man/building.texi b/man/building.texi index 972f88abbd..2ec96b0f6b 100644 --- a/man/building.texi +++ b/man/building.texi @@ -336,11 +336,13 @@ to a particular debugger program. @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 diff --git a/man/calc.texi b/man/calc.texi index 8c3a3c5f92..a77ba4eb26 100644 --- a/man/calc.texi +++ b/man/calc.texi @@ -10026,19 +10026,17 @@ additional notes from the summary that apply to this command. @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 @@ back on. 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)}). diff --git a/man/calendar.texi b/man/calendar.texi index 9e3d3cf9f4..45b3ed318b 100644 --- a/man/calendar.texi +++ b/man/calendar.texi @@ -37,6 +37,7 @@ information about the calendar and diary. * 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 @@ other than Mayan; for the Mayan calendar, see the following section. @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 @@ other than Mayan; for the Mayan calendar, see the following section. @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 @@ clock. The command @kbd{M-x appt-add} adds entries to the appointment 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 diff --git a/man/files.texi b/man/files.texi index b5ebf7cf82..4e36c2ab2f 100644 --- a/man/files.texi +++ b/man/files.texi @@ -2858,7 +2858,7 @@ or @key{DEL} to scroll backward. Various other commands are provided 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 diff --git a/man/gnus-faq.texi b/man/gnus-faq.texi index 6f0fddc556..5d243f8a02 100644 --- a/man/gnus-faq.texi +++ b/man/gnus-faq.texi @@ -1776,11 +1776,14 @@ Answer: @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 diff --git a/man/gnus.texi b/man/gnus.texi index c94845c7a8..a62e9bcf14 100644 --- a/man/gnus.texi +++ b/man/gnus.texi @@ -535,12 +535,9 @@ Marking Articles * 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 @@ neologism ohoy!) of the article. Alphabetic marks generally mean In addition, you also have marks that do not affect readedness. -@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: +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. +* Unread Articles:: Marks for unread articles. +* Read Articles:: Marks for read articles. +* Other Marks:: Marks that do not affect readedness. +* 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 @@ Let's look at an example value of this variable first: ;; @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.} diff --git a/man/info.texi b/man/info.texi index 2e42a0b9ed..014e916508 100644 --- a/man/info.texi +++ b/man/info.texi @@ -130,15 +130,15 @@ the screen. @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 @@ This is line 59 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 @@ well. In Emacs, the header line is duplicated in a special typeface, 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 @@ scroll beyond the beginning or the end of the current node. @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 @@ the list, make it go away by typing a @key{SPC} repeatedly. (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 @@ the node @samp{Top} in the Info file @file{dir}. Likewise, 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 @@ you typed @emph{as a substring}. For each match, Info shows in the 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 @@ reads from the terminal. 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 diff --git a/man/msdog.texi b/man/msdog.texi index 157eba2884..dec258ec67 100644 --- a/man/msdog.texi +++ b/man/msdog.texi @@ -840,7 +840,7 @@ effect of bringing up the Windows menu, it alters the meaning of 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 diff --git a/man/sc.texi b/man/sc.texi index 5e911e2df7..11ae3d139c 100644 --- a/man/sc.texi +++ b/man/sc.texi @@ -1565,7 +1565,7 @@ incorrectly. @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 diff --git a/man/search.texi b/man/search.texi index 58265341c2..0f5e871630 100644 --- a/man/search.texi +++ b/man/search.texi @@ -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 @@ repeat the search will then search for a string including that 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 @@ matches any character that does @emph{not} belong to category 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]*" diff --git a/man/text.texi b/man/text.texi index dbf990a2b5..01405ae525 100644 --- a/man/text.texi +++ b/man/text.texi @@ -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 @@ Then the formatting appears on the screen in Emacs while you edit. @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 @@ followed by the end of a line or two spaces, with any number of 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 either starts or separates paragraphs. The value of 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 @@ pages. @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 @@ period. Set the variable @code{sentence-end-without-period} to 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 @@ a new paragraph. @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 @@ filling determines what indentation to use when filling a paragraph. @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 @@ invisible lines follow). 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 @@ except the top @var{n} levels of heading lines. @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 @@ buffers. 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 @@ particular chapter or section of your document. 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 @@ current buffer's file. Generally, you need to do @kbd{C-c C-f} @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 @@ required. This is set up for Czech---customize the group @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 @@ into the file. When you visit the file again, Emacs will automatically 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 @@ commands directly: @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 @@ Set the region, or the next inserted character, to the face @var{face} 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 @@ format. 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. - - 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}. +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. + + 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 @@ text. There is a menu for specifying the foreground color and a menu 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 @@ Remove 4 columns of indentation from the right margin. 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 @@ affects the Emacs fill commands. 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 @@ the width of spaces in a line to achieve elegant justification. @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 @@ Make the region left-filled (@code{set-justification-left}). @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 @@ region. 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 @@ When you visit a file that was created with some other editor, Emacs may 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 @@ to translate from; however, normally you can type just @key{RET}, which 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 diff --git a/man/tramp.texi b/man/tramp.texi index ebba03d626..e8577af498 100644 --- a/man/tramp.texi +++ b/man/tramp.texi @@ -1952,9 +1952,12 @@ There is some informations on @value{tramp} on NT at the following URL; 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? diff --git a/man/trampver.texi b/man/trampver.texi index a5cc874b3f..743b49388f 100644 --- a/man/trampver.texi +++ b/man/trampver.texi @@ -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 diff --git a/msdos/ChangeLog b/msdos/ChangeLog index 1722153dc5..e906a8f495 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,8 @@ +2004-10-06 Eli Zaretskii <[email protected]> + + * 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 <[email protected]> * sedleim.inp: Remove the lines which say "<TAB>@true", to avoid diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index dc316819a5..8edc1616f2 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -20,9 +20,9 @@ s/^#.*// 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]*@/./ diff --git a/nt/ChangeLog b/nt/ChangeLog index 77c8305b0e..f91c59a85c 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -77,7 +77,7 @@ * multi-install-info.bat: New file. -2003-06-27 Jan D. <[email protected]> +2003-06-27 Jan Dj,Ad(Brv <[email protected]> * config.nt (my_strftime): New define. diff --git a/src/.gdbinit b/src/.gdbinit index 943481d419..adf2ccbf5f 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -60,6 +60,16 @@ Print the emacs s-expression which is $. 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 @@ document xreload 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 diff --git a/src/ChangeLog b/src/ChangeLog index e58ddb7428..9fedb52f42 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,157 @@ +2004-10-14 Kim F. Storm <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * doc.c (Fsubstitute_command_keys): Ignore remappings unless there + are no ordinary bindings. + +2004-10-11 Jan Dj,Ad(Brv <[email protected]> + + * xfns.c (syms_of_xfns): Defsubr x-file-dialog for GTK also. + +2004-10-10 YAMAMOTO Mitsuharu <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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. <[email protected]> + + * config.in: Regenerate. + + * Makefile.in (RUN_TEMACS): Check HAVE_RANDOM_HEAPSTART instead of + HAVE_EXECSHIELD. + +2004-10-05 Jan Dj,Ad(Brv <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> * 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 <[email protected]> - * config.in: Rebuild + * config.in: Rebuild. 2004-09-24 Jan Dj,Ad(Brv <[email protected]> @@ -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 <[email protected]> +2004-09-14 Stefan Monnier <[email protected]> * 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 <[email protected]> @@ -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 <[email protected]> @@ -210,8 +363,8 @@ 2004-09-07 Luc Teirlinck <[email protected]> * 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 <[email protected]> * 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 <[email protected]> +2004-09-07 Stefan Monnier <[email protected]> * 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 <[email protected]> +2004-06-30 Stefan Monnier <[email protected]> * xterm.c (x_detect_focus_change): Remove unused var `nr_events'. (x_calc_absolute_position): Remove unused var `child'. diff --git a/src/Makefile.in b/src/Makefile.in index 950564f8fa..08504dcf72 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -887,7 +887,7 @@ LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) \ #define OBJECTS_MACHINE #endif -#ifdef HAVE_EXECSHIELD +#ifdef HAVE_RANDOM_HEAPSTART #undef i386 RUN_TEMACS = @SETARCH@ i386 ./temacs #else diff --git a/src/callproc.c b/src/callproc.c index 7632d49194..d9f9a34257 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -216,7 +216,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) 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 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) 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 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) 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 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) 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 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) 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; diff --git a/src/config.in b/src/config.in index d87d235fe5..49095ca4e5 100644 --- a/src/config.in +++ b/src/config.in @@ -136,9 +136,6 @@ Boston, MA 02111-1307, USA. */ /* 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 @@ Boston, MA 02111-1307, USA. */ /* 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 @@ Boston, MA 02111-1307, USA. */ /* 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 @@ Boston, MA 02111-1307, USA. */ /* 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. */ diff --git a/src/dispextern.h b/src/dispextern.h index f28b39f0c6..a87a38ce46 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1961,8 +1961,8 @@ struct it /* 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 @@ extern int x_intersect_rectangles P_ ((XRectangle *, XRectangle *, 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)); @@ -776,9 +776,13 @@ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ int 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; diff --git a/src/fringe.c b/src/fringe.c index 0bf830cbd8..ef4c7631e0 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -722,19 +722,35 @@ draw_row_fringe_bitmaps (w, row) } /* 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. -void -draw_window_fringes (w) + 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. + + 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 @@ draw_window_fringes (w) continue; draw_row_fringe_bitmaps (w, row); row->redraw_fringe_bitmaps_p = 0; + updated++; } + + return updated; } @@ -950,11 +969,7 @@ update_window_fringes (w, force_p) 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 @@ DEFUN ("fringe-bitmaps-at-pos", Ffringe_bitmaps_at_pos, Sfringe_bitmaps_at_pos, 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 @@ Return nil if POS is not visible in WINDOW. */) 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; } diff --git a/src/keyboard.c b/src/keyboard.c index 378350710b..3360b11850 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -676,6 +676,9 @@ static Lisp_Object apply_modifiers P_ ((int, Lisp_Object)); static void clear_event P_ ((struct input_event *)); static void any_kboard_state P_ ((void)); static SIGTYPE interrupt_signal P_ ((int signalnum)); +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 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) 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 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) 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 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) 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 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) 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 @@ swallow_events (do_display) /* 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 @@ timer_start_idle () /* 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 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, 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 diff --git a/src/keyboard.h b/src/keyboard.h index 4e14257359..08cb934d3f 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -326,8 +326,6 @@ extern void swallow_events P_ ((int)); 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 *, diff --git a/src/keymap.c b/src/keymap.c index 5177ccfbf8..1711e7fbc3 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -268,7 +268,8 @@ get_keymap (object, error, autoload) /* 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; @@ -24,6 +24,7 @@ Boston, MA 02111-1307, USA. */ #include <stdio.h> #include <errno.h> +#include <time.h> #include <utime.h> #include <dirent.h> #include <sys/types.h> @@ -46,6 +47,8 @@ Boston, MA 02111-1307, USA. */ #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 @@ Boston, MA 02111-1307, USA. */ #include "process.h" #include "sysselect.h" #include "systime.h" +#include "blockinput.h" Lisp_Object QCLIPBOARD; @@ -2547,7 +2551,9 @@ component. */) CHECK_STRING (script); + BLOCK_INPUT; status = do_applescript (SDATA (script), &result); + UNBLOCK_INPUT; if (status) { if (!result) @@ -2617,26 +2623,23 @@ DEFUN ("mac-paste-function", Fmac_paste_function, Smac_paste_function, 0, 0, 0, () { #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 @@ DEFUN ("mac-cut-function", Fmac_cut_function, Smac_cut_function, 1, 2, 0, #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 @@ and t is the same as `SECONDARY'. */) 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 @@ and t is the same as `SECONDARY'. */) 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 diff --git a/src/macfns.c b/src/macfns.c index 3b09b344a5..88f975a65c 100644 --- a/src/macfns.c +++ b/src/macfns.c @@ -312,6 +312,9 @@ static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *, 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 @@ x_real_positions (f, xptr, yptr) FRAME_PTR f; int *xptr, *yptr; { - Point pt; - GrafPtr oldport; + Rect inner, outer; - GetPort (&oldport); - SetPortWindowPort (FRAME_MAC_WINDOW (f)); + mac_get_window_bounds (f, &inner, &outer); -#if TARGET_API_MAC_CARBON - { - Rect r; + f->x_pixels_diff = inner.left - outer.left; + f->y_pixels_diff = inner.top - outer.top; - 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; + *xptr = outer.left; + *yptr = outer.top; } @@ -4262,6 +4247,7 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) 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 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) AEDisposeDesc(&defLocAed); } - BLOCK_INPUT; status = NavDialogRun(dialogRef); - UNBLOCK_INPUT; } if (saveName) CFRelease(saveName); @@ -4347,9 +4331,7 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) { 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 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) dir, mustmatch, dir, Qfile_name_history, default_filename, Qnil); } + UNBLOCK_INPUT; } UNGCPRO; diff --git a/src/macgui.h b/src/macgui.h index 58081df52b..e5ea665ac1 100644 --- a/src/macgui.h +++ b/src/macgui.h @@ -42,6 +42,8 @@ typedef unsigned long Time; #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 diff --git a/src/macmenu.c b/src/macmenu.c index 740bda261d..007fab15ea 100644 --- a/src/macmenu.c +++ b/src/macmenu.c @@ -1322,7 +1322,7 @@ update_submenu_strings (first_wv) 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 @@ update_submenu_strings (first_wv) } } - if (wv->lkey && ! NILP (wv->lkey)) + if (STRINGP (wv->lkey)) wv->key = SDATA (wv->lkey); if (wv->contents) diff --git a/src/macterm.c b/src/macterm.c index e1b8d49ddf..2d09a2e93e 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -50,6 +50,7 @@ Boston, MA 02111-1307, USA. */ #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 @@ x_update_window_end (w, cursor_on_p, mouse_face_overwritten_p) 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 @@ remember_mouse_glyph (f1, gx, gy) 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 (); + WindowPtr wp = FrontWindow (); - if (tip_window && front_window == tip_window) - return GetNextWindow (front_window); - else - return front_window; + 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 @@ XTmouse_position (fp, insist, bar_window, part, x, y, time) { 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 @@ x_scroll_bar_report_motion (fp, bar_window, part, x, y, time) 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 @@ xim_close_dpy (dpyinfo) */ +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 @@ void x_calc_absolute_position (f) struct frame *f; { - Point pt; + int width_diff = 0, height_diff = 0; int flags = f->size_hint_flags; + Rect inner, outer; - pt.h = pt.v = 0; + /* We have nothing to do if the current position + is already for the top-left corner. */ + if (! ((flags & XNegative) || (flags & YNegative))) + return; - /* Find the position of the outside upper-left corner of + /* 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); + mac_get_window_bounds (f, &inner, &outer); - 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); - } + 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 @@ x_set_offset (f, xoff, yoff, change_gravity) register int xoff, yoff; int change_gravity; { - int modified_top, modified_left; - if (change_gravity > 0) { f->top_pos = yoff; @@ -5137,11 +5147,55 @@ x_set_offset (f, xoff, yoff, change_gravity) 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 @@ x_raise_frame (f) 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 @@ x_lower_frame (f) 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 @@ x_find_ccl_program (fontp) /* 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 @@ static int handling_window_update = 0; 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 @@ is_emacs_window (WindowPtr win) 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 @@ do_app_resume () 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 @@ do_app_suspend () app_is_suspended = true; app_sleep_time = WNE_SLEEP_AT_SUSPEND; +#endif } @@ -7308,10 +7378,10 @@ do_mouse_moved (mouse_pos, f) 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 @@ do_menu_choice (SInt32 menu_choice) 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 @@ do_zoom_window (WindowPtr w, int zoom_in_or_out) 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); - GetPort (&save_port); - - SetPortWindowPort (w); - - /* Clear window to avoid flicker. */ #if TARGET_API_MAC_CARBON { - Rect r; - BitMap bm; + Point standard_size; - GetWindowPortBounds (w, &r); - EraseRect (&r); + standard_size.h = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, DEFAULT_NUM_COLS); + standard_size.v = FRAME_MAC_DISPLAY_INFO (f)->height; - if (zoom_in_or_out == inZoomOut) + if (IsWindowInStandardState (w, &standard_size, &zoom_rect)) + zoom_in_or_out = inZoomIn; + else { - /* 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); + /* 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. */ EraseRect (&(w->portRect)); if (zoom_in_or_out == inZoomOut) { @@ -7479,12 +7551,19 @@ do_zoom_window (WindowPtr w, int zoom_in_or_out) 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; } -#endif /* not TARGET_API_MAC_CARBON */ - ZoomWindow (w, zoom_in_or_out, w == mac_front_window ()); + ZoomWindow (w, zoom_in_or_out, w == front_emacs_window ()); + + SetPort (save_port); +#endif /* not TARGET_API_MAC_CARBON */ /* retrieve window size and update application values */ #if TARGET_API_MAC_CARBON @@ -7495,8 +7574,7 @@ do_zoom_window (WindowPtr w, int zoom_in_or_out) 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 @@ XTread_socket (sd, expected, hold_quit) 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 @@ XTread_socket (sd, expected, hold_quit) switch (GetEventClass (eventRef)) { case kEventClassWindow: - if (GetEventKind (eventRef) == kEventWindowBoundsChanged) + if (GetEventKind (eventRef) == kEventWindowBoundsChanged) { WindowPtr window_ptr; GetEventParameter(eventRef, kEventParamDirectObject, @@ -8081,13 +8155,7 @@ XTread_socket (sd, expected, hold_quit) 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 @@ XTread_socket (sd, expected, hold_quit) { SInt32 delta; Point point; - WindowPtr window_ptr = mac_front_window (); + WindowPtr window_ptr = front_emacs_window (); if (!IsValidWindowPtr (window_ptr)) { @@ -8158,33 +8226,28 @@ XTread_socket (sd, expected, hold_quit) } 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 @@ XTread_socket (sd, expected, hold_quit) } 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 @@ XTread_socket (sd, expected, hold_quit) 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 @@ XTread_socket (sd, expected, hold_quit) /* 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 @@ XTread_socket (sd, expected, hold_quit) if (!is_emacs_window (window_ptr)) break; - + f = mac_window_to_frame (window_ptr); if ((er.modifiers & activeFlag) != 0) @@ -8486,7 +8535,7 @@ XTread_socket (sd, expected, hold_quit) #endif #if TARGET_API_MAC_CARBON - if (!IsValidWindowPtr (mac_front_window ())) + if (!IsValidWindowPtr (front_emacs_window ())) { SysBeep (1); break; @@ -8590,7 +8639,7 @@ XTread_socket (sd, expected, hold_quit) 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 @@ XTread_socket (sd, expected, hold_quit) 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 @@ make_mac_frame (FRAME_PTR fp) mwp = fp->output_data.mac; + BLOCK_INPUT; if (making_terminal_window) { if (!(mwp->mWP = GetNewCWindow (TERM_WINDOW_RESOURCE, NULL, @@ -8769,9 +8819,8 @@ make_mac_frame (FRAME_PTR fp) /* 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 @@ mac_check_for_quit_char () 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 @@ mac_initialize () signal (SIGPIPE, x_connection_signal); #endif + BLOCK_INPUT; mac_initialize_display_info (); #if TARGET_API_MAC_CARBON @@ -9212,6 +9262,7 @@ mac_initialize () if (!inhibit_window_system) MakeMeTheFrontProcess (); #endif + UNBLOCK_INPUT; } diff --git a/src/textprop.c b/src/textprop.c index c8ec008dcb..317f8fa6aa 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -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 @@ If a character in a buffer has PROPERTY, new text inserted adjacent to 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); diff --git a/src/unexmacosx.c b/src/unexmacosx.c index b41c586d2e..1f2b4c9662 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -99,7 +99,12 @@ Boston, MA 02111-1307, USA. */ #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 diff --git a/src/w32term.c b/src/w32term.c index 1d6b4ec753..574457f727 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -567,9 +567,8 @@ x_update_window_end (w, cursor_on_p, mouse_face_overwritten_p) 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; } diff --git a/src/window.c b/src/window.c index e7246b7c65..55d7d7d279 100644 --- a/src/window.c +++ b/src/window.c @@ -607,9 +607,6 @@ coordinates_in_window (w, x, y) 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 @@ coordinates_in_window (w, x, y) 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 @@ coordinates_in_window (w, x, y) 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 @@ display marginal areas and the text area. */) 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 @@ If TYPE is t, use the frame's scroll-bar type. */) struct window *w = decode_window (window); if (!NILP (width)) - CHECK_NUMBER (width); + CHECK_NATNUM (width); if (XINT (width) == 0) vertical_type = Qnil; diff --git a/src/xdisp.c b/src/xdisp.c index 04c313ef18..008195eba7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -216,6 +216,8 @@ extern int pending_menu_activation; 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 @@ redisplay_preserve_echo_area (from_where) } else redisplay_internal (1); + + if (rif != NULL && rif->flush_display_optional) + rif->flush_display_optional (NULL); } @@ -12320,7 +12325,8 @@ redisplay_window (window, just_this_one_p) { 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 @@ calc_line_height_property (it, prop, font, boff, total) 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 @@ define_frame_cursor1 (f, cursor, pointer) 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 @@ x_draw_vertical_border (w) 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)) { diff --git a/src/xfns.c b/src/xfns.c index b0864cbdff..e41540a994 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5551,7 +5551,7 @@ Chinese, Japanese, and Korean. */); 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 } diff --git a/src/xterm.c b/src/xterm.c index cf7ec09cf4..ef469a2b82 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -572,9 +572,8 @@ x_update_window_end (w, cursor_on_p, mouse_face_overwritten_p) 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 @@ x_find_modifier_meanings (dpyinfo) 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 @@ x_find_modifier_meanings (dpyinfo) { 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 @@ XTset_vertical_scroll_bar (w, portion, whole, position) /* 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 @@ XTset_vertical_scroll_bar (w, portion, whole, position) 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 @@ static struct redisplay_interface x_redisplay_interface = x_update_window_end, x_cursor_to, x_flush, -#ifndef XFlush +#ifdef XFlush x_flush, #else 0, /* flush_display_optional */ diff --git a/src/xterm.h b/src/xterm.h index d87135e8bf..76cba8a251 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -21,8 +21,8 @@ Boston, MA 02111-1307, USA. */ #include <X11/Xlib.h> #include <X11/cursorfont.h> -#include <X11/Xutil.h> #include <X11/keysym.h> +#include <X11/Xutil.h> #include <X11/Xatom.h> #include <X11/Xresource.h> |