Mercurial > emacs
changeset 111574:a92967e45167
merge trunk
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Wed, 17 Nov 2010 13:09:08 +0900 |
| parents | e89dd9c3633b (current diff) b4dbe6c4111e (diff) |
| children | c1042b16fa46 |
| files | |
| diffstat | 292 files changed, 15668 insertions(+), 7367 deletions(-) [+] |
line wrap: on
line diff
--- a/.dir-locals.el Mon Nov 08 14:19:54 2010 +0900 +++ b/.dir-locals.el Wed Nov 17 13:09:08 2010 +0900 @@ -2,6 +2,8 @@ (sentence-end-double-space . t) (fill-column . 70))) (c-mode . ((c-file-style . "GNU"))) + (log-edit-mode . ((log-edit-rewrite-fixes + " (bug#\\([0-9]+\\))" . "debbugs:\\1"))) (change-log-mode . ((add-log-time-zone-rule . t) (fill-column . 74) (bug-reference-url-format . "http://debbugs.gnu.org/%s")
--- a/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,15 @@ +2010-11-15 Dan Nicolaescu <dann@ics.uci.edu> + + * configure.in: Do not check for unconditionally included headers. + +2010-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * .dir-locals.el (log-edit-mode): Set log-edit-rewrite-fixes. + +2010-11-09 Michael Albinus <michael.albinus@gmx.de> + + * configure.in: Don't write a warning for D-Bus anymore. + 2010-11-06 Andreas Schwab <schwab@linux-m68k.org> * configure.in: Fix indentation.
--- a/configure Mon Nov 08 14:19:54 2010 +0900 +++ b/configure Wed Nov 17 13:09:08 2010 +0900 @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.68 for emacs 24.0.50. +# Generated by GNU Autoconf 2.67 for emacs 24.0.50. # # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -89,7 +89,6 @@ IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. -as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -215,18 +214,11 @@ # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. - # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV export CONFIG_SHELL - case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; - esac - exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test x$as_have_required = xno; then : @@ -1262,7 +1254,7 @@ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac @@ -1633,7 +1625,7 @@ if $ac_init_version; then cat <<\_ACEOF emacs configure 24.0.50 -generated by GNU Autoconf 2.68 +generated by GNU Autoconf 2.67 Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation @@ -1679,7 +1671,7 @@ ac_retval=1 fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} as_fn_set_status $ac_retval } # ac_fn_c_try_compile @@ -1725,7 +1717,7 @@ # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} as_fn_set_status $ac_retval } # ac_fn_c_try_link @@ -1762,7 +1754,7 @@ ac_retval=1 fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} as_fn_set_status $ac_retval } # ac_fn_c_try_cpp @@ -1775,10 +1767,10 @@ ac_fn_c_check_header_mongrel () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if eval \${$3+:} false; then : + if eval "test \"\${$3+set}\"" = set; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : +if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 fi eval ac_res=\$$3 @@ -1841,7 +1833,7 @@ esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : +if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else eval "$3=\$ac_header_compiler" @@ -1850,7 +1842,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_header_mongrel @@ -1891,7 +1883,7 @@ ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} as_fn_set_status $ac_retval } # ac_fn_c_try_run @@ -1905,7 +1897,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : +if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -1923,7 +1915,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_header_compile @@ -1938,7 +1930,7 @@ as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 $as_echo_n "checking whether $as_decl_name is declared... " >&6; } -if eval \${$3+:} false; then : +if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -1969,7 +1961,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_decl @@ -1981,7 +1973,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : +if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -1998,7 +1990,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_header_preproc @@ -2011,7 +2003,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 $as_echo_n "checking for $2.$3... " >&6; } -if eval \${$4+:} false; then : +if eval "test \"\${$4+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2055,7 +2047,7 @@ eval ac_res=\$$4 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_member @@ -2067,7 +2059,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : +if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2122,7 +2114,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_func @@ -2135,7 +2127,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : +if eval "test \"\${$3+set}\"" = set; then : $as_echo_n "(cached) " >&6 else eval "$3=no" @@ -2176,7 +2168,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_type cat >config.log <<_ACEOF @@ -2184,7 +2176,7 @@ running configure, to aid debugging if configure makes a mistake. It was created by emacs $as_me 24.0.50, which was -generated by GNU Autoconf 2.68. Invocation command line was +generated by GNU Autoconf 2.67. Invocation command line was $ $0 $@ @@ -2442,7 +2434,7 @@ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi done @@ -3000,7 +2992,7 @@ stringfreelist) ac_gc_check_string_free_list=1 ;; xmallocoverrun) ac_xmalloc_overrun=1 ;; conslist) ac_gc_check_cons_list=1 ;; - *) as_fn_error $? "unknown check category $check" "$LINENO" 5 ;; + *) as_fn_error $? "unknown check category $check" "$LINENO" 5 ;; esac done IFS="$ac_save_IFS" @@ -3148,7 +3140,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 $as_echo_n "checking build system type... " >&6; } -if ${ac_cv_build+:} false; then : +if test "${ac_cv_build+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_build_alias=$build_alias @@ -3164,7 +3156,7 @@ $as_echo "$ac_cv_build" >&6; } case $ac_cv_build in *-*-*) ;; -*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5 ;; esac build=$ac_cv_build ac_save_IFS=$IFS; IFS='-' @@ -3182,7 +3174,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 $as_echo_n "checking host system type... " >&6; } -if ${ac_cv_host+:} false; then : +if test "${ac_cv_host+set}" = set; then : $as_echo_n "(cached) " >&6 else if test "x$host_alias" = x; then @@ -3197,7 +3189,7 @@ $as_echo "$ac_cv_host" >&6; } case $ac_cv_host in *-*-*) ;; -*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5 ;; esac host=$ac_cv_host ac_save_IFS=$IFS; IFS='-' @@ -3515,7 +3507,7 @@ set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : +if test "${ac_cv_prog_CC+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3555,7 +3547,7 @@ set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_CC+:} false; then : +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -3608,7 +3600,7 @@ set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : +if test "${ac_cv_prog_CC+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3648,7 +3640,7 @@ set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : +if test "${ac_cv_prog_CC+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3707,7 +3699,7 @@ set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : +if test "${ac_cv_prog_CC+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3751,7 +3743,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_CC+:} false; then : +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -3806,7 +3798,7 @@ test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -3921,7 +3913,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } @@ -3964,7 +3956,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 @@ -4023,7 +4015,7 @@ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi fi fi @@ -4034,7 +4026,7 @@ ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 $as_echo_n "checking for suffix of object files... " >&6; } -if ${ac_cv_objext+:} false; then : +if test "${ac_cv_objext+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4075,7 +4067,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi @@ -4085,7 +4077,7 @@ ac_objext=$OBJEXT { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if ${ac_cv_c_compiler_gnu+:} false; then : +if test "${ac_cv_c_compiler_gnu+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4122,7 +4114,7 @@ ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } -if ${ac_cv_prog_cc_g+:} false; then : +if test "${ac_cv_prog_cc_g+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag @@ -4200,7 +4192,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if ${ac_cv_prog_cc_c89+:} false; then : +if test "${ac_cv_prog_cc_c89+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no @@ -4308,7 +4300,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using a Sun C compiler" >&5 $as_echo_n "checking whether we are using a Sun C compiler... " >&6; } -if ${emacs_cv_sunpro_c+:} false; then : +if test "${emacs_cv_sunpro_c+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4377,7 +4369,7 @@ CPP= fi if test -z "$CPP"; then - if ${ac_cv_prog_CPP+:} false; then : + if test "${ac_cv_prog_CPP+set}" = set; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -4493,7 +4485,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi ac_ext=c @@ -4505,7 +4497,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 $as_echo_n "checking for grep that handles long lines and -e... " >&6; } -if ${ac_cv_path_GREP+:} false; then : +if test "${ac_cv_path_GREP+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -z "$GREP"; then @@ -4568,7 +4560,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 $as_echo_n "checking for egrep... " >&6; } -if ${ac_cv_path_EGREP+:} false; then : +if test "${ac_cv_path_EGREP+set}" = set; then : $as_echo_n "(cached) " >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 @@ -4635,7 +4627,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 $as_echo_n "checking for ANSI C header files... " >&6; } -if ${ac_cv_header_stdc+:} false; then : +if test "${ac_cv_header_stdc+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4764,7 +4756,7 @@ ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" -if test "x$ac_cv_header_minix_config_h" = xyes; then : +if test "x$ac_cv_header_minix_config_h" = x""yes; then : MINIX=yes else MINIX= @@ -4786,7 +4778,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 $as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } -if ${ac_cv_safe_to_define___extensions__+:} false; then : +if test "${ac_cv_safe_to_define___extensions__+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4966,7 +4958,7 @@ CPP= fi if test -z "$CPP"; then - if ${ac_cv_prog_CPP+:} false; then : + if test "${ac_cv_prog_CPP+set}" = set; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -5082,7 +5074,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi ac_ext=c @@ -5108,7 +5100,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 $as_echo_n "checking for a BSD-compatible install... " >&6; } if test -z "$INSTALL"; then -if ${ac_cv_path_install+:} false; then : +if test "${ac_cv_path_install+set}" = set; then : $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -5190,7 +5182,7 @@ set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_RANLIB+:} false; then : +if test "${ac_cv_prog_RANLIB+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then @@ -5230,7 +5222,7 @@ set dummy ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : +if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then @@ -5285,7 +5277,7 @@ ## is running in i386 mode, we can help them out. if test "$machine" = "amdx86-64"; then ac_fn_c_check_decl "$LINENO" "i386" "ac_cv_have_decl_i386" "$ac_includes_default" -if test "x$ac_cv_have_decl_i386" = xyes; then : +if test "x$ac_cv_have_decl_i386" = x""yes; then : fi @@ -5300,7 +5292,7 @@ set dummy install-info; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_INSTALL_INFO+:} false; then : +if test "${ac_cv_path_INSTALL_INFO+set}" = set; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -5340,7 +5332,7 @@ set dummy install-info; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_INSTALL_INFO+:} false; then : +if test "${ac_cv_path_INSTALL_INFO+set}" = set; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -5380,7 +5372,7 @@ set dummy install-info; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_INSTALL_INFO+:} false; then : +if test "${ac_cv_path_INSTALL_INFO+set}" = set; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -5421,7 +5413,7 @@ set dummy gzip; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_GZIP_PROG+:} false; then : +if test "${ac_cv_path_GZIP_PROG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $GZIP_PROG in @@ -5464,7 +5456,7 @@ set dummy makeinfo; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_MAKEINFO+:} false; then : +if test "${ac_cv_path_MAKEINFO+set}" = set; then : $as_echo_n "(cached) " >&6 else case $MAKEINFO in @@ -5665,7 +5657,7 @@ C_SWITCH_MACHINE= if test "$machine" = "alpha"; then ac_fn_c_check_decl "$LINENO" "__ELF__" "ac_cv_have_decl___ELF__" "$ac_includes_default" -if test "x$ac_cv_have_decl___ELF__" = xyes; then : +if test "x$ac_cv_have_decl___ELF__" = x""yes; then : fi @@ -5735,7 +5727,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5 $as_echo_n "checking for special C compiler options needed for large files... " >&6; } -if ${ac_cv_sys_largefile_CC+:} false; then : +if test "${ac_cv_sys_largefile_CC+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_cv_sys_largefile_CC=no @@ -5786,7 +5778,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5 $as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; } -if ${ac_cv_sys_file_offset_bits+:} false; then : +if test "${ac_cv_sys_file_offset_bits+set}" = set; then : $as_echo_n "(cached) " >&6 else while :; do @@ -5855,7 +5847,7 @@ if test $ac_cv_sys_file_offset_bits = unknown; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5 $as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; } -if ${ac_cv_sys_large_files+:} false; then : +if test "${ac_cv_sys_large_files+set}" = set; then : $as_echo_n "(cached) " >&6 else while :; do @@ -6023,7 +6015,7 @@ # Emulation library used on NetBSD. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _oss_ioctl in -lossaudio" >&5 $as_echo_n "checking for _oss_ioctl in -lossaudio... " >&6; } -if ${ac_cv_lib_ossaudio__oss_ioctl+:} false; then : +if test "${ac_cv_lib_ossaudio__oss_ioctl+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -6057,7 +6049,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ossaudio__oss_ioctl" >&5 $as_echo "$ac_cv_lib_ossaudio__oss_ioctl" >&6; } -if test "x$ac_cv_lib_ossaudio__oss_ioctl" = xyes; then : +if test "x$ac_cv_lib_ossaudio__oss_ioctl" = x""yes; then : LIBSOUND=-lossaudio else LIBSOUND= @@ -6074,7 +6066,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -6229,10 +6221,10 @@ fi -for ac_header in sys/select.h sys/timeb.h sys/time.h unistd.h utime.h \ - linux/version.h sys/systeminfo.h termios.h limits.h string.h stdlib.h \ - stdio_ext.h fcntl.h strings.h coff.h pty.h sys/mman.h \ - sys/param.h sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \ +for ac_header in sys/select.h sys/time.h unistd.h utime.h \ + linux/version.h sys/systeminfo.h limits.h \ + stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \ + sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \ sys/utsname.h pwd.h utmp.h dirent.h util.h do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` @@ -6278,7 +6270,7 @@ for ac_header in term.h do : ac_fn_c_check_header_preproc "$LINENO" "term.h" "ac_cv_header_term_h" -if test "x$ac_cv_header_term_h" = xyes; then : +if test "x$ac_cv_header_term_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_TERM_H 1 _ACEOF @@ -6289,7 +6281,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 $as_echo_n "checking for ANSI C header files... " >&6; } -if ${ac_cv_header_stdc+:} false; then : +if test "${ac_cv_header_stdc+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6401,7 +6393,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5 $as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } -if ${ac_cv_header_time+:} false; then : +if test "${ac_cv_header_time+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6435,7 +6427,7 @@ fi ac_fn_c_check_decl "$LINENO" "sys_siglist" "ac_cv_have_decl_sys_siglist" "$ac_includes_default" -if test "x$ac_cv_have_decl_sys_siglist" = xyes; then : +if test "x$ac_cv_have_decl_sys_siglist" = x""yes; then : ac_have_decl=1 else ac_have_decl=0 @@ -6448,7 +6440,7 @@ if test $ac_cv_have_decl_sys_siglist != yes; then # For Tru64, at least: ac_fn_c_check_decl "$LINENO" "__sys_siglist" "ac_cv_have_decl___sys_siglist" "$ac_includes_default" -if test "x$ac_cv_have_decl___sys_siglist" = xyes; then : +if test "x$ac_cv_have_decl___sys_siglist" = x""yes; then : ac_have_decl=1 else ac_have_decl=0 @@ -6466,7 +6458,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sys/wait.h that is POSIX.1 compatible" >&5 $as_echo_n "checking for sys/wait.h that is POSIX.1 compatible... " >&6; } -if ${ac_cv_header_sys_wait_h+:} false; then : +if test "${ac_cv_header_sys_wait_h+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6508,7 +6500,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5 $as_echo_n "checking for struct utimbuf... " >&6; } -if ${emacs_cv_struct_utimbuf+:} false; then : +if test "${emacs_cv_struct_utimbuf+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6551,7 +6543,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking return type of signal handlers" >&5 $as_echo_n "checking return type of signal handlers... " >&6; } -if ${ac_cv_type_signal+:} false; then : +if test "${ac_cv_type_signal+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6585,7 +6577,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for speed_t" >&5 $as_echo_n "checking for speed_t... " >&6; } -if ${emacs_cv_speed_t+:} false; then : +if test "${emacs_cv_speed_t+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6616,7 +6608,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5 $as_echo_n "checking for struct timeval... " >&6; } -if ${emacs_cv_struct_timeval+:} false; then : +if test "${emacs_cv_struct_timeval+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6657,7 +6649,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct exception" >&5 $as_echo_n "checking for struct exception... " >&6; } -if ${emacs_cv_struct_exception+:} false; then : +if test "${emacs_cv_struct_exception+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6690,7 +6682,7 @@ for ac_header in sys/socket.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/socket.h" "ac_cv_header_sys_socket_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_socket_h" = xyes; then : +if test "x$ac_cv_header_sys_socket_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_SOCKET_H 1 _ACEOF @@ -6706,7 +6698,7 @@ #include <sys/socket.h> #endif " -if test "x$ac_cv_header_net_if_h" = xyes; then : +if test "x$ac_cv_header_net_if_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_NET_IF_H 1 _ACEOF @@ -6718,7 +6710,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct tm is in sys/time.h or time.h" >&5 $as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; } -if ${ac_cv_struct_tm+:} false; then : +if test "${ac_cv_struct_tm+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6755,7 +6747,7 @@ #include <$ac_cv_struct_tm> " -if test "x$ac_cv_member_struct_tm_tm_zone" = xyes; then : +if test "x$ac_cv_member_struct_tm_tm_zone" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_TM_TM_ZONE 1 @@ -6771,7 +6763,7 @@ else ac_fn_c_check_decl "$LINENO" "tzname" "ac_cv_have_decl_tzname" "#include <time.h> " -if test "x$ac_cv_have_decl_tzname" = xyes; then : +if test "x$ac_cv_have_decl_tzname" = x""yes; then : ac_have_decl=1 else ac_have_decl=0 @@ -6783,7 +6775,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tzname" >&5 $as_echo_n "checking for tzname... " >&6; } -if ${ac_cv_var_tzname+:} false; then : +if test "${ac_cv_var_tzname+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6820,7 +6812,7 @@ ac_fn_c_check_member "$LINENO" "struct tm" "tm_gmtoff" "ac_cv_member_struct_tm_tm_gmtoff" "#include <time.h> " -if test "x$ac_cv_member_struct_tm_tm_gmtoff" = xyes; then : +if test "x$ac_cv_member_struct_tm_tm_gmtoff" = x""yes; then : $as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h @@ -6834,7 +6826,7 @@ #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_flags" = xyes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_flags" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_FLAGS 1 @@ -6850,7 +6842,7 @@ #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_hwaddr" = xyes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_hwaddr" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_HWADDR 1 @@ -6866,7 +6858,7 @@ #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_netmask" = xyes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_netmask" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_NETMASK 1 @@ -6882,7 +6874,7 @@ #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_broadaddr" = xyes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_broadaddr" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_BROADADDR 1 @@ -6898,7 +6890,7 @@ #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_addr" = xyes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_addr" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_ADDR 1 @@ -6927,7 +6919,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working volatile" >&5 $as_echo_n "checking for working volatile... " >&6; } -if ${ac_cv_c_volatile+:} false; then : +if test "${ac_cv_c_volatile+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6961,7 +6953,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5 $as_echo_n "checking for an ANSI C-conforming const... " >&6; } -if ${ac_cv_c_const+:} false; then : +if test "${ac_cv_c_const+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7041,7 +7033,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for void * support" >&5 $as_echo_n "checking for void * support... " >&6; } -if ${emacs_cv_void_star+:} false; then : +if test "${emacs_cv_void_star+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7074,7 +7066,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 $as_echo_n "checking whether byte ordering is bigendian... " >&6; } -if ${ac_cv_c_bigendian+:} false; then : +if test "${ac_cv_c_bigendian+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_cv_c_bigendian=unknown @@ -7293,7 +7285,7 @@ ;; #( *) as_fn_error $? "unknown endianness - presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; esac @@ -7301,7 +7293,7 @@ $as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } set x ${MAKE-make} ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : +if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\"" = set; then : $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF @@ -7389,7 +7381,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5 $as_echo_n "checking for long file names... " >&6; } -if ${ac_cv_sys_long_file_names+:} false; then : +if test "${ac_cv_sys_long_file_names+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_cv_sys_long_file_names=yes @@ -7445,8 +7437,8 @@ have_x=disabled else case $x_includes,$x_libraries in #( - *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( - *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then : + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5 ;; #( + *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then : $as_echo_n "(cached) " >&6 else # One or both of the vars are not set, and there is no cached value. @@ -7729,7 +7721,7 @@ TEMACS_LDFLAGS2= fi ac_fn_c_check_header_mongrel "$LINENO" "AppKit/AppKit.h" "ac_cv_header_AppKit_AppKit_h" "$ac_includes_default" -if test "x$ac_cv_header_AppKit_AppKit_h" = xyes; then : +if test "x$ac_cv_header_AppKit_AppKit_h" = x""yes; then : HAVE_NS=yes else as_fn_error $? "\`--with-ns' was specified, but the include @@ -7811,7 +7803,7 @@ set dummy X; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_HAVE_XSERVER+:} false; then : +if test "${ac_cv_prog_HAVE_XSERVER+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$HAVE_XSERVER"; then @@ -7870,14 +7862,14 @@ GNU_MALLOC=yes doug_lea_malloc=yes ac_fn_c_check_func "$LINENO" "malloc_get_state" "ac_cv_func_malloc_get_state" -if test "x$ac_cv_func_malloc_get_state" = xyes; then : +if test "x$ac_cv_func_malloc_get_state" = x""yes; then : else doug_lea_malloc=no fi ac_fn_c_check_func "$LINENO" "malloc_set_state" "ac_cv_func_malloc_set_state" -if test "x$ac_cv_func_malloc_set_state" = xyes; then : +if test "x$ac_cv_func_malloc_set_state" = x""yes; then : else doug_lea_malloc=no @@ -7885,7 +7877,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __after_morecore_hook exists" >&5 $as_echo_n "checking whether __after_morecore_hook exists... " >&6; } -if ${emacs_cv_var___after_morecore_hook+:} false; then : +if test "${emacs_cv_var___after_morecore_hook+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7990,7 +7982,7 @@ for ac_func in getpagesize do : ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize" -if test "x$ac_cv_func_getpagesize" = xyes; then : +if test "x$ac_cv_func_getpagesize" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETPAGESIZE 1 _ACEOF @@ -8000,7 +7992,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5 $as_echo_n "checking for working mmap... " >&6; } -if ${ac_cv_func_mmap_fixed_mapped+:} false; then : +if test "${ac_cv_func_mmap_fixed_mapped+set}" = set; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -8175,7 +8167,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5 $as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; } -if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then : +if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -8209,7 +8201,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5 $as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; } -if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then : +if test "x$ac_cv_lib_dnet_dnet_ntoa" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBDNET 1 _ACEOF @@ -8221,7 +8213,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lXbsd" >&5 $as_echo_n "checking for main in -lXbsd... " >&6; } -if ${ac_cv_lib_Xbsd_main+:} false; then : +if test "${ac_cv_lib_Xbsd_main+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -8249,14 +8241,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xbsd_main" >&5 $as_echo "$ac_cv_lib_Xbsd_main" >&6; } -if test "x$ac_cv_lib_Xbsd_main" = xyes; then : +if test "x$ac_cv_lib_Xbsd_main" = x""yes; then : LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd" fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cma_open in -lpthreads" >&5 $as_echo_n "checking for cma_open in -lpthreads... " >&6; } -if ${ac_cv_lib_pthreads_cma_open+:} false; then : +if test "${ac_cv_lib_pthreads_cma_open+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -8290,7 +8282,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_cma_open" >&5 $as_echo "$ac_cv_lib_pthreads_cma_open" >&6; } -if test "x$ac_cv_lib_pthreads_cma_open" = xyes; then : +if test "x$ac_cv_lib_pthreads_cma_open" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBPTHREADS 1 _ACEOF @@ -8317,7 +8309,7 @@ aix*) { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -bbigtoc option" >&5 $as_echo_n "checking for -bbigtoc option... " >&6; } -if ${gdb_cv_bigtoc+:} false; then : +if test "${gdb_cv_bigtoc+set}" = set; then : $as_echo_n "(cached) " >&6 else @@ -8491,7 +8483,7 @@ if test "${window_system}" = "x11"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 version 6" >&5 $as_echo_n "checking X11 version 6... " >&6; } - if ${emacs_cv_x11_version_6+:} false; then : + if test "${emacs_cv_x11_version_6+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8556,7 +8548,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -8667,7 +8659,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -8766,7 +8758,7 @@ for ac_func in MagickExportImagePixels do : ac_fn_c_check_func "$LINENO" "MagickExportImagePixels" "ac_cv_func_MagickExportImagePixels" -if test "x$ac_cv_func_MagickExportImagePixels" = xyes; then : +if test "x$ac_cv_func_MagickExportImagePixels" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MAGICKEXPORTIMAGEPIXELS 1 _ACEOF @@ -8792,7 +8784,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -8898,7 +8890,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9003,7 +8995,7 @@ for ac_func in gtk_main do : ac_fn_c_check_func "$LINENO" "gtk_main" "ac_cv_func_gtk_main" -if test "x$ac_cv_func_gtk_main" = xyes; then : +if test "x$ac_cv_func_gtk_main" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GTK_MAIN 1 _ACEOF @@ -9013,7 +9005,7 @@ if test "${GTK_COMPILES}" != "yes"; then if test "$USE_X_TOOLKIT" != "maybe"; then - as_fn_error $? "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5; + as_fn_error $? "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5 ; fi else HAVE_GTK=yes @@ -9051,7 +9043,7 @@ ac_fn_c_check_decl "$LINENO" "GTK_TYPE_FILE_SELECTION" "ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" "$ac_includes_default #include <gtk/gtk.h> " -if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = xyes; then : +if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = x""yes; then : HAVE_GTK_FILE_SELECTION=yes else HAVE_GTK_FILE_SELECTION=no @@ -9061,7 +9053,7 @@ for ac_func in gtk_file_selection_new do : ac_fn_c_check_func "$LINENO" "gtk_file_selection_new" "ac_cv_func_gtk_file_selection_new" -if test "x$ac_cv_func_gtk_file_selection_new" = xyes; then : +if test "x$ac_cv_func_gtk_file_selection_new" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GTK_FILE_SELECTION_NEW 1 _ACEOF @@ -9075,7 +9067,7 @@ for ac_header in pthread.h do : ac_fn_c_check_header_mongrel "$LINENO" "pthread.h" "ac_cv_header_pthread_h" "$ac_includes_default" -if test "x$ac_cv_header_pthread_h" = xyes; then : +if test "x$ac_cv_header_pthread_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_PTHREAD_H 1 _ACEOF @@ -9087,7 +9079,7 @@ if test "$ac_cv_header_pthread_h"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -lpthread" >&5 $as_echo_n "checking for pthread_self in -lpthread... " >&6; } -if ${ac_cv_lib_pthread_pthread_self+:} false; then : +if test "${ac_cv_lib_pthread_pthread_self+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9121,7 +9113,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_self" >&5 $as_echo "$ac_cv_lib_pthread_pthread_self" >&6; } -if test "x$ac_cv_lib_pthread_pthread_self" = xyes; then : +if test "x$ac_cv_lib_pthread_pthread_self" = x""yes; then : HAVE_GTK_AND_PTHREAD=yes fi @@ -9164,7 +9156,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9259,7 +9251,7 @@ for ac_func in dbus_watch_get_unix_fd do : ac_fn_c_check_func "$LINENO" "dbus_watch_get_unix_fd" "ac_cv_func_dbus_watch_get_unix_fd" -if test "x$ac_cv_func_dbus_watch_get_unix_fd" = xyes; then : +if test "x$ac_cv_func_dbus_watch_get_unix_fd" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_DBUS_WATCH_GET_UNIX_FD 1 _ACEOF @@ -9281,7 +9273,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9380,7 +9372,7 @@ if test "${with_selinux}" = "yes"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgetfilecon in -lselinux" >&5 $as_echo_n "checking for lgetfilecon in -lselinux... " >&6; } -if ${ac_cv_lib_selinux_lgetfilecon+:} false; then : +if test "${ac_cv_lib_selinux_lgetfilecon+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9414,7 +9406,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_selinux_lgetfilecon" >&5 $as_echo "$ac_cv_lib_selinux_lgetfilecon" >&6; } -if test "x$ac_cv_lib_selinux_lgetfilecon" = xyes; then : +if test "x$ac_cv_lib_selinux_lgetfilecon" = x""yes; then : HAVE_LIBSELINUX=yes else HAVE_LIBSELINUX=no @@ -9438,7 +9430,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9540,7 +9532,7 @@ if test "$with_xaw3d" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5 $as_echo_n "checking for xaw3d... " >&6; } - if ${emacs_cv_xaw3d+:} false; then : + if test "${emacs_cv_xaw3d+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9582,7 +9574,7 @@ $as_echo "no" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libXaw" >&5 $as_echo_n "checking for libXaw... " >&6; } - if ${emacs_cv_xaw+:} false; then : + if test "${emacs_cv_xaw+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9628,7 +9620,7 @@ if test "${USE_X_TOOLKIT}" != "none"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 toolkit version" >&5 $as_echo_n "checking X11 toolkit version... " >&6; } - if ${emacs_cv_x11_toolkit_version_6+:} false; then : + if test "${emacs_cv_x11_toolkit_version_6+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9679,7 +9671,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuConvertStandardSelection in -lXmu" >&5 $as_echo_n "checking for XmuConvertStandardSelection in -lXmu... " >&6; } -if ${ac_cv_lib_Xmu_XmuConvertStandardSelection+:} false; then : +if test "${ac_cv_lib_Xmu_XmuConvertStandardSelection+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9713,7 +9705,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xmu_XmuConvertStandardSelection" >&5 $as_echo "$ac_cv_lib_Xmu_XmuConvertStandardSelection" >&6; } -if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = xyes; then : +if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBXMU 1 _ACEOF @@ -9740,7 +9732,7 @@ if test "${USE_X_TOOLKIT}" != "none"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XShapeQueryExtension in -lXext" >&5 $as_echo_n "checking for XShapeQueryExtension in -lXext... " >&6; } -if ${ac_cv_lib_Xext_XShapeQueryExtension+:} false; then : +if test "${ac_cv_lib_Xext_XShapeQueryExtension+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9774,7 +9766,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xext_XShapeQueryExtension" >&5 $as_echo "$ac_cv_lib_Xext_XShapeQueryExtension" >&6; } -if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = xyes; then : +if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBXEXT 1 _ACEOF @@ -9790,7 +9782,7 @@ if test "${USE_X_TOOLKIT}" = "MOTIF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Motif version 2.1" >&5 $as_echo_n "checking for Motif version 2.1... " >&6; } -if ${emacs_cv_motif_version_2_1+:} false; then : +if test "${emacs_cv_motif_version_2_1+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9820,7 +9812,7 @@ if test $emacs_cv_motif_version_2_1 = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpCreateContext in -lXp" >&5 $as_echo_n "checking for XpCreateContext in -lXp... " >&6; } -if ${ac_cv_lib_Xp_XpCreateContext+:} false; then : +if test "${ac_cv_lib_Xp_XpCreateContext+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9854,14 +9846,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xp_XpCreateContext" >&5 $as_echo "$ac_cv_lib_Xp_XpCreateContext" >&6; } -if test "x$ac_cv_lib_Xp_XpCreateContext" = xyes; then : +if test "x$ac_cv_lib_Xp_XpCreateContext" = x""yes; then : LIBXP=-lXp fi else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LessTif where some systems put it" >&5 $as_echo_n "checking for LessTif where some systems put it... " >&6; } -if ${emacs_cv_lesstif+:} false; then : +if test "${emacs_cv_lesstif+set}" = set; then : $as_echo_n "(cached) " >&6 else # We put this in CFLAGS temporarily to precede other -I options @@ -10020,7 +10012,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10122,7 +10114,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10214,7 +10206,7 @@ HAVE_XRENDER=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XRenderQueryExtension in -lXrender" >&5 $as_echo_n "checking for XRenderQueryExtension in -lXrender... " >&6; } -if ${ac_cv_lib_Xrender_XRenderQueryExtension+:} false; then : +if test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10248,7 +10240,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xrender_XRenderQueryExtension" >&5 $as_echo "$ac_cv_lib_Xrender_XRenderQueryExtension" >&6; } -if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = xyes; then : +if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = x""yes; then : HAVE_XRENDER=yes fi @@ -10261,10 +10253,10 @@ XFT_LIBS="-lXrender $XFT_LIBS" LIBS="$XFT_LIBS $LIBS" ac_fn_c_check_header_mongrel "$LINENO" "X11/Xft/Xft.h" "ac_cv_header_X11_Xft_Xft_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Xft_Xft_h" = xyes; then : +if test "x$ac_cv_header_X11_Xft_Xft_h" = x""yes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5 $as_echo_n "checking for XftFontOpen in -lXft... " >&6; } -if ${ac_cv_lib_Xft_XftFontOpen+:} false; then : +if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10298,7 +10290,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xft_XftFontOpen" >&5 $as_echo "$ac_cv_lib_Xft_XftFontOpen" >&6; } -if test "x$ac_cv_lib_Xft_XftFontOpen" = xyes; then : +if test "x$ac_cv_lib_Xft_XftFontOpen" = x""yes; then : HAVE_XFT=yes fi @@ -10347,7 +10339,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10440,7 +10432,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OTF_get_variation_glyphs in -lotf" >&5 $as_echo_n "checking for OTF_get_variation_glyphs in -lotf... " >&6; } -if ${ac_cv_lib_otf_OTF_get_variation_glyphs+:} false; then : +if test "${ac_cv_lib_otf_OTF_get_variation_glyphs+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10474,7 +10466,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_otf_OTF_get_variation_glyphs" >&5 $as_echo "$ac_cv_lib_otf_OTF_get_variation_glyphs" >&6; } -if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = xyes; then : +if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = x""yes; then : HAVE_OTF_GET_VARIATION_GLYPHS=yes else HAVE_OTF_GET_VARIATION_GLYPHS=no @@ -10499,7 +10491,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10617,10 +10609,10 @@ if test "${HAVE_X11}" = "yes"; then if test "${with_xpm}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_xpm_h" = xyes; then : +if test "x$ac_cv_header_X11_xpm_h" = x""yes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToPixmap in -lXpm" >&5 $as_echo_n "checking for XpmReadFileToPixmap in -lXpm... " >&6; } -if ${ac_cv_lib_Xpm_XpmReadFileToPixmap+:} false; then : +if test "${ac_cv_lib_Xpm_XpmReadFileToPixmap+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10654,7 +10646,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xpm_XpmReadFileToPixmap" >&5 $as_echo "$ac_cv_lib_Xpm_XpmReadFileToPixmap" >&6; } -if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = xyes; then : +if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = x""yes; then : HAVE_XPM=yes fi @@ -10706,10 +10698,10 @@ if test "${HAVE_X11}" = "yes"; then if test "${with_jpeg}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "jerror.h" "ac_cv_header_jerror_h" "$ac_includes_default" -if test "x$ac_cv_header_jerror_h" = xyes; then : +if test "x$ac_cv_header_jerror_h" = x""yes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_compress in -ljpeg" >&5 $as_echo_n "checking for jpeg_destroy_compress in -ljpeg... " >&6; } -if ${ac_cv_lib_jpeg_jpeg_destroy_compress+:} false; then : +if test "${ac_cv_lib_jpeg_jpeg_destroy_compress+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10743,7 +10735,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jpeg_jpeg_destroy_compress" >&5 $as_echo "$ac_cv_lib_jpeg_jpeg_destroy_compress" >&6; } -if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = xyes; then : +if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = x""yes; then : HAVE_JPEG=yes fi @@ -10802,7 +10794,7 @@ if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_get_channels in -lpng" >&5 $as_echo_n "checking for png_get_channels in -lpng... " >&6; } -if ${ac_cv_lib_png_png_get_channels+:} false; then : +if test "${ac_cv_lib_png_png_get_channels+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10836,7 +10828,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_get_channels" >&5 $as_echo "$ac_cv_lib_png_png_get_channels" >&6; } -if test "x$ac_cv_lib_png_png_get_channels" = xyes; then : +if test "x$ac_cv_lib_png_png_get_channels" = x""yes; then : HAVE_PNG=yes fi @@ -10858,13 +10850,13 @@ if test "${HAVE_X11}" = "yes"; then if test "${with_tiff}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default" -if test "x$ac_cv_header_tiffio_h" = xyes; then : +if test "x$ac_cv_header_tiffio_h" = x""yes; then : tifflibs="-lz -lm" # At least one tiff package requires the jpeg library. if test "${HAVE_JPEG}" = yes; then tifflibs="-ljpeg $tifflibs"; fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFGetVersion in -ltiff" >&5 $as_echo_n "checking for TIFFGetVersion in -ltiff... " >&6; } -if ${ac_cv_lib_tiff_TIFFGetVersion+:} false; then : +if test "${ac_cv_lib_tiff_TIFFGetVersion+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10898,7 +10890,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFGetVersion" >&5 $as_echo "$ac_cv_lib_tiff_TIFFGetVersion" >&6; } -if test "x$ac_cv_lib_tiff_TIFFGetVersion" = xyes; then : +if test "x$ac_cv_lib_tiff_TIFFGetVersion" = x""yes; then : HAVE_TIFF=yes fi @@ -10921,12 +10913,12 @@ LIBGIF= if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "gif_lib.h" "ac_cv_header_gif_lib_h" "$ac_includes_default" -if test "x$ac_cv_header_gif_lib_h" = xyes; then : +if test "x$ac_cv_header_gif_lib_h" = x""yes; then : # EGifPutExtensionLast only exists from version libungif-4.1.0b1. # Earlier versions can crash Emacs. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lgif" >&5 $as_echo_n "checking for EGifPutExtensionLast in -lgif... " >&6; } -if ${ac_cv_lib_gif_EGifPutExtensionLast+:} false; then : +if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10960,7 +10952,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5 $as_echo "$ac_cv_lib_gif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = xyes; then : +if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = x""yes; then : HAVE_GIF=yes else HAVE_GIF=maybe @@ -10976,7 +10968,7 @@ # If gif_lib.h but no libgif, try libungif. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lungif" >&5 $as_echo_n "checking for EGifPutExtensionLast in -lungif... " >&6; } -if ${ac_cv_lib_ungif_EGifPutExtensionLast+:} false; then : +if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11010,7 +11002,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ungif_EGifPutExtensionLast" >&5 $as_echo "$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = xyes; then : +if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = x""yes; then : HAVE_GIF=yes else HAVE_GIF=no @@ -11057,10 +11049,10 @@ MOUSE_SUPPORT= if test "${with_gpm}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "gpm.h" "ac_cv_header_gpm_h" "$ac_includes_default" -if test "x$ac_cv_header_gpm_h" = xyes; then : +if test "x$ac_cv_header_gpm_h" = x""yes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Gpm_Open in -lgpm" >&5 $as_echo_n "checking for Gpm_Open in -lgpm... " >&6; } -if ${ac_cv_lib_gpm_Gpm_Open+:} false; then : +if test "${ac_cv_lib_gpm_Gpm_Open+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11094,7 +11086,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gpm_Gpm_Open" >&5 $as_echo "$ac_cv_lib_gpm_Gpm_Open" >&6; } -if test "x$ac_cv_lib_gpm_Gpm_Open" = xyes; then : +if test "x$ac_cv_lib_gpm_Gpm_Open" = x""yes; then : HAVE_GPM=yes fi @@ -11114,7 +11106,7 @@ ac_fn_c_check_header_mongrel "$LINENO" "malloc/malloc.h" "ac_cv_header_malloc_malloc_h" "$ac_includes_default" -if test "x$ac_cv_header_malloc_malloc_h" = xyes; then : +if test "x$ac_cv_header_malloc_malloc_h" = x""yes; then : $as_echo "#define HAVE_MALLOC_MALLOC_H 1" >>confdefs.h @@ -11159,10 +11151,10 @@ LIBXSM= if test "${HAVE_X11}" = "yes"; then ac_fn_c_check_header_mongrel "$LINENO" "X11/SM/SMlib.h" "ac_cv_header_X11_SM_SMlib_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_SM_SMlib_h" = xyes; then : +if test "x$ac_cv_header_X11_SM_SMlib_h" = x""yes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SmcOpenConnection in -lSM" >&5 $as_echo_n "checking for SmcOpenConnection in -lSM... " >&6; } -if ${ac_cv_lib_SM_SmcOpenConnection+:} false; then : +if test "${ac_cv_lib_SM_SmcOpenConnection+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11196,7 +11188,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_SM_SmcOpenConnection" >&5 $as_echo "$ac_cv_lib_SM_SmcOpenConnection" >&6; } -if test "x$ac_cv_lib_SM_SmcOpenConnection" = xyes; then : +if test "x$ac_cv_lib_SM_SmcOpenConnection" = x""yes; then : HAVE_X_SM=yes fi @@ -11227,7 +11219,7 @@ set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -11318,7 +11310,7 @@ LIBS="$LIBXML2_LIBS $LIBS" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5 $as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; } -if ${ac_cv_lib_xml2_htmlReadMemory+:} false; then : +if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11352,7 +11344,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_htmlReadMemory" >&5 $as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; } -if test "x$ac_cv_lib_xml2_htmlReadMemory" = xyes; then : +if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then : HAVE_LIBXML2=yes else HAVE_LIBXML2=no @@ -11374,7 +11366,7 @@ # If netdb.h doesn't declare h_errno, we must declare it by hand. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5 $as_echo_n "checking whether netdb declares h_errno... " >&6; } -if ${emacs_cv_netdb_declares_h_errno+:} false; then : +if test "${emacs_cv_netdb_declares_h_errno+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11404,22 +11396,11 @@ fi -ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" -if test "x$ac_cv_type_size_t" = xyes; then : - -else - -cat >>confdefs.h <<_ACEOF -#define size_t unsigned int -_ACEOF - -fi - # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 $as_echo_n "checking for working alloca.h... " >&6; } -if ${ac_cv_working_alloca_h+:} false; then : +if test "${ac_cv_working_alloca_h+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11452,7 +11433,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 $as_echo_n "checking for alloca... " >&6; } -if ${ac_cv_func_alloca_works+:} false; then : +if test "${ac_cv_func_alloca_works+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11471,7 +11452,7 @@ #pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ -void *alloca (size_t); +char *alloca (); # endif # endif # endif @@ -11515,7 +11496,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5 $as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; } -if ${ac_cv_os_cray+:} false; then : +if test "${ac_cv_os_cray+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11556,7 +11537,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 $as_echo_n "checking stack direction for C alloca... " >&6; } -if ${ac_cv_c_stack_direction+:} false; then : +if test "${ac_cv_c_stack_direction+set}" = set; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -11613,7 +11594,7 @@ # On HPUX 9.01, -lm does not contain logb, so check for sqrt. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5 $as_echo_n "checking for sqrt in -lm... " >&6; } -if ${ac_cv_lib_m_sqrt+:} false; then : +if test "${ac_cv_lib_m_sqrt+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11647,7 +11628,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sqrt" >&5 $as_echo "$ac_cv_lib_m_sqrt" >&6; } -if test "x$ac_cv_lib_m_sqrt" = xyes; then : +if test "x$ac_cv_lib_m_sqrt" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF @@ -11661,7 +11642,7 @@ # have the same check as for liblockfile below. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -lmail" >&5 $as_echo_n "checking for maillock in -lmail... " >&6; } -if ${ac_cv_lib_mail_maillock+:} false; then : +if test "${ac_cv_lib_mail_maillock+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11695,7 +11676,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mail_maillock" >&5 $as_echo "$ac_cv_lib_mail_maillock" >&6; } -if test "x$ac_cv_lib_mail_maillock" = xyes; then : +if test "x$ac_cv_lib_mail_maillock" = x""yes; then : have_mail=yes else have_mail=no @@ -11712,7 +11693,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -llockfile" >&5 $as_echo_n "checking for maillock in -llockfile... " >&6; } -if ${ac_cv_lib_lockfile_maillock+:} false; then : +if test "${ac_cv_lib_lockfile_maillock+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11746,7 +11727,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lockfile_maillock" >&5 $as_echo "$ac_cv_lib_lockfile_maillock" >&6; } -if test "x$ac_cv_lib_lockfile_maillock" = xyes; then : +if test "x$ac_cv_lib_lockfile_maillock" = x""yes; then : have_lockfile=yes else have_lockfile=no @@ -11766,7 +11747,7 @@ set dummy liblockfile.so; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_liblockfile+:} false; then : +if test "${ac_cv_prog_liblockfile+set}" = set; then : $as_echo_n "(cached) " >&6 else if test -n "$liblockfile"; then @@ -11810,7 +11791,7 @@ for ac_func in touchlock do : ac_fn_c_check_func "$LINENO" "touchlock" "ac_cv_func_touchlock" -if test "x$ac_cv_func_touchlock" = xyes; then : +if test "x$ac_cv_func_touchlock" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_TOUCHLOCK 1 _ACEOF @@ -11821,7 +11802,7 @@ for ac_header in maillock.h do : ac_fn_c_check_header_mongrel "$LINENO" "maillock.h" "ac_cv_header_maillock_h" "$ac_includes_default" -if test "x$ac_cv_header_maillock_h" = xyes; then : +if test "x$ac_cv_header_maillock_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MAILLOCK_H 1 _ACEOF @@ -11903,7 +11884,7 @@ for ac_header in sys/un.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/un.h" "ac_cv_header_sys_un_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_un_h" = xyes; then : +if test "x$ac_cv_header_sys_un_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_UN_H 1 _ACEOF @@ -11936,7 +11917,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mktime" >&5 $as_echo_n "checking for working mktime... " >&6; } -if ${ac_cv_func_working_mktime+:} false; then : +if test "${ac_cv_func_working_mktime+set}" = set; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -12173,7 +12154,7 @@ # Check for getloadavg, but be sure not to touch the cache variable. (ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = xyes; then : +if test "x$ac_cv_func_getloadavg" = x""yes; then : exit 0 else exit 1 @@ -12184,7 +12165,7 @@ for ac_func in pstat_getdynamic do : ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" -if test "x$ac_cv_func_pstat_getdynamic" = xyes; then : +if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_PSTAT_GETDYNAMIC 1 _ACEOF @@ -12196,7 +12177,7 @@ # Solaris has libkstat which does not require root. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 $as_echo_n "checking for kstat_open in -lkstat... " >&6; } -if ${ac_cv_lib_kstat_kstat_open+:} false; then : +if test "${ac_cv_lib_kstat_kstat_open+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12230,7 +12211,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kstat_kstat_open" >&5 $as_echo "$ac_cv_lib_kstat_kstat_open" >&6; } -if test "x$ac_cv_lib_kstat_kstat_open" = xyes; then : +if test "x$ac_cv_lib_kstat_kstat_open" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBKSTAT 1 _ACEOF @@ -12248,7 +12229,7 @@ if test $ac_have_func = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5 $as_echo_n "checking for elf_begin in -lelf... " >&6; } -if ${ac_cv_lib_elf_elf_begin+:} false; then : +if test "${ac_cv_lib_elf_elf_begin+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12282,7 +12263,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5 $as_echo "$ac_cv_lib_elf_elf_begin" >&6; } -if test "x$ac_cv_lib_elf_elf_begin" = xyes; then : +if test "x$ac_cv_lib_elf_elf_begin" = x""yes; then : LIBS="-lelf $LIBS" fi @@ -12290,7 +12271,7 @@ if test $ac_have_func = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5 $as_echo_n "checking for kvm_open in -lkvm... " >&6; } -if ${ac_cv_lib_kvm_kvm_open+:} false; then : +if test "${ac_cv_lib_kvm_kvm_open+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12324,14 +12305,14 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kvm_kvm_open" >&5 $as_echo "$ac_cv_lib_kvm_kvm_open" >&6; } -if test "x$ac_cv_lib_kvm_kvm_open" = xyes; then : +if test "x$ac_cv_lib_kvm_kvm_open" = x""yes; then : LIBS="-lkvm $LIBS" fi # Check for the 4.4BSD definition of getloadavg. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lutil" >&5 $as_echo_n "checking for getloadavg in -lutil... " >&6; } -if ${ac_cv_lib_util_getloadavg+:} false; then : +if test "${ac_cv_lib_util_getloadavg+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12365,7 +12346,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5 $as_echo "$ac_cv_lib_util_getloadavg" >&6; } -if test "x$ac_cv_lib_util_getloadavg" = xyes; then : +if test "x$ac_cv_lib_util_getloadavg" = x""yes; then : LIBS="-lutil $LIBS" ac_have_func=yes ac_cv_func_getloadavg_setgid=yes fi @@ -12378,7 +12359,7 @@ LIBS="-L/usr/local/lib $LIBS" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lgetloadavg" >&5 $as_echo_n "checking for getloadavg in -lgetloadavg... " >&6; } -if ${ac_cv_lib_getloadavg_getloadavg+:} false; then : +if test "${ac_cv_lib_getloadavg_getloadavg+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12412,7 +12393,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5 $as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; } -if test "x$ac_cv_lib_getloadavg_getloadavg" = xyes; then : +if test "x$ac_cv_lib_getloadavg_getloadavg" = x""yes; then : LIBS="-lgetloadavg $LIBS" else LIBS=$ac_getloadavg_LIBS @@ -12425,7 +12406,7 @@ for ac_func in getloadavg do : ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = xyes; then : +if test "x$ac_cv_func_getloadavg" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETLOADAVG 1 _ACEOF @@ -12443,14 +12424,14 @@ # Figure out what our getloadavg.c needs. ac_have_func=no ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_dg_sys_info_h" = xyes; then : +if test "x$ac_cv_header_sys_dg_sys_info_h" = x""yes; then : ac_have_func=yes $as_echo "#define DGUX 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 $as_echo_n "checking for dg_sys_info in -ldgc... " >&6; } -if ${ac_cv_lib_dgc_dg_sys_info+:} false; then : +if test "${ac_cv_lib_dgc_dg_sys_info+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12484,7 +12465,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgc_dg_sys_info" >&5 $as_echo "$ac_cv_lib_dgc_dg_sys_info" >&6; } -if test "x$ac_cv_lib_dgc_dg_sys_info" = xyes; then : +if test "x$ac_cv_lib_dgc_dg_sys_info" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBDGC 1 _ACEOF @@ -12498,7 +12479,7 @@ ac_fn_c_check_header_mongrel "$LINENO" "locale.h" "ac_cv_header_locale_h" "$ac_includes_default" -if test "x$ac_cv_header_locale_h" = xyes; then : +if test "x$ac_cv_header_locale_h" = x""yes; then : fi @@ -12506,7 +12487,7 @@ for ac_func in setlocale do : ac_fn_c_check_func "$LINENO" "setlocale" "ac_cv_func_setlocale" -if test "x$ac_cv_func_setlocale" = xyes; then : +if test "x$ac_cv_func_setlocale" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SETLOCALE 1 _ACEOF @@ -12518,8 +12499,7 @@ # We cannot check for <dwarf.h>, because Solaris 2 does not use dwarf (it # uses stabs), but it is still SVR4. We cannot check for <elf.h> because # Irix 4.0.5F has the header but not the library. -if test $ac_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ - && test "$ac_cv_lib_kvm_kvm_open" = yes; then +if test $ac_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes; then ac_have_func=yes $as_echo "#define SVR4 1" >>confdefs.h @@ -12528,7 +12508,7 @@ if test $ac_have_func = no; then ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_inq_stats_cpustats_h" = xyes; then : +if test "x$ac_cv_header_inq_stats_cpustats_h" = x""yes; then : ac_have_func=yes $as_echo "#define UMAX 1" >>confdefs.h @@ -12543,7 +12523,7 @@ if test $ac_have_func = no; then ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_cpustats_h" = xyes; then : +if test "x$ac_cv_header_sys_cpustats_h" = x""yes; then : ac_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h fi @@ -12555,7 +12535,7 @@ for ac_header in mach/mach.h do : ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default" -if test "x$ac_cv_header_mach_mach_h" = xyes; then : +if test "x$ac_cv_header_mach_mach_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MACH_MACH_H 1 _ACEOF @@ -12569,13 +12549,13 @@ for ac_header in nlist.h do : ac_fn_c_check_header_mongrel "$LINENO" "nlist.h" "ac_cv_header_nlist_h" "$ac_includes_default" -if test "x$ac_cv_header_nlist_h" = xyes; then : +if test "x$ac_cv_header_nlist_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_NLIST_H 1 _ACEOF ac_fn_c_check_member "$LINENO" "struct nlist" "n_un.n_name" "ac_cv_member_struct_nlist_n_un_n_name" "#include <nlist.h> " -if test "x$ac_cv_member_struct_nlist_n_un_n_name" = xyes; then : +if test "x$ac_cv_member_struct_nlist_n_un_n_name" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_NLIST_N_UN_N_NAME 1 @@ -12598,7 +12578,7 @@ # Some definitions of getloadavg require that the program be installed setgid. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getloadavg requires setgid" >&5 $as_echo_n "checking whether getloadavg requires setgid... " >&6; } -if ${ac_cv_func_getloadavg_setgid+:} false; then : +if test "${ac_cv_func_getloadavg_setgid+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -12631,7 +12611,7 @@ if test $ac_cv_func_getloadavg_setgid = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking group of /dev/kmem" >&5 $as_echo_n "checking group of /dev/kmem... " >&6; } -if ${ac_cv_group_kmem+:} false; then : +if test "${ac_cv_group_kmem+set}" = set; then : $as_echo_n "(cached) " >&6 else # On Solaris, /dev/kmem is a symlink. Get info on the real file. @@ -12659,7 +12639,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5 $as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; } -if ${ac_cv_sys_largefile_source+:} false; then : +if test "${ac_cv_sys_largefile_source+set}" = set; then : $as_echo_n "(cached) " >&6 else while :; do @@ -12752,7 +12732,7 @@ for ac_header in getopt.h do : ac_fn_c_check_header_mongrel "$LINENO" "getopt.h" "ac_cv_header_getopt_h" "$ac_includes_default" -if test "x$ac_cv_header_getopt_h" = xyes; then : +if test "x$ac_cv_header_getopt_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETOPT_H 1 _ACEOF @@ -12767,7 +12747,7 @@ for ac_func in getopt_long_only do : ac_fn_c_check_func "$LINENO" "getopt_long_only" "ac_cv_func_getopt_long_only" -if test "x$ac_cv_func_getopt_long_only" = xyes; then : +if test "x$ac_cv_func_getopt_long_only" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETOPT_LONG_ONLY 1 _ACEOF @@ -12782,7 +12762,7 @@ if test -z "$GETOPT_H"; then ac_fn_c_check_decl "$LINENO" "optreset" "ac_cv_have_decl_optreset" "#include <getopt.h> " -if test "x$ac_cv_have_decl_optreset" = xyes; then : +if test "x$ac_cv_have_decl_optreset" = x""yes; then : GETOPT_H=getopt.h fi @@ -12791,13 +12771,13 @@ if test -z "$GETOPT_H"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working GNU getopt function" >&5 $as_echo_n "checking for working GNU getopt function... " >&6; } -if ${gl_cv_func_gnu_getopt+:} false; then : +if test "${gl_cv_func_gnu_getopt+set}" = set; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : ac_fn_c_check_decl "$LINENO" "getopt_clip" "ac_cv_have_decl_getopt_clip" "#include <getopt.h> " -if test "x$ac_cv_have_decl_getopt_clip" = xyes; then : +if test "x$ac_cv_have_decl_getopt_clip" = x""yes; then : gl_cv_func_gnu_getopt=no else gl_cv_func_gnu_getopt=yes @@ -12858,7 +12838,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5 $as_echo_n "checking whether getpgrp requires zero arguments... " >&6; } -if ${ac_cv_func_getpgrp_void+:} false; then : +if test "${ac_cv_func_getpgrp_void+set}" = set; then : $as_echo_n "(cached) " >&6 else # Use it with a single arg. @@ -12893,7 +12873,7 @@ for ac_func in strftime do : ac_fn_c_check_func "$LINENO" "strftime" "ac_cv_func_strftime" -if test "x$ac_cv_func_strftime" = xyes; then : +if test "x$ac_cv_func_strftime" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRFTIME 1 _ACEOF @@ -12902,7 +12882,7 @@ # strftime is in -lintl on SCO UNIX. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strftime in -lintl" >&5 $as_echo_n "checking for strftime in -lintl... " >&6; } -if ${ac_cv_lib_intl_strftime+:} false; then : +if test "${ac_cv_lib_intl_strftime+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12936,7 +12916,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_intl_strftime" >&5 $as_echo "$ac_cv_lib_intl_strftime" >&6; } -if test "x$ac_cv_lib_intl_strftime" = xyes; then : +if test "x$ac_cv_lib_intl_strftime" = x""yes; then : $as_echo "#define HAVE_STRFTIME 1" >>confdefs.h LIBS="-lintl $LIBS" @@ -12950,7 +12930,7 @@ for ac_func in grantpt do : ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt" -if test "x$ac_cv_func_grantpt" = xyes; then : +if test "x$ac_cv_func_grantpt" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GRANTPT 1 _ACEOF @@ -12963,7 +12943,7 @@ for ac_func in getpt do : ac_fn_c_check_func "$LINENO" "getpt" "ac_cv_func_getpt" -if test "x$ac_cv_func_getpt" = xyes; then : +if test "x$ac_cv_func_getpt" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETPT 1 _ACEOF @@ -12980,7 +12960,7 @@ have_tputs_et_al=true { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing tputs" >&5 $as_echo_n "checking for library containing tputs... " >&6; } -if ${ac_cv_search_tputs+:} false; then : +if test "${ac_cv_search_tputs+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_func_search_save_LIBS=$LIBS @@ -13014,11 +12994,11 @@ fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext - if ${ac_cv_search_tputs+:} false; then : + if test "${ac_cv_search_tputs+set}" = set; then : break fi done -if ${ac_cv_search_tputs+:} false; then : +if test "${ac_cv_search_tputs+set}" = set; then : else ac_cv_search_tputs=no @@ -13077,7 +13057,7 @@ freebsd) { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5 $as_echo_n "checking whether FreeBSD is new enough to use terminfo... " >&6; } - if ${emacs_cv_freebsd_terminfo+:} false; then : + if test "${emacs_cv_freebsd_terminfo+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -13219,16 +13199,16 @@ if test "$with_hesiod" != no ; then # Don't set $LIBS here -- see comments above. FIXME which comments? ac_fn_c_check_func "$LINENO" "res_send" "ac_cv_func_res_send" -if test "x$ac_cv_func_res_send" = xyes; then : +if test "x$ac_cv_func_res_send" = x""yes; then : else ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send" -if test "x$ac_cv_func___res_send" = xyes; then : +if test "x$ac_cv_func___res_send" = x""yes; then : else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_send in -lresolv" >&5 $as_echo_n "checking for res_send in -lresolv... " >&6; } -if ${ac_cv_lib_resolv_res_send+:} false; then : +if test "${ac_cv_lib_resolv_res_send+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13262,12 +13242,12 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv_res_send" >&5 $as_echo "$ac_cv_lib_resolv_res_send" >&6; } -if test "x$ac_cv_lib_resolv_res_send" = xyes; then : +if test "x$ac_cv_lib_resolv_res_send" = x""yes; then : resolv=yes else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __res_send in -lresolv" >&5 $as_echo_n "checking for __res_send in -lresolv... " >&6; } -if ${ac_cv_lib_resolv___res_send+:} false; then : +if test "${ac_cv_lib_resolv___res_send+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13301,7 +13281,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv___res_send" >&5 $as_echo "$ac_cv_lib_resolv___res_send" >&6; } -if test "x$ac_cv_lib_resolv___res_send" = xyes; then : +if test "x$ac_cv_lib_resolv___res_send" = x""yes; then : resolv=yes fi @@ -13317,12 +13297,12 @@ RESOLVLIB= fi ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost" -if test "x$ac_cv_func_hes_getmailhost" = xyes; then : +if test "x$ac_cv_func_hes_getmailhost" = x""yes; then : else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for hes_getmailhost in -lhesiod" >&5 $as_echo_n "checking for hes_getmailhost in -lhesiod... " >&6; } -if ${ac_cv_lib_hesiod_hes_getmailhost+:} false; then : +if test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13356,7 +13336,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_hesiod_hes_getmailhost" >&5 $as_echo "$ac_cv_lib_hesiod_hes_getmailhost" >&6; } -if test "x$ac_cv_lib_hesiod_hes_getmailhost" = xyes; then : +if test "x$ac_cv_lib_hesiod_hes_getmailhost" = x""yes; then : hesiod=yes else : @@ -13395,7 +13375,7 @@ if test "${with_kerberos}" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for com_err in -lcom_err" >&5 $as_echo_n "checking for com_err in -lcom_err... " >&6; } -if ${ac_cv_lib_com_err_com_err+:} false; then : +if test "${ac_cv_lib_com_err_com_err+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13429,7 +13409,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_com_err_com_err" >&5 $as_echo "$ac_cv_lib_com_err_com_err" >&6; } -if test "x$ac_cv_lib_com_err_com_err" = xyes; then : +if test "x$ac_cv_lib_com_err_com_err" = x""yes; then : have_com_err=yes else have_com_err=no @@ -13444,7 +13424,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lcrypto" >&5 $as_echo_n "checking for mit_des_cbc_encrypt in -lcrypto... " >&6; } -if ${ac_cv_lib_crypto_mit_des_cbc_encrypt+:} false; then : +if test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13478,7 +13458,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_crypto_mit_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_crypto_mit_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = xyes; then : +if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = x""yes; then : have_crypto=yes else have_crypto=no @@ -13493,7 +13473,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lk5crypto" >&5 $as_echo_n "checking for mit_des_cbc_encrypt in -lk5crypto... " >&6; } -if ${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+:} false; then : +if test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13527,7 +13507,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = xyes; then : +if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = x""yes; then : have_k5crypto=yes else have_k5crypto=no @@ -13542,7 +13522,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb5_init_context in -lkrb5" >&5 $as_echo_n "checking for krb5_init_context in -lkrb5... " >&6; } -if ${ac_cv_lib_krb5_krb5_init_context+:} false; then : +if test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13576,7 +13556,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb5_krb5_init_context" >&5 $as_echo "$ac_cv_lib_krb5_krb5_init_context" >&6; } -if test "x$ac_cv_lib_krb5_krb5_init_context" = xyes; then : +if test "x$ac_cv_lib_krb5_krb5_init_context" = x""yes; then : have_krb5=yes else have_krb5=no @@ -13592,7 +13572,7 @@ if test "${with_kerberos5}" = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes425" >&5 $as_echo_n "checking for des_cbc_encrypt in -ldes425... " >&6; } -if ${ac_cv_lib_des425_des_cbc_encrypt+:} false; then : +if test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13626,7 +13606,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des425_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_des425_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_des425_des_cbc_encrypt" = xyes; then : +if test "x$ac_cv_lib_des425_des_cbc_encrypt" = x""yes; then : have_des425=yes else have_des425=no @@ -13641,7 +13621,7 @@ else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes" >&5 $as_echo_n "checking for des_cbc_encrypt in -ldes... " >&6; } -if ${ac_cv_lib_des_des_cbc_encrypt+:} false; then : +if test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13675,7 +13655,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_des_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_des_des_cbc_encrypt" = xyes; then : +if test "x$ac_cv_lib_des_des_cbc_encrypt" = x""yes; then : have_des=yes else have_des=no @@ -13691,7 +13671,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb4" >&5 $as_echo_n "checking for krb_get_cred in -lkrb4... " >&6; } -if ${ac_cv_lib_krb4_krb_get_cred+:} false; then : +if test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13725,7 +13705,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb4_krb_get_cred" >&5 $as_echo "$ac_cv_lib_krb4_krb_get_cred" >&6; } -if test "x$ac_cv_lib_krb4_krb_get_cred" = xyes; then : +if test "x$ac_cv_lib_krb4_krb_get_cred" = x""yes; then : have_krb4=yes else have_krb4=no @@ -13740,7 +13720,7 @@ else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb" >&5 $as_echo_n "checking for krb_get_cred in -lkrb... " >&6; } -if ${ac_cv_lib_krb_krb_get_cred+:} false; then : +if test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13774,7 +13754,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb_krb_get_cred" >&5 $as_echo "$ac_cv_lib_krb_krb_get_cred" >&6; } -if test "x$ac_cv_lib_krb_krb_get_cred" = xyes; then : +if test "x$ac_cv_lib_krb_krb_get_cred" = x""yes; then : have_krb=yes else have_krb=no @@ -13794,13 +13774,13 @@ for ac_header in krb5.h do : ac_fn_c_check_header_mongrel "$LINENO" "krb5.h" "ac_cv_header_krb5_h" "$ac_includes_default" -if test "x$ac_cv_header_krb5_h" = xyes; then : +if test "x$ac_cv_header_krb5_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_H 1 _ACEOF ac_fn_c_check_member "$LINENO" "krb5_error" "text" "ac_cv_member_krb5_error_text" "#include <krb5.h> " -if test "x$ac_cv_member_krb5_error_text" = xyes; then : +if test "x$ac_cv_member_krb5_error_text" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_ERROR_TEXT 1 @@ -13810,7 +13790,7 @@ fi ac_fn_c_check_member "$LINENO" "krb5_error" "e_text" "ac_cv_member_krb5_error_e_text" "#include <krb5.h> " -if test "x$ac_cv_member_krb5_error_e_text" = xyes; then : +if test "x$ac_cv_member_krb5_error_e_text" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_ERROR_E_TEXT 1 @@ -13827,7 +13807,7 @@ for ac_header in des.h do : ac_fn_c_check_header_mongrel "$LINENO" "des.h" "ac_cv_header_des_h" "$ac_includes_default" -if test "x$ac_cv_header_des_h" = xyes; then : +if test "x$ac_cv_header_des_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_DES_H 1 _ACEOF @@ -13836,7 +13816,7 @@ for ac_header in kerberosIV/des.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/des.h" "ac_cv_header_kerberosIV_des_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberosIV_des_h" = xyes; then : +if test "x$ac_cv_header_kerberosIV_des_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROSIV_DES_H 1 _ACEOF @@ -13845,7 +13825,7 @@ for ac_header in kerberos/des.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberos/des.h" "ac_cv_header_kerberos_des_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberos_des_h" = xyes; then : +if test "x$ac_cv_header_kerberos_des_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROS_DES_H 1 _ACEOF @@ -13865,7 +13845,7 @@ for ac_header in krb.h do : ac_fn_c_check_header_mongrel "$LINENO" "krb.h" "ac_cv_header_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_krb_h" = xyes; then : +if test "x$ac_cv_header_krb_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB_H 1 _ACEOF @@ -13874,7 +13854,7 @@ for ac_header in kerberosIV/krb.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/krb.h" "ac_cv_header_kerberosIV_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberosIV_krb_h" = xyes; then : +if test "x$ac_cv_header_kerberosIV_krb_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROSIV_KRB_H 1 _ACEOF @@ -13883,7 +13863,7 @@ for ac_header in kerberos/krb.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberos/krb.h" "ac_cv_header_kerberos_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberos_krb_h" = xyes; then : +if test "x$ac_cv_header_kerberos_krb_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROS_KRB_H 1 _ACEOF @@ -13904,7 +13884,7 @@ for ac_header in com_err.h do : ac_fn_c_check_header_mongrel "$LINENO" "com_err.h" "ac_cv_header_com_err_h" "$ac_includes_default" -if test "x$ac_cv_header_com_err_h" = xyes; then : +if test "x$ac_cv_header_com_err_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_COM_ERR_H 1 _ACEOF @@ -13925,7 +13905,7 @@ # to return localized messages. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dgettext in -lintl" >&5 $as_echo_n "checking for dgettext in -lintl... " >&6; } -if ${ac_cv_lib_intl_dgettext+:} false; then : +if test "${ac_cv_lib_intl_dgettext+set}" = set; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13959,7 +13939,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_intl_dgettext" >&5 $as_echo "$ac_cv_lib_intl_dgettext" >&6; } -if test "x$ac_cv_lib_intl_dgettext" = xyes; then : +if test "x$ac_cv_lib_intl_dgettext" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBINTL 1 _ACEOF @@ -13971,7 +13951,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5 $as_echo_n "checking whether localtime caches TZ... " >&6; } -if ${emacs_cv_localtime_cache+:} false; then : +if test "${emacs_cv_localtime_cache+set}" = set; then : $as_echo_n "(cached) " >&6 else if test x$ac_cv_func_tzset = xyes; then @@ -14030,7 +14010,7 @@ for ac_func in gettimeofday do : ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" -if test "x$ac_cv_func_gettimeofday" = xyes; then : +if test "x$ac_cv_func_gettimeofday" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETTIMEOFDAY 1 _ACEOF @@ -14041,7 +14021,7 @@ if test $ac_cv_func_gettimeofday = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gettimeofday can accept two arguments" >&5 $as_echo_n "checking whether gettimeofday can accept two arguments... " >&6; } -if ${emacs_cv_gettimeofday_two_arguments+:} false; then : +if test "${emacs_cv_gettimeofday_two_arguments+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14085,7 +14065,7 @@ ok_so_far=yes ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket" -if test "x$ac_cv_func_socket" = xyes; then : +if test "x$ac_cv_func_socket" = x""yes; then : else ok_so_far=no @@ -14093,7 +14073,7 @@ if test $ok_so_far = yes; then ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default" -if test "x$ac_cv_header_netinet_in_h" = xyes; then : +if test "x$ac_cv_header_netinet_in_h" = x""yes; then : else ok_so_far=no @@ -14103,7 +14083,7 @@ fi if test $ok_so_far = yes; then ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default" -if test "x$ac_cv_header_arpa_inet_h" = xyes; then : +if test "x$ac_cv_header_arpa_inet_h" = x""yes; then : else ok_so_far=no @@ -14120,7 +14100,7 @@ for ac_header in sys/ioctl.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_ioctl_h" = xyes; then : +if test "x$ac_cv_header_sys_ioctl_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_IOCTL_H 1 _ACEOF @@ -14150,7 +14130,7 @@ fi ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default" -if test "x$ac_cv_type_pid_t" = xyes; then : +if test "x$ac_cv_type_pid_t" = x""yes; then : else @@ -14163,7 +14143,7 @@ for ac_header in vfork.h do : ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default" -if test "x$ac_cv_header_vfork_h" = xyes; then : +if test "x$ac_cv_header_vfork_h" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_VFORK_H 1 _ACEOF @@ -14187,7 +14167,7 @@ if test "x$ac_cv_func_fork" = xyes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5 $as_echo_n "checking for working fork... " >&6; } -if ${ac_cv_func_fork_works+:} false; then : +if test "${ac_cv_func_fork_works+set}" = set; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -14240,7 +14220,7 @@ if test "x$ac_cv_func_vfork" = xyes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5 $as_echo_n "checking for working vfork... " >&6; } -if ${ac_cv_func_vfork_works+:} false; then : +if test "${ac_cv_func_vfork_works+set}" = set; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -14376,7 +14356,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5 $as_echo_n "checking for nl_langinfo and CODESET... " >&6; } -if ${emacs_cv_langinfo_codeset+:} false; then : +if test "${emacs_cv_langinfo_codeset+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14408,7 +14388,7 @@ fi ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" -if test "x$ac_cv_type_size_t" = xyes; then : +if test "x$ac_cv_type_size_t" = x""yes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SIZE_T 1 @@ -14420,7 +14400,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5 $as_echo_n "checking for mbstate_t... " >&6; } -if ${ac_cv_type_mbstate_t+:} false; then : +if test "${ac_cv_type_mbstate_t+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14456,7 +14436,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restrict keyword" >&5 $as_echo_n "checking for C restrict keyword... " >&6; } -if ${emacs_cv_c_restrict+:} false; then : +if test "${emacs_cv_c_restrict+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14510,7 +14490,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restricted array declarations" >&5 $as_echo_n "checking for C restricted array declarations... " >&6; } -if ${emacs_cv_c_restrict_arr+:} false; then : +if test "${emacs_cv_c_restrict_arr+set}" = set; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14550,7 +14530,7 @@ && test x"`$CC --version 2> /dev/null | grep 'gcc.* 4.5.0'`" != x \ && test x"`echo $CFLAGS | grep '\-O[23]'`" != x \ && test x"`echo $CFLAGS | grep '\-fno-optimize-sibling-calls'`" = x; then - as_fn_error "GCC 4.5.0 has problems compiling Emacs; see etc/PROBLEMS'." "$LINENO" 5 + as_fn_error $? "GCC 4.5.0 has problems compiling Emacs; see etc/PROBLEMS'." "$LINENO" 5 fi #### Find out which version of Emacs this is. @@ -15019,11 +14999,6 @@ echo fi -if test "$HAVE_DBUS" = yes && test "${opsys}" != "gnu-linux"; then - echo "D-Bus integration has been tested for GNU/Linux only." - echo -fi - # Remove any trailing slashes in these variables. test "${prefix}" != NONE && @@ -15099,21 +15074,10 @@ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then - if test "x$cache_file" != "x/dev/null"; then + test "x$cache_file" != "x/dev/null" && { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} - if test ! -f "$cache_file" || test -h "$cache_file"; then - cat confcache >"$cache_file" - else - case $cache_file in #( - */* | ?:*) - mv -f confcache "$cache_file"$$ && - mv -f "$cache_file"$$ "$cache_file" ;; #( - *) - mv -f confcache "$cache_file" ;; - esac - fi - fi + cat confcache >$cache_file else { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} @@ -15146,7 +15110,7 @@ -: "${CONFIG_STATUS=./config.status}" +: ${CONFIG_STATUS=./config.status} ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" @@ -15247,7 +15211,6 @@ IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. -as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -15555,7 +15518,7 @@ # values after options handling. ac_log=" This file was extended by emacs $as_me 24.0.50, which was -generated by GNU Autoconf 2.68. Invocation command line was +generated by GNU Autoconf 2.67. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -15621,7 +15584,7 @@ ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ emacs config.status 24.0.50 -configured by $0, generated by GNU Autoconf 2.68, +configured by $0, generated by GNU Autoconf 2.67, with options \\"\$ac_cs_config\\" Copyright (C) 2010 Free Software Foundation, Inc. @@ -15761,7 +15724,7 @@ "leim/Makefile") CONFIG_FILES="$CONFIG_FILES leim/Makefile" ;; "default") CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;; esac done @@ -15784,10 +15747,9 @@ # after its creation but before its name has been assigned to `$tmp'. $debug || { - tmp= ac_tmp= + tmp= trap 'exit_status=$? - : "${ac_tmp:=$tmp}" - { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status + { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } @@ -15795,13 +15757,12 @@ { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -d "$tmp" + test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 -ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. @@ -15840,13 +15801,13 @@ ac_cs_awk_cr=$ac_cr fi -echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +echo 'BEGIN {' >"$tmp/subs1.awk" && _ACEOF # Create commands to substitute file output variables. { echo "cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1" && - echo 'cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&' && + echo 'cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&' && echo "$ac_subst_files" | sed 's/.*/F["&"]="$&"/' && echo "_ACAWK" && echo "_ACEOF" @@ -15879,7 +15840,7 @@ rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +cat >>"\$tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h @@ -15927,7 +15888,7 @@ rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK -cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && +cat >>"\$tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" \$ac_cs_awk_pipe_init @@ -15965,7 +15926,7 @@ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat -fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ +fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF @@ -15999,7 +15960,7 @@ # No need to generate them if there are no CONFIG_HEADERS. # This happens for instance with `./config.status Makefile'. if test -n "$CONFIG_HEADERS"; then -cat >"$ac_tmp/defines.awk" <<\_ACAWK || +cat >"$tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF @@ -16011,8 +15972,8 @@ # handling of long lines. ac_delim='%!_!# ' for ac_last_try in false false :; do - ac_tt=`sed -n "/$ac_delim/p" confdefs.h` - if test -z "$ac_tt"; then + ac_t=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_t"; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 @@ -16113,7 +16074,7 @@ esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5 ;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac @@ -16132,7 +16093,7 @@ for ac_f do case $ac_f in - -) ac_f="$ac_tmp/stdin";; + -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. @@ -16141,7 +16102,7 @@ [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5 ;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" @@ -16167,8 +16128,8 @@ esac case $ac_tag in - *:-:* | *:-) cat >"$ac_tmp/stdin" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + *:-:* | *:-) cat >"$tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac @@ -16300,25 +16261,24 @@ " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | if $ac_cs_awk_getline; then - $AWK -f "$ac_tmp/subs.awk" -else - $AWK -f "$ac_tmp/subs.awk" | $SHELL -fi \ - >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + $AWK -f "$tmp/subs.awk" +else + $AWK -f "$tmp/subs.awk" | $SHELL +fi >$tmp/out \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ - "$ac_tmp/out"`; test -z "$ac_out"; } && + { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} - rm -f "$ac_tmp/stdin" + rm -f "$tmp/stdin" case $ac_file in - -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; - *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + -) cat "$tmp/out" && rm -f "$tmp/out";; + *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; @@ -16329,20 +16289,20 @@ if test x"$ac_file" != x-; then { $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" - } >"$ac_tmp/config.h" \ + && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" + } >"$tmp/config.h" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 $as_echo "$as_me: $ac_file is unchanged" >&6;} else rm -f "$ac_file" - mv "$ac_tmp/config.h" "$ac_file" \ + mv "$tmp/config.h" "$ac_file" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 fi else $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \ || as_fn_error $? "could not create -" "$LINENO" 5 fi ;;
--- a/configure.in Mon Nov 08 14:19:54 2010 +0900 +++ b/configure.in Wed Nov 17 13:09:08 2010 +0900 @@ -1218,10 +1218,10 @@ fi dnl checks for header files -AC_CHECK_HEADERS(sys/select.h sys/timeb.h sys/time.h unistd.h utime.h \ - linux/version.h sys/systeminfo.h termios.h limits.h string.h stdlib.h \ - stdio_ext.h fcntl.h strings.h coff.h pty.h sys/mman.h \ - sys/param.h sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \ +AC_CHECK_HEADERS(sys/select.h sys/time.h unistd.h utime.h \ + linux/version.h sys/systeminfo.h limits.h \ + stdio_ext.h fcntl.h coff.h pty.h sys/mman.h \ + sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h \ sys/utsname.h pwd.h utmp.h dirent.h util.h) AC_MSG_CHECKING(if personality LINUX32 can be set) @@ -3737,11 +3737,6 @@ echo fi -if test "$HAVE_DBUS" = yes && test "${opsys}" != "gnu-linux"; then - echo "D-Bus integration has been tested for GNU/Linux only." - echo -fi - # Remove any trailing slashes in these variables. [test "${prefix}" != NONE &&
--- a/doc/emacs/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/emacs/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,27 @@ +2010-11-13 Eli Zaretskii <eliz@gnu.org> + + * rmail.texi (Rmail Coding): Characters with no fonts are not + necessarily displayed as empty boxes. + + * mule.texi (Language Environments, Fontsets): Characters with no + fonts are not necessarily displayed as empty boxes. + + * display.texi (Text Display): Document display of glyphless + characters. + +2010-11-13 Glenn Morris <rgm@gnu.org> + + * basic.texi (Position Info): Add M-x count-words-region. + +2010-11-11 Glenn Morris <rgm@gnu.org> + + * msdog.texi (ls in Lisp): Update for ls-lisp changes. + +2010-11-09 Eli Zaretskii <eliz@gnu.org> + + * msdog.texi (Windows HOME): Add information regarding startup + directory when invoking Emacs from a desktop shortcut. (bug#7300) + 2010-10-11 Glenn Morris <rgm@gnu.org> * Makefile.in (MAKEINFO): Add explicit -I$srcdir.
--- a/doc/emacs/basic.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/emacs/basic.texi Wed Nov 17 13:09:08 2010 +0900 @@ -537,6 +537,8 @@ Display the number of lines in the current region. Normally bound to @kbd{M-=}, except in a few specialist modes. @xref{Mark}, for information about the region. +@item M-x count-words-region +Display the number of words in the current region. @item C-x = Display the character code of character after point, character position of point, and column of point (@code{what-cursor-position}). @@ -743,6 +745,3 @@ z z z}. The first @kbd{C-x z} repeats the command once, and each subsequent @kbd{z} repeats it once again. -@ignore - arch-tag: cda8952a-c439-41c1-aecf-4bc0d6482956 -@end ignore
--- a/doc/emacs/display.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/emacs/display.texi Wed Nov 17 13:09:08 2010 +0900 @@ -1136,6 +1136,48 @@ by means of a display table. @xref{Display Tables,, Display Tables, elisp, The Emacs Lisp Reference Manual}. +@cindex glyphless characters +@cindex characters with no font glyphs + On graphics displays, some characters could have no glyphs in any of +the fonts available to Emacs. On text terminals, some characters +could be impossible to encode with the terminal coding system +(@pxref{Terminal Coding}). Emacs can display such @dfn{glyphless} +characters using one of the following methods: + +@table @code +@item zero-width +Don't display the character. + +@item thin-space +Display a thin space, 1-pixel wide on graphics displays or 1-character +wide on text terminals. + +@item empty-box +Display an empty box. + +@item acronym +Display the acronym of the character's name (such as @sc{zwnj} or +@sc{rlm}) in a box. + +@item hex-code +Display the Unicode codepoint of the character in hexadecimal +notation, in a box. +@end table + +@noindent +@cindex @code{glyphless-char} face +With the exception of @code{zero-width}, all other methods draw these +characters in a special face @code{glyphless-char}, which you can +customize. + +@vindex glyphless-char-display-control +@vindex char-acronym-table +To control what glyphless characters are displayed using which method, +customize the variable @code{glyphless-char-display-control}; see its +doc string for the details. For even finer control, set the elements +of 2 char-tables: @code{glyphless-char-display} and +@code{char-acronym-table}. + @node Cursor Display @section Displaying the Cursor
--- a/doc/emacs/msdog.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/emacs/msdog.texi Wed Nov 17 13:09:08 2010 +0900 @@ -31,7 +31,8 @@ * Text and Binary:: Text files use CRLF to terminate lines. * Windows Files:: File-name conventions on Windows. * ls in Lisp:: Emulation of @code{ls} for Dired. -* Windows HOME:: Where Emacs looks for your @file{.emacs}. +* Windows HOME:: Where Emacs looks for your @file{.emacs} and + where it starts up. * Windows Keyboard:: Windows-specific keyboard features. * Windows Mouse:: Windows-specific mouse features. * Windows Processes:: Running subprocesses on Windows. @@ -284,11 +285,12 @@ @end table @noindent -Any other value of @code{ls-lisp-emulation} means the same as -@code{GNU}. Note that this option needs to be set @emph{before} -@file{ls-lisp.el} is loaded, which means that on MS-Windows and MS-DOS -you will have to set the value from your @file{.emacs} file and then -restart Emacs, since @file{ls-lisp.el} is preloaded. +Any other value of @code{ls-lisp-emulation} means the same as @code{GNU}. +Customizing this option calls the function @code{ls-lisp-set-options} to +update the 3 dependent options as needed. If you change the value of +this variable without using customize after @file{ls-lisp.el} is loaded +(note that it is preloaded on MS-Windows and MS-DOS), you can call that +function manually for the same result. @vindex ls-lisp-support-shell-wildcards The variable @code{ls-lisp-support-shell-wildcards} controls how @@ -329,7 +331,7 @@ @end ifnottex @node Windows HOME -@section HOME Directory on MS-Windows +@section HOME and Startup Directories on MS-Windows @cindex @code{HOME} directory on MS-Windows The Windows equivalent of the @code{HOME} directory is the @@ -371,6 +373,13 @@ @file{_emacs} as a fallback, if such a file exists in the home directory, whereas @file{.emacs} does not. +@cindex start directory, MS-Windows +@cindex directory where Emacs starts on MS-Windows + If you use a Windows desktop shortcut to start Emacs, it starts in +the directory specified by the shortcut. To control where that is, +right-click on the shortcut, select ``Properties'', and in the +``Shortcut'' tab modify the ``Start in'' field to your liking. + @node Windows Keyboard @section Keyboard Usage on MS-Windows @cindex keyboard, MS-Windows @@ -917,6 +926,3 @@ @include msdog-xtra.texi @end ifnottex -@ignore - arch-tag: f39d2590-5dcc-4318-88d9-0eb73ca10fa2 -@end ignore
--- a/doc/emacs/mule.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/emacs/mule.texi Wed Nov 17 13:09:08 2010 +0900 @@ -351,10 +351,11 @@ @cindex Intlfonts package, installation To display the script(s) used by your language environment on a graphical display, you need to have a suitable font. If some of the -characters appear as empty boxes, you should install the GNU Intlfonts -package, which includes fonts for most supported scripts.@footnote{If -you run Emacs on X, you need to inform the X server about the location -of the newly installed fonts with the following commands: +characters appear as empty boxes or hex codes, you should install the +GNU Intlfonts package, which includes fonts for most supported +scripts.@footnote{If you run Emacs on X, you need to inform the X +server about the location of the newly installed fonts with the +following commands: @example xset fp+ /usr/local/share/emacs/fonts @@ -1314,10 +1315,11 @@ explicitly requested, despite its name. A fontset does not necessarily specify a font for every character -code. If a fontset specifies no font for a certain character, or if it -specifies a font that does not exist on your system, then it cannot -display that character properly. It will display that character as an -empty box instead. +code. If a fontset specifies no font for a certain character, or if +it specifies a font that does not exist on your system, then it cannot +display that character properly. It will display that character as a +hex code or thin space or an empty box instead. (@xref{Text Display, , +glyphless characters}, for details.) @node Defining Fontsets @section Defining fontsets
--- a/doc/emacs/rmail.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/emacs/rmail.texi Wed Nov 17 13:09:08 2010 +0900 @@ -1192,7 +1192,8 @@ example, a misconfigured mailer could send a message with a @samp{charset=iso-8859-1} header when the message is actually encoded in @code{koi8-r}. When you see the message text garbled, or some of -its characters displayed as empty boxes, this may have happened. +its characters displayed as hex codes or empty boxes, this may have +happened. @findex rmail-redecode-body You can correct the problem by decoding the message again using the
--- a/doc/lispintro/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/lispintro/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,8 @@ +2010-11-13 Glenn Morris <rgm@gnu.org> + + * emacs-lisp-intro.texi: Rename the `count-words-region' example, + since there is now a standard command of that name. + 2010-10-11 Glenn Morris <rgm@gnu.org> * Makefile.in (.dvi.ps): Remove unnecessary suffix rule.
--- a/doc/lispintro/emacs-lisp-intro.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/lispintro/emacs-lisp-intro.texi Wed Nov 17 13:09:08 2010 +0900 @@ -704,23 +704,25 @@ * fwd-para while:: The forward motion @code{while} loop. Counting: Repetition and Regexps +@set COUNT-WORDS count-words-example +@c Length of variable name chosen so that things still line up when expanded. * Why Count Words:: -* count-words-region:: Use a regexp, but find a problem. +* @value{COUNT-WORDS}:: Use a regexp, but find a problem. * recursive-count-words:: Start with case of no words in region. * Counting Exercise:: -The @code{count-words-region} Function - -* Design count-words-region:: The definition using a @code{while} loop. -* Whitespace Bug:: The Whitespace Bug in @code{count-words-region}. +The @code{@value{COUNT-WORDS}} Function + +* Design @value{COUNT-WORDS}:: The definition using a @code{while} loop. +* Whitespace Bug:: The Whitespace Bug in @code{@value{COUNT-WORDS}}. Counting Words in a @code{defun} * Divide and Conquer:: * Words and Symbols:: What to count? * Syntax:: What constitutes a word or symbol? -* count-words-in-defun:: Very like @code{count-words}. +* count-words-in-defun:: Very like @code{@value{COUNT-WORDS}}. * Several defuns:: Counting several defuns in a file. * Find a File:: Do you want to look at a file? * lengths-list-file:: A list of the lengths of many definitions. @@ -13829,35 +13831,37 @@ @menu * Why Count Words:: -* count-words-region:: Use a regexp, but find a problem. +* @value{COUNT-WORDS}:: Use a regexp, but find a problem. * recursive-count-words:: Start with case of no words in region. * Counting Exercise:: @end menu -@node Why Count Words, count-words-region, Counting Words, Counting Words +@node Why Count Words, @value{COUNT-WORDS}, Counting Words, Counting Words @ifnottex @unnumberedsec Counting words @end ifnottex -The standard Emacs distribution contains a function for counting the -number of lines within a region. However, there is no corresponding -function for counting words. +The standard Emacs distribution contains functions for counting the +number of lines and words within a region. Certain types of writing ask you to count words. Thus, if you write an essay, you may be limited to 800 words; if you write a novel, you -may discipline yourself to write 1000 words a day. It seems odd to me -that Emacs lacks a word count command. Perhaps people use Emacs -mostly for code or types of documentation that do not require word -counts; or perhaps they restrict themselves to the operating system -word count command, @code{wc}. Alternatively, people may follow -the publishers' convention and compute a word count by dividing the -number of characters in a document by five. In any event, here are -commands to count words. - -@node count-words-region, recursive-count-words, Why Count Words, Counting Words -@comment node-name, next, previous, up -@section The @code{count-words-region} Function -@findex count-words-region +may discipline yourself to write 1000 words a day. It seems odd, but +for a long time, Emacs lacked a word count command. Perhaps people used +Emacs mostly for code or types of documentation that did not require +word counts; or perhaps they restricted themselves to the operating +system word count command, @code{wc}. Alternatively, people may have +followed the publishers' convention and computed a word count by +dividing the number of characters in a document by five. + +There are many ways to implement a command to count words. Here are +some examples, which you may wish to compare with the standard Emacs +command, @code{count-words-region}. + +@node @value{COUNT-WORDS}, recursive-count-words, Why Count Words, Counting Words +@comment node-name, next, previous, up +@section The @code{@value{COUNT-WORDS}} Function +@findex @value{COUNT-WORDS} A word count command could count words in a line, paragraph, region, or buffer. What should the command cover? You could design the @@ -13865,7 +13869,7 @@ the Emacs tradition encourages flexibility---you may want to count words in just a section, rather than all of a buffer. So it makes more sense to design the command to count the number of words in a -region. Once you have a @code{count-words-region} command, you can, +region. Once you have a command to count words in a region, you can, if you wish, count words in a whole buffer by marking it with @w{@kbd{C-x h}} (@code{mark-whole-buffer}). @@ -13876,13 +13880,13 @@ or to a @code{while} loop. @menu -* Design count-words-region:: The definition using a @code{while} loop. -* Whitespace Bug:: The Whitespace Bug in @code{count-words-region}. -@end menu - -@node Design count-words-region, Whitespace Bug, count-words-region, count-words-region -@ifnottex -@unnumberedsubsec Designing @code{count-words-region} +* Design @value{COUNT-WORDS}:: The definition using a @code{while} loop. +* Whitespace Bug:: The Whitespace Bug in @code{@value{COUNT-WORDS}}. +@end menu + +@node Design @value{COUNT-WORDS}, Whitespace Bug, @value{COUNT-WORDS}, @value{COUNT-WORDS} +@ifnottex +@unnumberedsubsec Designing @code{@value{COUNT-WORDS}} @end ifnottex First, we will implement the word count command with a @code{while} @@ -13905,7 +13909,9 @@ The name of the function should be self-explanatory and similar to the existing @code{count-lines-region} name. This makes the name easier -to remember. @code{count-words-region} is a good choice. +to remember. @code{count-words-region} is the obvious choice. Since +that name is now used for the standard Emacs command to count words, we +will name our implementation @code{@value{COUNT-WORDS}}. The function counts words within a region. This means that the argument list must contain symbols that are bound to the two @@ -13923,7 +13929,7 @@ count words, second, to run the @code{while} loop, and third, to send a message to the user. -When a user calls @code{count-words-region}, point may be at the +When a user calls @code{@value{COUNT-WORDS}}, point may be at the beginning or the end of the region. However, the counting process must start at the beginning of the region. This means we will want to put point there if it is not already there. Executing @@ -14015,7 +14021,7 @@ @smallexample @group ;;; @r{First version; has bugs!} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region. Words are defined as at least one word-constituent character followed by at least one character that @@ -14056,14 +14062,14 @@ @noindent As written, the function works, but not in all circumstances. -@node Whitespace Bug, , Design count-words-region, count-words-region -@comment node-name, next, previous, up -@subsection The Whitespace Bug in @code{count-words-region} - -The @code{count-words-region} command described in the preceding +@node Whitespace Bug, , Design @value{COUNT-WORDS}, @value{COUNT-WORDS} +@comment node-name, next, previous, up +@subsection The Whitespace Bug in @code{@value{COUNT-WORDS}} + +The @code{@value{COUNT-WORDS}} command described in the preceding section has two bugs, or rather, one bug with two manifestations. First, if you mark a region containing only whitespace in the middle -of some text, the @code{count-words-region} command tells you that the +of some text, the @code{@value{COUNT-WORDS}} command tells you that the region contains one word! Second, if you mark a region containing only whitespace at the end of the buffer or the accessible portion of a narrowed buffer, the command displays an error message that looks @@ -14084,7 +14090,7 @@ @smallexample @group ;; @r{First version; has bugs!} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region. Words are defined as at least one word-constituent character followed by at least one character that is not a word-constituent. The buffer's @@ -14123,12 +14129,12 @@ If you wish, you can also install this keybinding by evaluating it: @smallexample -(global-set-key "\C-c=" 'count-words-region) +(global-set-key "\C-c=" '@value{COUNT-WORDS}) @end smallexample To conduct the first test, set mark and point to the beginning and end of the following line and then type @kbd{C-c =} (or @kbd{M-x -count-words-region} if you have not bound @kbd{C-c =}): +@value{COUNT-WORDS}} if you have not bound @kbd{C-c =}): @smallexample one two three @@ -14139,7 +14145,7 @@ Repeat the test, but place mark at the beginning of the line and place point just @emph{before} the word @samp{one}. Again type the command -@kbd{C-c =} (or @kbd{M-x count-words-region}). Emacs should tell you +@kbd{C-c =} (or @kbd{M-x @value{COUNT-WORDS}}). Emacs should tell you that the region has no words, since it is composed only of the whitespace at the beginning of the line. But instead Emacs tells you that the region has one word! @@ -14148,7 +14154,7 @@ @file{*scratch*} buffer and then type several spaces at the end of the line. Place mark right after the word @samp{three} and point at the end of line. (The end of the line will be the end of the buffer.) -Type @kbd{C-c =} (or @kbd{M-x count-words-region}) as you did before. +Type @kbd{C-c =} (or @kbd{M-x @value{COUNT-WORDS}}) as you did before. Again, Emacs should tell you that the region has no words, since it is composed only of the whitespace at the end of the line. Instead, Emacs displays an error message saying @samp{Search failed}. @@ -14157,7 +14163,7 @@ Consider the first manifestation of the bug, in which the command tells you that the whitespace at the beginning of the line contains -one word. What happens is this: The @code{M-x count-words-region} +one word. What happens is this: The @code{M-x @value{COUNT-WORDS}} command moves point to the beginning of the region. The @code{while} tests whether the value of point is smaller than the value of @code{end}, which it is. Consequently, the regular expression search @@ -14191,7 +14197,7 @@ repeat count. (In Emacs, you can see a function's documentation by typing @kbd{C-h f}, the name of the function, and then @key{RET}.) -In the @code{count-words-region} definition, the value of the end of +In the @code{@value{COUNT-WORDS}} definition, the value of the end of the region is held by the variable @code{end} which is passed as an argument to the function. Thus, we can add @code{end} as an argument to the regular expression search expression: @@ -14200,7 +14206,7 @@ (re-search-forward "\\w+\\W*" end) @end smallexample -However, if you make only this change to the @code{count-words-region} +However, if you make only this change to the @code{@value{COUNT-WORDS}} definition and then test the new version of the definition on a stretch of whitespace, you will receive an error message saying @samp{Search failed}. @@ -14231,7 +14237,7 @@ than the value of end, since the @code{re-search-forward} expression did not move point. @dots{} and the cycle repeats @dots{} -The @code{count-words-region} definition requires yet another +The @code{@value{COUNT-WORDS}} definition requires yet another modification, to cause the true-or-false-test of the @code{while} loop to test false if the search fails. Put another way, there are two conditions that must be satisfied in the true-or-false-test before the @@ -14265,17 +14271,17 @@ found, point is moved through the region. When the search expression fails to find another word, or when point reaches the end of the region, the true-or-false-test tests false, the @code{while} loop -exits, and the @code{count-words-region} function displays one or +exits, and the @code{@value{COUNT-WORDS}} function displays one or other of its messages. -After incorporating these final changes, the @code{count-words-region} +After incorporating these final changes, the @code{@value{COUNT-WORDS}} works without bugs (or at least, without bugs that I have found!). Here is what it looks like: @smallexample @group ;;; @r{Final version:} @code{while} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region." (interactive "r") (message "Counting words in region ... ") @@ -14309,7 +14315,7 @@ @end group @end smallexample -@node recursive-count-words, Counting Exercise, count-words-region, Counting Words +@node recursive-count-words, Counting Exercise, @value{COUNT-WORDS}, Counting Words @comment node-name, next, previous, up @section Count Words Recursively @cindex Count words recursively @@ -14319,7 +14325,7 @@ You can write the function for counting words recursively as well as with a @code{while} loop. Let's see how this is done. -First, we need to recognize that the @code{count-words-region} +First, we need to recognize that the @code{@value{COUNT-WORDS}} function has three jobs: it sets up the appropriate conditions for counting to occur; it counts the words in the region; and it sends a message to the user telling how many words there are. @@ -14333,7 +14339,7 @@ message; the other will return the word count. Let us start with the function that causes the message to be displayed. -We can continue to call this @code{count-words-region}. +We can continue to call this @code{@value{COUNT-WORDS}}. This is the function that the user will call. It will be interactive. Indeed, it will be similar to our previous versions of this @@ -14347,7 +14353,7 @@ @smallexample @group ;; @r{Recursive version; uses regular expression search} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "@var{documentation}@dots{}" (@var{interactive-expression}@dots{}) @end group @@ -14388,7 +14394,7 @@ @smallexample @group -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region." (interactive "r") @end group @@ -14484,7 +14490,7 @@ Note that the search expression is part of the do-again-test---the function returns @code{t} if its search succeeds and @code{nil} if it fails. (@xref{Whitespace Bug, , The Whitespace Bug in -@code{count-words-region}}, for an explanation of how +@code{@value{COUNT-WORDS}}}, for an explanation of how @code{re-search-forward} works.) The do-again-test is the true-or-false test of an @code{if} clause. @@ -14657,7 +14663,7 @@ @smallexample @group ;;; @r{Recursive version} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region. @end group @@ -14702,11 +14708,11 @@ Our next project is to count the number of words in a function definition. Clearly, this can be done using some variant of -@code{count-word-region}. @xref{Counting Words, , Counting Words: +@code{@value{COUNT-WORDS}}. @xref{Counting Words, , Counting Words: Repetition and Regexps}. If we are just going to count the words in one definition, it is easy enough to mark the definition with the @kbd{C-M-h} (@code{mark-defun}) command, and then call -@code{count-word-region}. +@code{@value{COUNT-WORDS}}. However, I am more ambitious: I want to count the words and symbols in every definition in the Emacs sources and then print a graph that @@ -14719,7 +14725,7 @@ * Divide and Conquer:: * Words and Symbols:: What to count? * Syntax:: What constitutes a word or symbol? -* count-words-in-defun:: Very like @code{count-words}. +* count-words-in-defun:: Very like @code{@value{COUNT-WORDS}}. * Several defuns:: Counting several defuns in a file. * Find a File:: Do you want to look at a file? * lengths-list-file:: A list of the lengths of many definitions. @@ -14793,11 +14799,11 @@ @noindent However, if we mark the @code{multiply-by-seven} definition with @kbd{C-M-h} (@code{mark-defun}), and then call -@code{count-words-region} on it, we will find that -@code{count-words-region} claims the definition has eleven words, not +@code{@value{COUNT-WORDS}} on it, we will find that +@code{@value{COUNT-WORDS}} claims the definition has eleven words, not ten! Something is wrong! -The problem is twofold: @code{count-words-region} does not count the +The problem is twofold: @code{@value{COUNT-WORDS}} does not count the @samp{*} as a word, and it counts the single symbol, @code{multiply-by-seven}, as containing three words. The hyphens are treated as if they were interword spaces rather than intraword @@ -14805,8 +14811,8 @@ @samp{multiply by seven}. The cause of this confusion is the regular expression search within -the @code{count-words-region} definition that moves point forward word -by word. In the canonical version of @code{count-words-region}, the +the @code{@value{COUNT-WORDS}} definition that moves point forward word +by word. In the canonical version of @code{@value{COUNT-WORDS}}, the regexp is: @smallexample @@ -14839,8 +14845,8 @@ Usually, a hyphen is not specified as a `word constituent character'. Instead, it is specified as being in the `class of characters that are part of symbol names but not words.' This means that the -@code{count-words-region} function treats it in the same way it treats -an interword white space, which is why @code{count-words-region} +@code{@value{COUNT-WORDS}} function treats it in the same way it treats +an interword white space, which is why @code{@value{COUNT-WORDS}} counts @samp{multiply-by-seven} as three words. There are two ways to cause Emacs to count @samp{multiply-by-seven} as @@ -14853,7 +14859,7 @@ constituent character; there are others, too. Alternatively, we can redefine the regular expression used in the -@code{count-words} definition so as to include symbols. This +@code{@value{COUNT-WORDS}} definition so as to include symbols. This procedure has the merit of clarity, but the task is a little tricky. @need 1200 @@ -14910,7 +14916,7 @@ @cindex Counting words in a @code{defun} We have seen that there are several ways to write a -@code{count-word-region} function. To write a +@code{count-words-region} function. To write a @code{count-words-in-defun}, we need merely adapt one of these versions. @@ -15044,7 +15050,7 @@ How to test this? The function is not interactive, but it is easy to put a wrapper around the function to make it interactive; we can use almost the same code as for the recursive version of -@code{count-words-region}: +@code{@value{COUNT-WORDS}}: @smallexample @group @@ -18885,7 +18891,7 @@ @itemize @bullet @item -Install the @code{count-words-region} function and then cause it to +Install the @code{@value{COUNT-WORDS}} function and then cause it to enter the built-in debugger when you call it. Run the command on a region containing two words. You will need to press @kbd{d} a remarkable number of times. On your system, is a `hook' called after @@ -18894,7 +18900,7 @@ Manual}.) @item -Copy @code{count-words-region} into the @file{*scratch*} buffer, +Copy @code{@value{COUNT-WORDS}} into the @file{*scratch*} buffer, instrument the function for Edebug, and walk through its execution. The function does not need to have a bug, although you can introduce one if you wish. If the function lacks a bug, the walk-through @@ -18909,7 +18915,7 @@ @item In the Edebug debugging buffer, use the @kbd{p} (@code{edebug-bounce-point}) command to see where in the region the -@code{count-words-region} is working. +@code{@value{COUNT-WORDS}} is working. @item Move point to some spot further down the function and then type the @@ -22272,6 +22278,3 @@ @bye -@ignore - arch-tag: da1a2154-531f-43a8-8e33-fc7faad10acf -@end ignore
--- a/doc/lispref/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/lispref/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,8 @@ +2010-11-13 Eli Zaretskii <eliz@gnu.org> + + * display.texi (Usual Display): Characters with no fonts are not + necessarily displayed as empty boxes. + 2010-10-31 Glenn Morris <rgm@gnu.org> * maps.texi (Standard Keymaps): Update File menu description.
--- a/doc/lispref/display.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/lispref/display.texi Wed Nov 17 13:09:08 2010 +0900 @@ -5579,9 +5579,9 @@ table can specify a glyph to use instead of @samp{\}.) @item -Multibyte character codes above 256 are displayed as themselves, or as a -question mark or empty box if the terminal cannot display that -character. +Multibyte character codes above 256 are displayed as themselves, or as +a question mark or a hex code or an empty box if the terminal cannot +display that character. @end itemize The usual display conventions apply even when there is a display
--- a/doc/misc/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/misc/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,147 @@ +2010-11-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (Article Washing): Fix typo. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org.texi: Fix typo. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Using capture): Explain that refiling is + sensitive to cursor position. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Images and tables): Add cross reference to link section. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi: Document the <c> cookie. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi: multi-line header arguments :PROPERTIES: :ID: + b77c8857-6c76-4ea9-8a61-ddc2648d96c4 :END:. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (CSS support): Document :HTML_CONTAINER_CLASS: property. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Project alist): Mention that this is a property list. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Setting up the staging area): Document that + file names remain visible when encrypting the MobileOrg files. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Setting up the staging area): Document which + versions are needed for encryption. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi (noweb): Update :noweb documentation to + reflect the new "tangle" argument. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi (Batch execution): Improve tangling script in + documentation. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Handling links): + (In-buffer settings): Document inlining images on startup. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Setting up the staging area): Document use of + crypt password. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.texi (Template expansion): Add date related link type escapes. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.texi (Template expansion): Add mew in table for link type + escapes. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.texi (Template expansion): Fix typo in link type escapes. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi (Structure of code blocks): Another documentation tweak. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi (Structure of code blocks): Documentation tweak. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi (Structure of code blocks): + Update documentation to mention inline code block syntax. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi (comments): Improve wording. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.texi (comments): Document the new :comments header arguments. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Installation): Remove the special + installation instructions for XEmacs. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.texi (Easy Templates): New section. Documents quick + insertion of empty structural elements. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org.texi: Fix doc. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.texi (The date/time prompt): Document specification + of time ranges. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Internal links): Document the changes in + internal links. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.texi (Agenda commands): Document the limitation for + the filter preset - it can only be used for an entire agenda + view, not in an individual block in a block agenda. + +2010-11-11 Eric S Fraga <e.fraga@ucl.ac.uk> + + * org.texi (iCalendar export): Document alarm creation. + +2010-11-10 Michael Albinus <michael.albinus@gmx.de> + + * dbus.texi (Type Conversion): Introduce `:unix-fd' type mapping. + +2010-11-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Article Washing): Document gnus-article-treat-non-ascii. + +2010-11-09 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi: Use emacsver.texi to determine Emacs version. + 2010-11-04 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus.texi (Customizing the IMAP Connection): Remove nnir mention,
--- a/doc/misc/dbus.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/misc/dbus.texi Wed Nov 17 13:09:08 2010 +0900 @@ -890,7 +890,8 @@ types are represented by the type symbols @code{:byte}, @code{:boolean}, @code{:int16}, @code{:uint16}, @code{:int32}, @code{:uint32}, @code{:int64}, @code{:uint64}, @code{:double}, -@code{:string}, @code{:object-path} and @code{:signature}. +@code{:string}, @code{:object-path}, @code{:signature} and +@code{:unix-fd}. @noindent Example: @@ -1009,6 +1010,7 @@ @item DBUS_TYPE_UINT16 @tab @expansion{} @tab natural number @item DBUS_TYPE_INT16 @tab @expansion{} @tab integer @item DBUS_TYPE_UINT32 @tab @expansion{} @tab natural number or float +@item DBUS_TYPE_UNIX_FD @tab @expansion{} @tab natural number or float @item DBUS_TYPE_INT32 @tab @expansion{} @tab integer or float @item DBUS_TYPE_UINT64 @tab @expansion{} @tab natural number or float @item DBUS_TYPE_INT64 @tab @expansion{} @tab integer or float @@ -1024,9 +1026,9 @@ @end example A float object in case of @code{DBUS_TYPE_UINT32}, -@code{DBUS_TYPE_INT32}, @code{DBUS_TYPE_UINT64} and -@code{DBUS_TYPE_INT6432} is returned, when the C value exceeds the -Emacs number size range. +@code{DBUS_TYPE_INT32}, @code{DBUS_TYPE_UINT64}, +@code{DBUS_TYPE_INT64} and @code{DBUS_TYPE_UNIX_FD} is returned, when +the C value exceeds the Emacs number size range. The resulting list of the last 4 D-Bus compound types contains as elements the elements of the D-Bus container, mapped according to the
--- a/doc/misc/gnus.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/misc/gnus.texi Wed Nov 17 13:09:08 2010 +0900 @@ -9664,6 +9664,17 @@ like @code{\222} or @code{\264} where you're expecting some kind of apostrophe or quotation mark, then try this wash. +@item W U +@kindex W U (Summary) +@findex gnus-article-treat-non-ascii +@cindex Unicode +@cindex Non-@acronym{ASCII} +Translate many non-@acronym{ASCII} characters into their +@acronym{ASCII} equivalents (@code{gnus-article-treat-non-ascii}). +This is mostly useful if you're on a terminal that has a limited font +and does't show accented characters, ``advanced'' punctuation, and the +like. For instance, @samp{»} is tranlated into @samp{>>}, and so on. + @item W Y f @kindex W Y f (Summary) @findex gnus-article-outlook-deuglify-article
--- a/doc/misc/org.texi Mon Nov 08 14:19:54 2010 +0900 +++ b/doc/misc/org.texi Wed Nov 17 13:09:08 2010 +0900 @@ -4,8 +4,8 @@ @setfilename ../../info/org @settitle The Org Manual -@set VERSION 7.01 -@set DATE July 2010 +@set VERSION 7.3 +@set DATE November 2010 @c Use proper quote and backtick for code sections in PDF output @c Cf. Texinfo manual 14.2 @@ -22,6 +22,24 @@ @finalout @c Macro definitions +@macro orgcmd{key,command} +@iftex +@kindex \key\ +@findex \command\ +@item @kbd{\key\} @hskip 0pt plus 1filll @code{\command\} +@end iftex +@ifnottex +@kindex \key\ +@findex \command\ +@item @kbd{\key\} @tie{}@tie{}@tie{}@tie{}(@code{\command\}) +@end ifnottex +@end macro + +@macro orgkey{key} +@kindex \key\ +@item @kbd{\key\} +@end macro + @iftex @c @hyphenation{time-stamp time-stamps time-stamp-ing time-stamp-ed} @end iftex @@ -122,6 +140,7 @@ * History and Acknowledgments:: How Org came into being * Main Index:: An index of Org's concepts and features * Key Index:: Key bindings and where they are described +* Command and Function Index:: Command names and some internal functions * Variable Index:: Variables mentioned in the manual @detailmenu @@ -244,6 +263,7 @@ * Resolving idle time:: Resolving time if you've been idle * Effort estimates:: Planning work effort in advance * Relative timer:: Notes with a running timer +* Countdown timer:: Starting a countdown timer for a task Creating timestamps @@ -364,6 +384,7 @@ * Links in HTML export:: How links will be interpreted and formatted * Tables in HTML export:: How to modify the formatting of tables * Images in HTML export:: How to insert figures into HTML output +* Math formatting in HTML export:: Beautiful math also on the web * Text areas in HTML export:: An alternative way to show an example * CSS support:: Changing the appearance of the output * JavaScript support:: Info and Folding in a web browser @@ -436,16 +457,22 @@ * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values +* Header arguments in function calls:: The most specific level Specific header arguments * var:: Pass arguments to code blocks -* results:: Specify the type of results and how they will be collected and handled +* results:: Specify the type of results and how they will + be collected and handled * file:: Specify a path for file output -* dir:: Specify the default directory for code block execution +* dir:: Specify the default (possibly remote) + directory for code block execution * exports:: Export code and/or results * tangle:: Toggle tangling and specify file name -* no-expand:: Turn off variable assignment and noweb expansion during tangling +* comments:: Toggle insertion of comments in tangled + code files +* no-expand:: Turn off variable assignment and noweb + expansion during tangling * session:: Preserve the state of code evaluation * noweb:: Toggle expansion of noweb references * cache:: Avoid re-evaluating unchanged code blocks @@ -453,10 +480,12 @@ * colnames:: Handle column names in tables * rownames:: Handle row names in tables * shebang:: Make tangled files executable +* eval:: Limit evaluation of specific code blocks Miscellaneous * Completion:: M-TAB knows what you need +* Easy Templates:: Quick insertion of structural elements * Speed keys:: Electric commands at the beginning of a headline * Code evaluation security:: Org mode files evaluate inline code * Customization:: Adapting Org to your taste @@ -608,18 +637,6 @@ (setq load-path (cons "~/path/to/orgdir/contrib/lisp" load-path)) @end example -@sp 2 -@cartouche -XEmacs users now need to install the file @file{noutline.el} from -the @file{xemacs} sub-directory of the Org distribution. Use the -command: - -@example - make install-noutline -@end example -@end cartouche -@sp 2 - @noindent Now byte-compile the Lisp files with the shell command: @example @@ -720,10 +737,15 @@ If you find problems with Org, or if you have questions, remarks, or ideas about it, please mail to the Org mailing list @email{emacs-orgmode@@gnu.org}. If you are not a member of the mailing list, your mail will be passed to the -list after a moderator has approved it. - -For bug reports, please provide as much information as possible, including -the version information of Emacs (@kbd{M-x emacs-version @key{RET}}) and Org +list after a moderator has approved it@footnote{Please consider subscribing +to the mailing list, in order to minimize the work the mailing list +moderators have to do.}. + +For bug reports, please first try to reproduce the bug with the latest +version of Org available - if you are running an outdated version, it is +quite possible that the bug has been fixed already. If the bug persists, +prepare a report and provide as much information as possible, including the +version information of Emacs (@kbd{M-x emacs-version @key{RET}}) and Org (@kbd{M-x org-version @key{RET}}), as well as the Org related setup in @file{.emacs}. The easiest way to do this is to use the command @example @@ -742,7 +764,7 @@ @item What did you expect to happen? @item What happened instead? @end enumerate -@noindent Thank you for helping to improve this mode. +@noindent Thank you for helping to improve this program. @subsubheading How to create a useful backtrace @@ -886,9 +908,8 @@ @cindex folded, subtree visibility state @cindex children, subtree visibility state @cindex subtree, subtree visibility state -@table @kbd -@kindex @key{TAB} -@item @key{TAB} +@table @asis +@orgcmd{@key{TAB},org-cycle} @emph{Subtree cycling}: Rotate current subtree among the states @example @@ -910,8 +931,7 @@ @cindex overview, global visibility state @cindex contents, global visibility state @cindex show all, global visibility state -@kindex S-@key{TAB} -@item S-@key{TAB} +@orgcmd{S-@key{TAB},org-global-cycle} @itemx C-u @key{TAB} @emph{Global cycling}: Rotate the entire buffer among the states @@ -925,22 +945,18 @@ tables, @kbd{S-@key{TAB}} jumps to the previous field. @cindex show all, command -@kindex C-u C-u C-u @key{TAB} -@item C-u C-u C-u @key{TAB} +@orgcmd{C-u C-u C-u @key{TAB},show-all} Show all, including drawers. -@kindex C-c C-r -@item C-c C-r +@orgcmd{C-c C-r,org-reveal} Reveal context around point, showing the current entry, the following heading and the hierarchy above. Useful for working near a location that has been exposed by a sparse tree command (@pxref{Sparse trees}) or an agenda command (@pxref{Agenda commands}). With a prefix argument show, on each level, all sibling headings. With double prefix arg, also show the entire subtree of the parent. -@kindex C-c C-k -@item C-c C-k +@orgcmd{C-c C-k,show-branches} Expose all the headings of the subtree, CONTENT view for just one subtree. -@kindex C-c C-x b -@item C-c C-x b +@orgcmd{C-c C-x b,org-tree-to-indirect-buffer} Show the current subtree in an indirect buffer@footnote{The indirect buffer @ifinfo @@ -982,9 +998,8 @@ and Columns}) will get their visibility adapted accordingly. Allowed values for this property are @code{folded}, @code{children}, @code{content}, and @code{all}. -@table @kbd -@kindex C-u C-u @key{TAB} -@item C-u C-u @key{TAB} +@table @asis +@orgcmd{C-u C-u @key{TAB},org-set-startup-visibility} Switch back to the startup visibility of the buffer, i.e. whatever is requested by startup options and @samp{VISIBILITY} properties in individual entries. @@ -997,24 +1012,18 @@ @cindex headline navigation The following commands jump to other headlines in the buffer. -@table @kbd -@kindex C-c C-n -@item C-c C-n +@table @asis +@orgcmd{C-c C-n,outline-next-visible-heading} Next heading. -@kindex C-c C-p -@item C-c C-p +@orgcmd{C-c C-p,outline-previous-visible-heading} Previous heading. -@kindex C-c C-f -@item C-c C-f +@orgcmd{C-c C-f,org-forward-same-level} Next heading same level. -@kindex C-c C-b -@item C-c C-b +@orgcmd{C-c C-b,org-backward-same-level} Previous heading same level. -@kindex C-c C-u -@item C-c C-u +@orgcmd{C-c C-u,outline-up-heading} Backward to higher level heading. -@kindex C-c C-j -@item C-c C-j +@orgcmd{C-c C-j,org-goto} Jump to a different place without changing the current outline visibility. Shows the document structure in a temporary buffer, where you can use the following keys to find your destination: @@ -1049,9 +1058,8 @@ @cindex sorting, of subtrees @cindex subtrees, cut and paste -@table @kbd -@kindex M-@key{RET} -@item M-@key{RET} +@table @asis +@orgcmd{M-@key{RET},org-insert-heading} @vindex org-M-RET-may-split-line Insert new heading with same level as current. If the cursor is in a plain list item, a new item is created (@pxref{Plain lists}). To force @@ -1066,62 +1074,48 @@ used at the end of a folded subtree (i.e. behind the ellipses at the end of a headline), then a headline like the current one will be inserted after the end of the subtree. -@kindex C-@key{RET} -@item C-@key{RET} +@orgcmd{C-@key{RET},org-insert-heading-respect-content} Just like @kbd{M-@key{RET}}, except when adding a new heading below the current heading, the new heading is placed after the body instead of before it. This command works from anywhere in the entry. -@kindex M-S-@key{RET} -@item M-S-@key{RET} +@orgcmd{M-S-@key{RET},org-insert-todo-heading} @vindex org-treat-insert-todo-heading-as-state-change Insert new TODO entry with same level as current heading. See also the variable @code{org-treat-insert-todo-heading-as-state-change}. -@kindex C-S-@key{RET} -@item C-S-@key{RET} +@orgcmd{C-S-@key{RET},org-insert-todo-heading-respect-content} Insert new TODO entry with same level as current heading. Like @kbd{C-@key{RET}}, the new headline will be inserted after the current subtree. -@kindex @key{TAB} -@item @key{TAB} @r{in new, empty entry} +@orgcmd{@key{TAB},org-cycle} In a new entry with no text yet, the first @key{TAB} demotes the entry to become a child of the previous one. The next @key{TAB} makes it a parent, and so on, all the way to top level. Yet another @key{TAB}, and you are back to the initial level. -@kindex M-@key{left} -@item M-@key{left} +@orgcmd{M-@key{left},org-do-promote} Promote current heading by one level. -@kindex M-@key{right} -@item M-@key{right} +@orgcmd{M-@key{right},org-do-demote} Demote current heading by one level. -@kindex M-S-@key{left} -@item M-S-@key{left} +@orgcmd{M-S-@key{left},org-promote-subtree} Promote the current subtree by one level. -@kindex M-S-@key{right} -@item M-S-@key{right} +@orgcmd{M-S-@key{right},org-demote-subtree} Demote the current subtree by one level. -@kindex M-S-@key{up} -@item M-S-@key{up} +@orgcmd{M-S-@key{up},org-move-subtree-up} Move subtree up (swap with previous subtree of same level). -@kindex M-S-@key{down} -@item M-S-@key{down} +@orgcmd{M-S-@key{down},org-move-subtree-down} Move subtree down (swap with next subtree of same level). -@kindex C-c C-x C-w -@item C-c C-x C-w +@orgcmd{C-c C-x C-w,org-cut-subtree} Kill subtree, i.e. remove it from buffer but save in kill ring. With a numeric prefix argument N, kill N sequential subtrees. -@kindex C-c C-x M-w -@item C-c C-x M-w +@orgcmd{C-c C-x M-w,org-copy-subtree} Copy subtree to kill ring. With a numeric prefix argument N, copy the N sequential subtrees. -@kindex C-c C-x C-y -@item C-c C-x C-y +@orgcmd{C-c C-x C-y,org-paste-subtree} Yank subtree from kill ring. This does modify the level of the subtree to make sure the tree fits in nicely at the yank position. The yank level can also be specified with a numeric prefix argument, or by yanking after a headline marker like @samp{****}. -@kindex C-y -@item C-y +@orgcmd{C-y,org-yank} @vindex org-yank-adjusted-subtrees @vindex org-yank-folded-subtrees Depending on the variables @code{org-yank-adjusted-subtrees} and @@ -1134,19 +1128,16 @@ force a normal yank is @kbd{C-u C-y}. If you use @code{yank-pop} after a yank, it will yank previous kill items plainly, without adjustment and folding. -@kindex C-c C-x c -@item C-c C-x c +@orgcmd{C-c C-x c,org-clone-subtree-with-time-shift} Clone a subtree by making a number of sibling copies of it. You will be prompted for the number of copies to make, and you can also specify if any timestamps in the entry should be shifted. This can be useful, for example, to create a number of tasks related to a series of lectures to prepare. For more details, see the docstring of the command @code{org-clone-subtree-with-time-shift}. -@kindex C-c C-w -@item C-c C-w +@orgcmd{C-c C-w,org-refile} Refile entry or region to a different location. @xref{Refiling notes}. -@kindex C-c ^ -@item C-c ^ +@orgcmd{C-c ^,org-sort-entries-or-items} Sort same-level entries. When there is an active region, all entries in the region will be sorted. Otherwise the children of the current headline are sorted. The command prompts for the sorting method, which can be @@ -1157,14 +1148,11 @@ your own function to extract the sorting key. With a @kbd{C-u} prefix, sorting will be case-sensitive. With two @kbd{C-u C-u} prefixes, duplicate entries will also be removed. -@kindex C-x n s -@item C-x n s +@orgcmd{C-x n s,org-narrow-to-subtree} Narrow buffer to current subtree. -@kindex C-x n w -@item C-x n w +@orgcmd{C-x n w,widen} Widen buffer to remove narrowing. -@kindex C-c * -@item C-c * +@orgcmd{C-c *,org-toggle-heading} Turn a normal line or plain list item into a headline (so that it becomes a subheading at its location). Also turn a headline into a normal line by removing the stars. If there is an active region, turn all lines in the @@ -1208,9 +1196,8 @@ Org-mode contains several commands creating such trees, all these commands can be accessed through a dispatcher: -@table @kbd -@kindex C-c / -@item C-c / +@table @asis +@orgcmd{C-c /,org-sparse-tree} This prompts for an extra key to select a sparse-tree creating command. @kindex C-c / r @item C-c / r @@ -1264,9 +1251,9 @@ @cindex ordered lists Within an entry of the outline tree, hand-formatted lists can provide -additional structure. They also provide a way to create lists of -checkboxes (@pxref{Checkboxes}). Org supports editing such lists, -and the HTML exporter (@pxref{Exporting}) parses and formats them. +additional structure. They also provide a way to create lists of checkboxes +(@pxref{Checkboxes}). Org supports editing such lists, and every exporter +(@pxref{Exporting}) can parse and format them. Org knows ordered lists, unordered lists, and description lists. @itemize @bullet @@ -1279,26 +1266,39 @@ @samp{*} is supported, it may be better to not use it for plain list items.} as bullets. @item +@vindex org-plain-list-ordered-item-terminator @emph{Ordered} list items start with a numeral followed by either a period or -a right parenthesis, such as @samp{1.} or @samp{1)}. If you want a list to -start a different value (e.g. 20), start the text of the item with -@code{[@@start:20]}. +a right parenthesis@footnote{You can filter out any of them by configuring +@code{org-plain-list-ordered-item-terminator}.}, such as @samp{1.} or +@samp{1)}. If you want a list to start a different value (e.g. 20), start +the text of the item with @code{[@@20]}@footnote{If there's a checkbox in the +item, the cookie must be put @emph{before} the checkbox.}. Those constructs +can be used in any item of the list in order to enforce a particular +numbering. @item @emph{Description} list items are unordered list items, and contain the separator @samp{ :: } to separate the description @emph{term} from the description. @end itemize -@vindex org-empty-line-terminates-plain-lists Items belonging to the same list must have the same indentation on the first line. In particular, if an ordered list reaches number @samp{10.}, then the 2--digit numbers must be written left-aligned with the other numbers in the -list. Indentation also determines the end of a list item. It ends before -the next line that is indented like the bullet/number, or less. Empty lines -are part of the previous item, so you can have several paragraphs in one -item. If you would like an empty line to terminate all currently open plain -lists, configure the variable @code{org-empty-line-terminates-plain-lists}. -Here is an example: +list. + +@vindex org-list-ending-method +@vindex org-list-end-regexp +@vindex org-empty-line-terminates-plain-lists +Two methods@footnote{To disable either of them, configure +@code{org-list-ending-method}.} are provided to terminate lists. A list ends +before the next line that is indented like the bullet/number or less, or it +ends before two blank lines@footnote{See also +@code{org-empty-line-terminates-plain-lists}.}. In both cases, all levels of +the list are closed@footnote{So you cannot have a sublist, some text and then +another sublist while still in the same top-level list item. This used to be +possible, but it was only supported in the HTML exporter and difficult to +manage with automatic indentation.}. For finer control, you can end lists +with any pattern set in @code{org-list-end-regexp}. Here is an example: @example @group @@ -1309,8 +1309,8 @@ + this was already my favorite scene in the book + I really like Miranda Otto. 3. Peter Jackson being shot by Legolas - - on DVD only He makes a really funny face when it happens. + - on DVD only But in the end, no individual scenes matter but the film as a whole. Important actors in this film are: - @b{Elijah Wood} :: He plays Frodo @@ -1325,19 +1325,23 @@ put into @file{.emacs}: @code{(require 'filladapt)}}, and by exporting them properly (@pxref{Exporting}). Since indentation is what governs the structure of these lists, many structural constructs like @code{#+BEGIN_...} -blocks can be indented to signal that they should be part of a list item. +blocks can be indented to signal that they should be considered of a list +item. @vindex org-list-demote-modify-bullet If you find that using a different bullet for a sub-list (than that used for the current list-level) improves readability, customize the variable @code{org-list-demote-modify-bullet}. -The following commands act on items when the cursor is in the first line -of an item (the line with the bullet or number). - -@table @kbd -@kindex @key{TAB} -@item @key{TAB} +@vindex org-list-automatic-rules +The following commands act on items when the cursor is in the first line of +an item (the line with the bullet or number). Some of them imply the +application of automatic rules to keep list structure in tact. If some of +these actions get in your way, configure @code{org-list-automatic-rules} +to disable them individually. + +@table @asis +@orgcmd{@key{TAB},org-cycle} @vindex org-cycle-include-plain-lists Items can be folded just like headline levels. Normally this works only if the cursor is on a plain list item. For more details, see the variable @@ -1345,31 +1349,29 @@ will be treated like low-level. The level of an item is then given by the indentation of the bullet/number. Items are always subordinate to real headlines, however; the hierarchies remain completely separated. - -If @code{org-cycle-include-plain-lists} has not been set, @key{TAB} -fixes the indentation of the current line in a heuristic way. -@kindex M-@key{RET} -@item M-@key{RET} +@orgcmd{M-@key{RET},org-insert-heading} @vindex org-M-RET-may-split-line +@vindex org-list-automatic-rules Insert new item at current level. With a prefix argument, force a new heading (@pxref{Structure editing}). If this command is used in the middle of a line, the line is @emph{split} and the rest of the line becomes the new item@footnote{If you do not want the line to be split, customize the variable -@code{org-M-RET-may-split-line}.}. If this command is executed in the -@emph{whitespace before a bullet or number}, the new item is created -@emph{before} the current item. If the command is executed in the white -space before the text that is part of an item but does not contain the -bullet, a bullet is added to the current line. +@code{org-M-RET-may-split-line}.}. If this command is executed @emph{before +item's body}, the new item is created @emph{before} the current item. If the +command is executed in the white space before the text that is part of an +item but does not contain the bullet, a bullet is added to the current line. + +As a new item cannot be inserted in a structural construct (like an example +or source code block) within a list, Org will instead insert it right before +the structure, or return an error. @kindex M-S-@key{RET} @item M-S-@key{RET} Insert a new item with a checkbox (@pxref{Checkboxes}). -@kindex @key{TAB} -@item @key{TAB} @r{in new, empty item} +@orgcmd{@key{TAB},org-cycle} In a new item with no text yet, the first @key{TAB} demotes the item to -become a child of the previous one. The next @key{TAB} makes it a parent, -and so on, all the way to the left margin. Yet another @key{TAB}, and you -are back to the initial level. -@kindex S-@key{up} +become a child of the previous one. Subsequents @key{TAB} move the item to +meaningful levels in the list and eventually get it back to its initial +position. @kindex S-@key{down} @item S-@key{up} @itemx S-@key{down} @@ -1396,25 +1398,35 @@ @item M-S-@key{left} @itemx M-S-@key{right} Decrease/increase the indentation of the item, including subitems. -Initially, the item tree is selected based on current indentation. -When these commands are executed several times in direct succession, -the initially selected region is used, even if the new indentation -would imply a different hierarchy. To use the new hierarchy, break -the command chain with a cursor motion or so. +Initially, the item tree is selected based on current indentation. When +these commands are executed several times in direct succession, the initially +selected region is used, even if the new indentation would imply a different +hierarchy. To use the new hierarchy, break the command chain with a cursor +motion or so. + +As a special case, using this command on the very first item of a list will +move the whole list. This behavior can be disabled by configuring +@code{org-list-automatic-rules}. The global indentation of a list has no +influence on the text @emph{after} the list. @kindex C-c C-c @item C-c C-c If there is a checkbox (@pxref{Checkboxes}) in the item line, toggle the -state of the checkbox. If not, this command makes sure that all the -items on this list level use the same bullet. Furthermore, if this is -an ordered list, make sure the numbering is OK. +state of the checkbox. Also, makes sure that all the +items on this list level use the same bullet and that the numbering of list +items (if applicable) is correct. @kindex C-c - +@vindex org-plain-list-ordered-item-terminator +@vindex org-list-automatic-rules @item C-c - Cycle the entire list level through the different itemize/enumerate bullets -(@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}). With a numeric prefix -argument N, select the Nth bullet from this list. If there is an active -region when calling this, all lines will be converted to list items. If the -first line already was a list item, any item markers will be removed from the -list. Finally, even without an active region, a normal line will be +(@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them, +depending on @code{org-plain-list-ordered-item-terminator}, the type of list, +and its position@footnote{See @code{bullet} rule in +@code{org-list-automatic-rules} for more information.}. With a numeric +prefix argument N, select the Nth bullet from this list. If there is an +active region when calling this, all lines will be converted to list items. +If the first line already was a list item, any item markers will be removed +from the list. Finally, even without an active region, a normal line will be converted into a list item. @kindex C-c * @item C-c * @@ -1696,8 +1708,7 @@ @table @kbd @tsubheading{Creation and conversion} -@kindex C-c | -@item C-c | +@orgcmd{C-c |,org-table-create-or-convert-from-region} Convert the active region to table. If every line contains at least one TAB character, the function assumes that the material is tab separated. If every line contains a comma, comma-separated values (CSV) are assumed. @@ -1711,21 +1722,17 @@ @kbd{|Name|Phone|Age @key{RET} |- @key{TAB}}. @tsubheading{Re-aligning and field motion} -@kindex C-c C-c -@item C-c C-c +@orgcmd{C-c C-c,org-ctrl-c-ctrl-c} Re-align the table without moving the cursor. @c -@kindex @key{TAB} -@item @key{TAB} +@orgcmd{<TAB>,org-cycle} Re-align the table, move to the next field. Creates a new row if necessary. @c -@kindex S-@key{TAB} -@item S-@key{TAB} +@orgcmd{S-@key{TAB},org-shifttab} Re-align, move to previous field. @c -@kindex @key{RET} -@item @key{RET} +@orgcmd{@key{RET},org-return} Re-align the table and move down to next row. Creates a new row if necessary. At the beginning or end of a line, @key{RET} still does NEWLINE, so it can be used to split a table. @@ -1940,9 +1947,10 @@ @end example If you would like to overrule the automatic alignment of number-rich columns -to the right and of string-rich column to the left, you and use @samp{<r>} or -@samp{<l>} in a similar fashion. You may also combine alignment and field -width like this: @samp{<l10>}. +to the right and of string-rich column to the left, you and use @samp{<r>}, +@samp{c}@footnote{Centering does not work inside Emacs, but it does have an +effect when exporting to HTML.} or @samp{<l>} in a similar fashion. You may +also combine alignment and field width like this: @samp{<l10>}. Lines which only contain these formatting cookies will be removed automatically when exporting the document. @@ -2807,23 +2815,13 @@ target should be after the first headline, or in the line directly before the first headline.}. -If no dedicated target exists, Org will search for the words in the link. In -the above example the search would be for @samp{my target}. Links starting -with a star like @samp{*My Target} restrict the search to -headlines@footnote{To insert a link targeting a headline, in-buffer -completion can be used. Just type a star followed by a few optional letters -into the buffer and press @kbd{M-@key{TAB}}. All headlines in the current -buffer will be offered as completions. @xref{Handling links}, for more -commands creating links.}. When searching, Org-mode will first try an -exact match, but then move on to more and more lenient searches. For -example, the link @samp{[[*My Targets]]} will find any of the following: - -@example -** My targets -** TODO my targets are bright -** my 20 targets are -@end example - +If no dedicated target exists, Org will search for a headline that is exactly +the link text but may also include a TODO keyword and tags@footnote{To insert +a link targeting a headline, in-buffer completion can be used. Just type a +star followed by a few optional letters into the buffer and press +@kbd{M-@key{TAB}}. All headlines in the current buffer will be offered as +completions.}. In non-Org files, the search will look for the words in the +link text, in the above example the search would be for @samp{my target}. Following a link pushes a mark onto Org's own mark ring. You can return to the previous position with @kbd{C-c &}. Using this command @@ -3087,11 +3085,17 @@ @cindex inlining images @cindex images, inlining @kindex C-c C-x C-v +@vindex org-startup-with-inline-images +@cindex @code{inlineimages}, STARTUP keyword +@cindex @code{noinlineimages}, STARTUP keyword @item C-c C-x C-v Toggle the inline display of linked images. Normally this will only inline images that have no description part in the link, i.e. images that will also be inlined during export. When called with a prefix argument, also display -images that do have a link description. +images that do have a link description. You can ask for inline images to be +displayed at startup by configuring the variable +@code{org-startup-with-inline-images}@footnote{with corresponding +@code{#+STARTUP} keywords @code{inlineimages} and @code{inlineimages}}. @cindex mark ring @kindex C-c % @item C-c % @@ -3157,15 +3161,16 @@ according to the information in the variable @code{org-link-abbrev-alist} that relates the linkwords to replacement text. Here is an example: -@lisp +@smalllisp @group (setq org-link-abbrev-alist '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") ("google" . "http://www.google.com/search?q=") - ("ads" . "http://adsabs.harvard.edu/cgi-bin/ - nph-abs_connect?author=%s&db_key=AST"))) + ("gmap" . "http://maps.google.com/maps?q=%s") + ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") + ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST"))) @end group -@end lisp +@end smalllisp If the replacement text contains the string @samp{%s}, it will be replaced with the tag. Otherwise the tag will be appended to the string @@ -3174,8 +3179,11 @@ With the above setting, you could link to a specific bug with @code{[[bugzilla:129]]}, search the web for @samp{OrgMode} with -@code{[[google:OrgMode]]} and find out what the Org author is -doing besides Emacs hacking with @code{[[ads:Dominik,C]]}. +@code{[[google:OrgMode]]}, show the map location of the Free Software +Foundation @code{[[gmap:51 Franklin Street, Boston]]} or of Carsten office +@code{[[omap:Science Park 904, Amsterdam, The Netherlands]]} and find out +what the Org author is doing besides Emacs hacking with +@code{[[ads:Dominik,C]]}. If you need special abbreviations just for a single Org buffer, you can define them in the file with @@ -3810,7 +3818,10 @@ @item The property @code{STYLE} is set to the value @code{habit}. @item -The TODO has a scheduled date, with a @code{.+} style repeat interval. +The TODO has a scheduled date, usually with a @code{.+} style repeat +interval. A @code{++} style may be appropriate for habits with time +constraints, e.g., must be done on weekends, or a @code{+} style for an +unusual habit that can have a backlog, e.g., weekly reports. @item The TODO may also have minimum and maximum ranges specified by using the syntax @samp{.+2d/3d}, which says that you want to do the task at least every @@ -3908,13 +3919,13 @@ @vindex org-priority-faces By default, Org-mode supports three priorities: @samp{A}, @samp{B}, and @samp{C}. @samp{A} is the highest priority. An entry without a cookie is -treated as priority @samp{B}. Priorities make a difference only in the -agenda (@pxref{Weekly/daily agenda}); outside the agenda, they have no -inherent meaning to Org-mode. The cookies can be highlighted with special -faces by customizing the variable @code{org-priority-faces}. - -Priorities can be attached to any outline tree entries; they do not need -to be TODO items. +treated just like priority @samp{B}. Priorities make a difference only for +sorting in the agenda (@pxref{Weekly/daily agenda}); outside the agenda, they +have no inherent meaning to Org-mode. The cookies can be highlighted with +special faces by customizing the variable @code{org-priority-faces}. + +Priorities can be attached to any outline node; they do not need to be TODO +items. @table @kbd @kindex @kbd{C-c ,} @@ -4017,13 +4028,16 @@ @section Checkboxes @cindex checkboxes -Every item in a plain list (@pxref{Plain lists}) can be made into a -checkbox by starting it with the string @samp{[ ]}. This feature is -similar to TODO items (@pxref{TODO Items}), but is more lightweight. -Checkboxes are not included into the global TODO list, so they are often -great to split a task into a number of simple steps. Or you can use -them in a shopping list. To toggle a checkbox, use @kbd{C-c C-c}, or -use the mouse (thanks to Piotr Zielinski's @file{org-mouse.el}). +@vindex org-list-automatic-rules +Every item in a plain list@footnote{With the exception of description +lists. But you can allow it by modifying @code{org-list-automatic-rules} +accordingly.} (@pxref{Plain lists}) can be made into a checkbox by starting +it with the string @samp{[ ]}. This feature is similar to TODO items +(@pxref{TODO Items}), but is more lightweight. Checkboxes are not included +into the global TODO list, so they are often great to split a task into a +number of simple steps. Or you can use them in a shopping list. To toggle a +checkbox, use @kbd{C-c C-c}, or use the mouse (thanks to Piotr Zielinski's +@file{org-mouse.el}). Here is an example of a checkbox list. @@ -4738,8 +4752,8 @@ @var{property} @r{The property that should be edited in this column.} @r{Special properties representing meta data are allowed here} @r{as well (@pxref{Special properties})} -(title) @r{The header text for the column. If omitted, the} - @r{property name is used.} +@var{title} @r{The header text for the column. If omitted, the property} + @r{name is used.} @{@var{summary-type}@} @r{The summary type. If specified, the column values for} @r{parent nodes are computed from the children.} @r{Supported summary types are:} @@ -4756,9 +4770,10 @@ @{:min@} @r{Smallest time value in column.} @{:max@} @r{Largest time value.} @{:mean@} @r{Arithmetic mean of time values.} - @{@@min@} @r{Minimum age (in days/hours/mins/seconds).} - @{@@max@} @r{Maximum age (in days/hours/mins/seconds).} - @{@@mean@} @r{Arithmetic mean of ages (in days/hours/mins/seconds).} + @{@@min@} @r{Minimum age (in days/hours/mins/seconds).} + @{@@max@} @r{Maximum age (in days/hours/mins/seconds).} + @{@@mean@} @r{Arithmetic mean of ages (in days/hours/mins/seconds).} + @{est+@} @r{Add low-high estimates.} @end example @noindent @@ -4766,6 +4781,22 @@ include. Subsequent columns referencing the same property will all display the same summary information. +The @code{est+} summary type requires further explanation. It is used for +combining estimates, expressed as low-high ranges. For example, instead +of estimating a particular task will take 5 days, you might estimate it as +5-6 days if you're fairly confident you know how much woark is required, or +1-10 days if you don't really know what needs to be done. Both ranges +average at 5.5 days, but the first represents a more predictable delivery. + +When combining a set of such estimates, simply adding the lows and highs +produces an unrealistically wide result. Instead, @code{est+} adds the +statistical mean and variance of the sub-tasks, generating a final estimate +from the sum. For example, suppose you had ten tasks, each of which was +estimated at 0.5 to 2 days of work. Straight addition produces an estimate +of 5 to 20 days, representing what to expect if everything goes either +extremely well or extremely poorly. In contrast, @code{est+} estimates the +full job more realistically, at 10-15 days. + Here is an example for a complete columns definition, along with allowed values. @@ -4978,6 +5009,7 @@ * Resolving idle time:: Resolving time if you've been idle * Effort estimates:: Planning work effort in advance * Relative timer:: Notes with a running timer +* Countdown timer:: Starting a countdown timer for a task @end menu @@ -5067,15 +5099,13 @@ format. @table @kbd -@kindex C-c . -@item C-c . +@orgcmd{C-c .,org-time-stamp} Prompt for a date and insert a corresponding timestamp. When the cursor is at an existing timestamp in the buffer, the command is used to modify this timestamp instead of inserting a new one. When this command is used twice in succession, a time range is inserted. @c -@kindex C-c ! -@item C-c ! +@orgcmd{C-c !,org-time-stamp-inactive} Like @kbd{C-c .}, but insert an inactive timestamp that will not cause an agenda entry. @c @@ -5088,18 +5118,15 @@ contains date and time. The default time can be rounded to multiples of 5 minutes, see the option @code{org-time-stamp-rounding-minutes}. @c -@kindex C-c < -@item C-c < +@orgcmd{C-c <,org-date-from-calendar} Insert a timestamp corresponding to the cursor date in the Calendar. @c -@kindex C-c > -@item C-c > +@orgcmd{C-c >,org-goto-calendar} Access the Emacs calendar for the current date. If there is a timestamp in the current line, go to the corresponding date instead. @c -@kindex C-c C-o -@item C-c C-o +@orgcmd{C-c C-o,org-open-at-point} Access the agenda for the date given by the timestamp or -range at point (@pxref{Weekly/daily agenda}). @c @@ -5206,6 +5233,16 @@ you want to use unabbreviated names and/or other languages, configure the variables @code{parse-time-months} and @code{parse-time-weekdays}. +You can specify a time range by giving start and end times or by giving a +start time and a duration (in HH:MM format). Use '-' or '--' as the separator +in the former case and use '+' as the separator in the latter case. E.g. + +@example +11am-1:15pm --> 11:00-13:15 +11am--1:15pm --> same as above +11am+2:15 --> same as above +@end example + @cindex calendar, for selecting date @vindex org-popup-calendar-for-date-prompt Parallel to the minibuffer prompt, a calendar is popped up@footnote{If @@ -5593,9 +5630,8 @@ mistake, or if you ended up working on something else. @kindex C-c C-x C-j @item C-c C-x C-j -Jump to the entry that contains the currently running clock. With a -@kbd{C-u} prefix arg, select the target task from a list of recently clocked -tasks. +Jump to the headline of the currently clocked in task. With a @kbd{C-u} +prefix arg, select the target task from a list of recently clocked tasks. @kindex C-c C-x C-d @item C-c C-x C-d @vindex org-remove-highlights-with-change @@ -5835,7 +5871,7 @@ these estimates defined consistently, two or three key presses will narrow down the list to stuff that fits into an available time slot. -@node Relative timer, , Effort estimates, Dates and Times +@node Relative timer, Countdown timer, Effort estimates, Dates and Times @section Taking notes with a relative timer @cindex relative timer @@ -5877,6 +5913,20 @@ not started at exactly the right moment. @end table +@node Countdown timer, , Relative timer, Dates and Times +@section Countdown timer +@cindex Countdown timer +@kindex C-c C-x ; +@kindex ; + +Calling @code{org-timer-set-timer} from an Org-mode buffer runs a countdown +timer. Use @key{;} from agenda buffers, @key{C-c C-x ;} everwhere else. + +@code{org-timer-set-timer} prompts the user for a duration and displays a +countdown timer in the modeline. @code{org-timer-default-timer} sets the +default countdown value. Giving a prefix numeric argument overrides this +default value. + @node Capture - Refile - Archive, Agenda Views, Dates and Times, Top @chapter Capture - Refile - Archive @cindex capture @@ -5934,6 +5984,7 @@ a global key@footnote{Please select your own key, @kbd{C-c c} is only a suggestion.} for capturing new material. +@vindex org-default-notes-file @example (setq org-default-notes-file (concat org-directory "/notes.org")) (define-key global-map "\C-cc" 'org-capture) @@ -5960,7 +6011,10 @@ @kindex C-c C-w @item C-c C-w Finalize the capture process by refiling (@pxref{Refiling notes}) the note to -a different place. +a different place. Please realize that this is a normal refiling command +that will be executed - so the cursor position at the moment you run this +command is important. If you have inserted a tree with a parent and +children, first move the cursor back to the parent. @kindex C-c C-k @item C-c C-k @@ -6067,10 +6121,12 @@ @end table @item target -Specification of where the captured item should be placed. -In Org-mode files, targets usually define a node. Entries will become -children of this node, other types will be added to the table or list in the -body of this node. +@vindex org-default-notes-file +Specification of where the captured item should be placed. In Org-mode +files, targets usually define a node. Entries will become children of this +node, other types will be added to the table or list in the body of this +node. Most target specifications contain a file name. If that file name is +the empty string, it defaults to @code{org-default-notes-file}. Valid values are: @table @code @@ -6139,6 +6195,10 @@ @item :unnarrowed Do not narrow the target buffer, simply show the full buffer. Default is to narrow it so that you only see the new material. + +@item :kill-buffer +If the target file was not yet visited when capture was invoked, kill the +buffer again after capture is completed. @end table @end table @@ -6191,16 +6251,19 @@ @smallexample Link type | Available keywords -------------------+---------------------------------------------- -bbdb | %:name %:company -bbdb | %::server %:port %:nick -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} -gnus | %:group, @r{for messages also all email fields} -w3, w3m | %:url -info | %:file %:node -calendar | %:date +bbdb | %:name %:company +irc | %:server %:port %:nick +vm, wl, mh, mew, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:date @r{(message date header field)} + | %:date-timestamp @r{(date as active timestamp)} + | %:date-timestamp-inactive @r{(date as inactive timestamp)} + | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} +gnus | %:group, @r{for messages also all email fields} +w3, w3m | %:url +info | %:file %:node +calendar | %:date @end smallexample @noindent @@ -7247,6 +7310,7 @@ @subsection Categories @cindex category +@cindex #+CATEGORY The category is a broad label assigned to each agenda item. By default, the category is simply derived from the file name, but you can also specify it with a special line in the buffer, like this@footnote{For @@ -7474,6 +7538,10 @@ @item j Prompt for a date and go there. @c +@kindex J +@item J +Go to the currently clocked in task in the agenda buffer. +@c @kindex D @item D Toggle the inclusion of diary entries. See @ref{Weekly/daily agenda}. @@ -7584,7 +7652,9 @@ having to recreate the agenda@footnote{Custom commands can preset a filter by binding the variable @code{org-agenda-filter-preset} as an option. This filter will then be applied to the view and persist as a basic filter through -refreshes and more secondary filtering.} +refreshes and more secondary filtering. The filter is a global property of +the entire agenda view - in a block agenda, you should only set this in the +global options section, not in the section of an individual block.} You will be prompted for a tag selection letter, SPC will mean any tag at all. Pressing @key{TAB} at that prompt will offer use completion to select a @@ -8600,6 +8670,7 @@ backend-specific, see the sections about the individual backends for more information. +@xref{Handling links,the discussion of image links}. @node Literal examples, Include files, Images and tables, Markup @section Literal examples @@ -8631,13 +8702,24 @@ @cindex formatting source code, markup rules If the example is source code from a programming language, or any other text that can be marked up by font-lock in Emacs, you can ask for the example to -look like the fontified Emacs buffer@footnote{Currently this works for the -HTML backend, and requires the @file{htmlize.el} package version 1.34 or -later. It also works for LaTeX with the listings package, if you turn on the -option @code{org-export-latex-listings} and make sure that the listings -package is included by the LaTeX header.}. This is done with the @samp{src} -block, where you also need to specify the name of the major mode that should -be used to fontify the example: +look like the fontified Emacs buffer@footnote{This works automatically for +the HTML backend (it requires version 1.34 of the @file{htmlize.el} package, +which is distributed with Org.) Fontified code chunks in LaTeX can be +achieved using either the listings or the +@url{http://code.google.com/p/minted, minted,} package. To use listings, turn +on the variable @code{org-export-latex-listings} and ensure that the listings +package is included by the LaTeX header (e.g. by configuring +@code{org-export-latex-packages-alist}). See the listings documentation for +configuration options, including obtaining colored output. For minted it is +necessary to install the program @url{http://pygments.org, pygments}, in +addition to setting @code{org-export-latex-minted}, ensuring that the minted +package is included by the LaTeX header, and ensuring that the +@code{-shell-escape} option is passed to @file{pdflatex} (see +@code{org-latex-to-pdf-process}). See the documentation of the variables +@code{org-export-latex-listings} and @code{org-export-latex-minted} for +further details.}. This is done with the @samp{src} block, where you also +need to specify the name of the major mode that should be used to fontify the +example: @cindex #+BEGIN_SRC @example @@ -8794,12 +8876,9 @@ features described here as ``La@TeX{}'' are really from @TeX{}, but for simplicity I am blurring this distinction.} is widely used to typeset scientific documents. Org-mode supports embedding La@TeX{} code into its -files, because many academics are used to reading La@TeX{} source code, and -because it can be readily processed into images for HTML production. - -It is not necessary to mark La@TeX{} macros and code in any special way. -If you observe a few conventions, Org-mode knows how to find it and what -to do with it. +files, because many academics are used to writing and reading La@TeX{} source +code, and because it can be readily processed to produce pretty output for a +number of export backends. @menu * Special symbols:: Greek letters and other symbols @@ -8843,7 +8922,7 @@ @samp{...} are all converted into special commands creating hyphens of different lengths or a compact set of dots. -If you would like to see entities displayed as utf8 characters, use the +If you would like to see entities displayed as UTF8 characters, use the following command@footnote{You can turn this on by default by setting the variable @code{org-pretty-entities}, or on a per-file base with the @code{#+STARTUP} option @code{entitiespretty}.}: @@ -8884,6 +8963,9 @@ #+OPTIONS: ^:@{@} @end example +@noindent With this setting, @samp{a_b} will not be interpreted as a +subscript, but @samp{a_@{b@}} will. + @table @kbd @kindex C-c C-x \ @item C-c C-x \ @@ -8896,31 +8978,31 @@ @cindex La@TeX{} fragments @vindex org-format-latex-header -With symbols, sub- and superscripts, HTML is pretty much at its end when -it comes to representing mathematical formulas@footnote{Yes, there is -MathML, but that is not yet fully supported by many browsers, and there -is no decent converter for turning La@TeX{} or ASCII representations of -formulas into MathML. So for the time being, converting formulas into -images seems the way to go.}. More complex expressions need a dedicated -formula processor. To this end, Org-mode can contain arbitrary La@TeX{} -fragments. It provides commands to preview the typeset result of these -fragments, and upon export to HTML, all fragments will be converted to -images and inlined into the HTML document@footnote{The La@TeX{} export -will not use images for displaying La@TeX{} fragments but include these -fragments directly into the La@TeX{} code.}. For this to work you -need to be on a system with a working La@TeX{} installation. You also -need the @file{dvipng} program, available at -@url{http://sourceforge.net/projects/dvipng/}. The La@TeX{} header that -will be used when processing a fragment can be configured with the -variable @code{org-format-latex-header}. +Going beyond symbols and sub- and superscripts, a full formula language is +needed. Org-mode can contain La@TeX{} math fragments, and it supports ways +to process these for several export backends. When exporting to La@TeX{}, +the code is obviously left as it is. When exporting to HTML, Org invokes the +@uref{http://www.mathjax.org, MathJax library} (@pxref{Math formatting in +HTML export}) to process and display the math@footnote{If you plan to use +this regularly or on pages with significant page views, you should install +@file{MathJax} on your own server in order to limit the load of our server.}. +Finally, it can also process the mathematical expressions into +images@footnote{For this to work you need to be on a system with a working +La@TeX{} installation. You also need the @file{dvipng} program, available at +@url{http://sourceforge.net/projects/dvipng/}. The La@TeX{} header that will +be used when processing a fragment can be configured with the variable +@code{org-format-latex-header}.} that can be displayed in a browser or in +DocBook documents. La@TeX{} fragments don't need any special marking at all. The following snippets will be identified as La@TeX{} source code: @itemize @bullet @item -Environments of any kind. The only requirement is that the -@code{\begin} statement appears on a new line, preceded by only -whitespace. +Environments of any kind@footnote{When @file{MathJax} is used, only the +environment recognized by @file{MathJax} will be processed. When dvipng is +used to create images, any La@TeX{} environments will be handled.}. The only +requirement is that the @code{\begin} statement appears on a new line, +preceded by only whitespace. @item Text within the usual La@TeX{} math delimiters. To avoid conflicts with currency specifications, single @samp{$} characters are only recognized as @@ -8948,12 +9030,26 @@ can configure the option @code{org-format-latex-options} to deselect the ones you do not wish to have interpreted by the La@TeX{} converter. +@vindex org-export-with-LaTeX-fragments +LaTeX processing can be configured with the variable +@code{org-export-with-LaTeX-fragments}. The default setting is @code{t} +which means @file{MathJax} for HTML, and no processing for DocBook, ASCII and +LaTeX backends. You can also set this variable on a per-file basis using one +of these lines: + +@example +#+OPTIONS: LaTeX:t @r{Do the right thing automatically (MathJax)} +#+OPTIONS: LaTeX:dvipng @r{Force using dvipng images} +#+OPTIONS: LaTeX:nil @r{Do not process La@TeX{} fragments at all} +#+OPTIONS: LaTeX:verbatim @r{Verbatim export, for jsMath or so} +@end example + @node Previewing LaTeX fragments, CDLaTeX mode, LaTeX fragments, Embedded LaTeX @subsection Previewing LaTeX fragments @cindex LaTeX fragments, preview -La@TeX{} fragments can be processed to produce preview images of the -typeset expressions: +If you have @file{dvipng} installed, La@TeX{} fragments can be processed to +produce preview images of the typeset expressions: @table @kbd @kindex C-c C-x C-l @@ -8975,14 +9071,6 @@ export, @code{:html-scale}) property can be used to adjust the size of the preview images. -During HTML export (@pxref{HTML export}), all La@TeX{} fragments are -converted into images and inlined into the document if the following -setting is active: - -@lisp -(setq org-export-with-LaTeX-fragments t) -@end lisp - @node CDLaTeX mode, , Previewing LaTeX fragments, Embedded LaTeX @subsection Using CDLa@TeX{} to enter math @cindex CDLa@TeX{} @@ -9200,7 +9288,7 @@ <: @r{turn on/off inclusion of any time/date stamps like DEADLINES} *: @r{turn on/off emphasized text (bold, italic, underlined)} TeX: @r{turn on/off simple @TeX{} macros in plain text} -LaTeX: @r{turn on/off La@TeX{} fragments} +LaTeX: @r{configure export of La@TeX{} fragments. Default @code{auto}} skip: @r{turn on/off skipping the text before the first heading} author: @r{turn on/off inclusion of author name/email into exported file} email: @r{turn on/off inclusion of author email into exported file} @@ -9333,6 +9421,7 @@ * Links in HTML export:: How links will be interpreted and formatted * Tables in HTML export:: How to modify the formatting of tables * Images in HTML export:: How to insert figures into HTML output +* Math formatting in HTML export:: Beautiful math also on the web * Text areas in HTML export:: An alternative way to show an example * CSS support:: Changing the appearance of the output * JavaScript support:: Info and Folding in a web browser @@ -9468,7 +9557,7 @@ #+ATTR_HTML: border="2" rules="all" frame="all" @end example -@node Images in HTML export, Text areas in HTML export, Tables in HTML export, HTML export +@node Images in HTML export, Math formatting in HTML export, Tables in HTML export, HTML export @subsection Images in HTML export @cindex images, inline in HTML @@ -9505,7 +9594,41 @@ @noindent and you could use @code{http} addresses just as well. -@node Text areas in HTML export, CSS support, Images in HTML export, HTML export +@node Math formatting in HTML export, Text areas in HTML export, Images in HTML export, HTML export +@subsection Math formatting in HTML export +@cindex MathJax +@cindex dvipng + +La@TeX{} math snippets (@pxref{LaTeX fragments}) can be displayed in two +different ways on HTML pages. The default is to use the +@uref{http://www.mathjax.org, MathJax system} which should work out of the +box with Org mode installation because @code{http://orgmode.org} serves +@file{MathJax} for Org-mode users for small applications and for testing +purposes. @b{If you plan to use this regularly or on pages with significant +page views, you should install MathJax on your own server in order to limit +the load of our server.} To configure @file{MathJax}, use the variable +@code{org-export-html-mathjax-options} or insert something like the following +into the buffer: + +@example +#+MATHJAX: align:"left" mathml:t path:"/MathJax/MathJax.js" +@end example + +@noindent See the docstring of the variable +@code{org-export-html-mathjax-options} for the meaning of the parameters in +this line. + +If you prefer, you can also request that La@TeX{} are processed into small +images that will be inserted into the browser page. Before the availability +of MathJax, this was the default method for Org files. This method requires +that the @file{dvipng} program is available on your system. You can still +get this processing with + +@example +#+OPTIONS: LaTeX:dvipng +@end example + +@node Text areas in HTML export, CSS support, Math formatting in HTML export, HTML export @subsection Text areas in HTML export @cindex text areas, in HTML @@ -9595,6 +9718,11 @@ directly write a @code{<style>} @code{</style>} section in this way, without referring to an external file. +In order to add styles to a subtree, use the @code{:HTML_CONTAINER_CLASS:} +property to assign a class to the tree. In order to specify CSS styles for a +particular headline, you can use the id specified in a @code{:CUSTOM_ID:} +property. + @c FIXME: More about header and footer styles @c FIXME: Talk about links and targets. @@ -9890,9 +10018,9 @@ structure of the presentation. A template for useful in-buffer settings or properties can be inserted into -the buffer with @kbd{M-x org-beamer-settings-template}. Among other things, -this will install a column view format which is very handy for editing -special properties used by beamer. +the buffer with @kbd{M-x org-insert-beamer-options-template}. Among other +things, this will install a column view format which is very handy for +editing special properties used by beamer. You can influence the structure of the presentation using the following properties: @@ -9957,7 +10085,7 @@ Column view provides a great way to set the environment of a node and other important parameters. Make sure you are using a COLUMN format that is geared toward this special purpose. The command @kbd{M-x -org-beamer-settings-template} defines such a format. +org-insert-beamer-options-template} defines such a format. Here is a simple example Org document that is intended for beamer export. @@ -10366,6 +10494,7 @@ @vindex org-icalendar-use-deadline @vindex org-icalendar-use-scheduled @vindex org-icalendar-categories +@vindex org-icalendar-alarm-time Some people use Org-mode for keeping track of projects, but still prefer a standard calendar application for anniversaries and appointments. In this case it can be useful to show deadlines and other time-stamped items in Org @@ -10379,7 +10508,9 @@ @code{org-icalendar-use-deadline} and @code{org-icalendar-use-scheduled}.}. As categories, it will use the tags locally defined in the heading, and the file/tree category@footnote{To add inherited tags or the TODO state, -configure the variable @code{org-icalendar-categories}.}. +configure the variable @code{org-icalendar-categories}.}. See the variable +@code{org-icalendar-alarm-time} for a way to assign alarms to entries with a +time. @vindex org-icalendar-store-UID @cindex property, ID @@ -10477,7 +10608,8 @@ configures one project, and may be in one of the two following forms: @lisp - ("project-name" :property value :property value ...) + ("project-name" :property value :property value ...) + @r{i.e. a well-formed property list with alternating keys and values} @r{or} ("project-name" :components ("project-name" "project-name" ...)) @@ -10553,20 +10685,20 @@ Org files as HTML files, and this is done by the function @code{org-publish-org-to-html} which calls the HTML exporter (@pxref{HTML export}). But you also can publish your content as PDF files using -@code{org-publish-org-to-pdf}. If you want to publish the Org file itself, -but with @i{archived}, @i{commented}, and @i{tag-excluded} trees removed, use -@code{org-publish-org-to-org} and set the parameters @code{:plain-source} -and/or @code{:htmlized-source}. This will produce @file{file.org} and -@file{file.org.html} in the publishing +@code{org-publish-org-to-pdf}, or as @code{ascii}, @code{latin1} or +@code{utf8} encoded files using the corresponding functions. If you want to +publish the Org file itself, but with @i{archived}, @i{commented}, and +@i{tag-excluded} trees removed, use @code{org-publish-org-to-org} and set the +parameters @code{:plain-source} and/or @code{:htmlized-source}. This will +produce @file{file.org} and @file{file.org.html} in the publishing directory@footnote{@file{file-source.org} and @file{file-source.org.html} if source and publishing directories are equal. Note that with this kind of setup, you need to add @code{:exclude "-source\\.org"} to the project definition in @code{org-publish-project-alist} to avoid that the published source files will be considered as new org files the next time the project is -published.}. Other files like images only -need to be copied to the publishing destination, for this you may use -@code{org-publish-attachment}. For non-Org files, you always need to -specify the publishing function: +published.}. Other files like images only need to be copied to the +publishing destination, for this you may use @code{org-publish-attachment}. +For non-Org files, you always need to specify the publishing function: @multitable @columnfractions 0.3 0.7 @item @code{:publishing-function} @@ -10960,9 +11092,9 @@ Org-mode provides a number of features for working with live source code, including editing of code blocks in their native major-mode, evaluation of -code blocks, tangling of code blocks, and exporting code blocks and -their results in several formats. This functionality was contributed by Dan -Davison and Eric Schulte, and was originally named Org-babel. +code blocks, tangling of code blocks, and exporting code blocks and their +results in several formats. This functionality was contributed by Eric +Schulte and Dan Davison, and was originally named Org-babel. The following sections describe Org-mode's code block handling facilities. @@ -10998,6 +11130,18 @@ #+end_src @end example +code blocks can also be embedded in text as so called inline code blocks as + +@example +src_<language>@{<body>@} +@end example + +or + +@example +src_<language>[<header arguments>]@{<body>@} +@end example + @table @code @item <name> This name is associated with the code block. This is similar to the @@ -11124,10 +11268,10 @@ @kindex C-c C-v t @subsubheading Functions @table @code -@item org-babel-tangle @kbd{C-c C-v t} -Tangle the current file. +@item org-babel-tangle +Tangle the current file. Bound to @kbd{C-c C-v t}. @item org-babel-tangle-file -Choose a file to tangle. +Choose a file to tangle. Bound to @kbd{C-c C-v f}. @end table @subsubheading Hooks @@ -11200,10 +11344,10 @@ they were in the current Org-mode buffer (see @ref{Evaluating code blocks} for information on the syntax of remote code block evaluation). -@kindex C-c C-v l +@kindex C-c C-v i Code blocks located in any Org-mode file can be loaded into the ``Library of Babel'' with the @code{org-babel-lob-ingest} function, bound to @kbd{C-c C-v -l}. +i}. @node Languages, Header arguments, Library of Babel, Working With Source Code @section Languages @@ -11279,7 +11423,7 @@ @node Using header arguments, Specific header arguments, Header arguments, Header arguments @subsection Using header arguments -The values of header arguments can be set in five different ways, each more +The values of header arguments can be set in six different ways, each more specific (and having higher priority) than the last. @menu * System-wide header arguments:: Set global default values @@ -11287,6 +11431,7 @@ * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values +* Header arguments in function calls:: The most specific level @end menu @@ -11381,7 +11526,7 @@ @code{org-set-property} function bound to @kbd{C-c C-x p} to set properties in Org-mode documents. -@node Code block specific header arguments, , Header arguments in Org-mode properties, Using header arguments +@node Code block specific header arguments, Header arguments in function calls, Header arguments in Org-mode properties, Using header arguments @subsubheading Code block specific header arguments The most common way to assign values to header arguments is at the @@ -11402,14 +11547,18 @@ fac n = n * fac (n-1) #+end_src @end example - Similarly, it is possible to set header arguments for inline code blocks: @example src_haskell[:exports both]@{fac 5@} @end example -Header arguments for ``Library of Babel'' or function call lines can be set as shown below: +@node Header arguments in function calls, , Code block specific header arguments, Using header arguments +@comment node-name, next, previous, up +@subsubheading Header arguments in function calls + +At the most specific level, header arguments for ``Library of Babel'' or +function call lines can be set as shown below: @example #+call: factorial(n=5) :exports results @@ -11428,10 +11577,10 @@ directory for code block execution * exports:: Export code and/or results * tangle:: Toggle tangling and specify file name +* comments:: Toggle insertion of comments in tangled + code files * no-expand:: Turn off variable assignment and noweb expansion during tangling -* comments:: Toggle insertion of comments in tangled - code files * session:: Preserve the state of code evaluation * noweb:: Toggle expansion of noweb references * cache:: Avoid re-evaluating unchanged code blocks @@ -11842,10 +11991,25 @@ @subsubsection @code{:comments} By default code blocks are tangled to source-code files without any insertion of comments beyond those which may already exist in the body of the code -block. The @code{:comments} header argument can be set to ``yes'' -e.g. @code{:comments yes} to enable the insertion of comments around code -blocks during tangling. The inserted comments contain pointers back to the -original Org file from which the comment was tangled. +block. The @code{:comments} header argument can be set as follows to control +the insertion of extra comments into the tangled code file. + +@itemize @bullet +@item @code{no} +The default. No extra comments are inserted during tangling. +@item @code{link} +The code block is wrapped in comments which contain pointers back to the +original Org file from which the code was tangled. +@item @code{yes} +A synonym for ``link'' to maintain backwards compatibility. +@item @code{org} +Include text from the org-mode file as a comment. + +The text is picked from the leading context of the tangled code and is +limited by the nearest headline or source block as the case may be. +@item @code{both} +Turns on both the ``link'' and ``org'' comment options. +@end itemize @node no-expand, session, comments, Specific header arguments @subsubsection @code{:no-expand} @@ -11873,16 +12037,20 @@ The @code{:noweb} header argument controls expansion of ``noweb'' style (see @ref{Noweb reference syntax}) references in a code block. This header -argument can have one of two values: @code{yes} or @code{no}. +argument can have one of three values: @code{yes} @code{no} or @code{tangle}. @itemize @bullet +@item @code{yes} +All ``noweb'' syntax references in the body of the code block will be +expanded before the block is evaluated, tangled or exported. @item @code{no} The default. No ``noweb'' syntax specific action is taken on evaluating code blocks, However, noweb references will still be expanded during tangling. @item @code{yes} All ``noweb'' syntax references in the body of the code block will be -expanded before the block is evaluated. +expanded before the block is tangled, however ``noweb'' references will not +be expanded when the block is evaluated or exported. @end itemize @subsubheading Noweb prefix lines @@ -12067,7 +12235,7 @@ first line of any tangled file holding the code block, and the file permissions of the tangled file are set to make it executable. -@node eval, , shebang, Specific header arguments +@node eval, , shebang, Specific header arguments @subsubsection @code{:eval} The @code{:eval} header argument can be used to limit the evaluation of specific code blocks. @code{:eval} accepts two arguments ``never'' and @@ -12268,17 +12436,18 @@ #!/bin/sh # -*- mode: shell-script -*- # -# tangle a file with org-mode +# tangle files with org-mode # DIR=`pwd` FILES="" +ORGINSTALL="~/src/org/lisp/org-install.el" # wrap each argument in the code required to call tangle on it for i in $@@; do -FILES="$FILES \"$i\"" + FILES="$FILES \"$i\"" done -emacsclient \ +emacs -Q --batch -l $ORGINSTALL \ --eval "(progn (add-to-list 'load-path (expand-file-name \"~/src/org/lisp/\")) (add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\")) @@ -12286,7 +12455,7 @@ (mapc (lambda (file) (find-file (expand-file-name file \"$DIR\")) (org-babel-tangle) - (kill-buffer)) '($FILES)))" + (kill-buffer)) '($FILES)))" 2>&1 |grep tangled @end example @node Miscellaneous, Hacking, Working With Source Code, Top @@ -12294,6 +12463,7 @@ @menu * Completion:: M-TAB knows what you need +* Easy Templates:: Quick insertion of structural elements * Speed keys:: Electric commands at the beginning of a headline * Code evaluation security:: Org mode files evaluate inline code * Customization:: Adapting Org to your taste @@ -12305,7 +12475,7 @@ @end menu -@node Completion, Speed keys, Miscellaneous, Miscellaneous +@node Completion, Easy Templates, Miscellaneous, Miscellaneous @section Completion @cindex completion, of @TeX{} symbols @cindex completion, of TODO keywords @@ -12367,7 +12537,46 @@ @end itemize @end table -@node Speed keys, Code evaluation security, Completion, Miscellaneous +@node Easy Templates, Speed keys, Completion, Miscellaneous +@section Easy Templates +@cindex template insertion +@cindex insertion, of templates + +Org-mode supports insertion of empty structural elements (like +@code{#+BEGIN_SRC} and @code{#+END_SRC} pairs) with just a few key +strokes. This is achieved through a native template expansion mechanism. +Note that Emacs has several other template mechanisms which could be used in +a similar way, for example @file{yasnippet}. + +To insert a structural element, type a @samp{<}, followed by a template +selector and @kbd{@key{TAB}}. Completion takes effect only when the above +keystrokes are typed on a line by itself. + +The following template selectors are currently supported. + +@multitable @columnfractions 0.1 0.9 +@item @kbd{s} @tab @code{#+begin_src ... #+end_src} +@item @kbd{e} @tab @code{#+begin_example ... #+end_example} +@item @kbd{q} @tab @code{#+begin_quote ... #+end_quote} +@item @kbd{v} @tab @code{#+begin_verse ... #+end_verse} +@item @kbd{c} @tab @code{#+begin_center ... #+end_center} +@item @kbd{l} @tab @code{#+begin_latex ... #+end_latex} +@item @kbd{L} @tab @code{#+latex:} +@item @kbd{h} @tab @code{#+begin_html ... #+end_html} +@item @kbd{H} @tab @code{#+html:} +@item @kbd{a} @tab @code{#+begin_ascii ... #+end_ascii} +@item @kbd{A} @tab @code{#+ascii:} +@item @kbd{i} @tab @code{#+include:} line +@end multitable + +For example, on an empty line, typing "<e" and then pressing TAB, will expand +into a complete EXAMPLE template. + +You can install additional templates by customizing the variable +@code{org-structure-template-alist}. Refer docstring of the variable for +additional details. + +@node Speed keys, Code evaluation security, Easy Templates, Miscellaneous @section Speed keys @cindex speed keys @vindex org-use-speed-commands @@ -12388,7 +12597,7 @@ @node Code evaluation security, Customization, Speed keys, Miscellaneous @section Code evaluation and security issues -Org provides tool to work with the code snippets, including evaluating them. +Org provides tools to work with the code snippets, including evaluating them. Running code on your machine always comes with a security risk. Badly written or malicious code can be executed on purpose or by accident. Org has @@ -12406,12 +12615,12 @@ @item Source code blocks Source code blocks can be evaluated during export, or when pressing @kbd{C-c C-c} in the block. The most important thing to realize here is that Org mode -files which contain code snippets are in a certain sense like executable +files which contain code snippets are, in a certain sense, like executable files. So you should accept them and load them into Emacs only from trusted sources - just like you would do with a program you install on your computer. Make sure you know what you are doing before customizing the variables -which take of the default security brakes. +which take off the default security brakes. @defopt org-confirm-babel-evaluate When set to t user is queried before code block evaluation @@ -12419,7 +12628,7 @@ @item Following @code{shell} and @code{elisp} links Org has two link types that can directly evaluate code (@pxref{External -links}). These links can be problematic because the code to be evaluated his +links}). These links can be problematic because the code to be evaluated is not visible. @defopt org-confirm-shell-link-function @@ -12429,12 +12638,6 @@ Functions to query user for Emacs Lisp link execution. @end defopt -@item Following @code{shell} and @code{elisp} links -Org has two link types that can directly evaluate code (@pxref{External -links}). These links can be problematic because the code to be evaluated his -not visible. @b{Security advice:} Do not use these links, use source code -blocks which make the associated actions much more transparent. - @item Formulas in tables Formulas in tables (@pxref{The spreadsheet}) are code that is evaluated either by the @i{calc} interpreter, or by the @i{Emacs Lisp} interpreter. @@ -12565,6 +12768,18 @@ align @r{align all tables} noalign @r{don't align tables on startup} @end example + +@vindex org-startup-with-inline-images +When visiting a file, inline images can be automatically displayed. The +corresponding variable is @code{org-startup-with-inline-images}, with a +default value @code{nil} to avoid delays when visiting a file. +@cindex @code{inlineimages}, STARTUP keyword +@cindex @code{noinlineimages}, STARTUP keyword +@example +inlineimages @r{show inline images} +noinlineimages @r{don't show inline images on startup} +@end example + @vindex org-log-done @vindex org-log-note-clock-out @vindex org-log-repeat @@ -13273,8 +13488,10 @@ Add-ons can tap into this functionality by providing a function that detects special context for that add-on and executes functionality appropriate for the context. Here is an example from Dan Davison's @file{org-R.el} which -allows you to evaluate commands based on the @file{R} programming language. For -this package, special contexts are lines that start with @code{#+R:} or +allows you to evaluate commands based on the @file{R} programming language +@footnote{@file{org-R.el} has been replaced by the org-mode functionality +described in @ref{Working With Source Code} and is now obsolete.}. For this +package, special contexts are lines that start with @code{#+R:} or @code{#+RR:}. @lisp @@ -13693,10 +13910,11 @@ @section Special agenda views @cindex agenda views, user-defined -Org provides a special hook that can be used to narrow down the -selection made by any of the agenda views. You may specify a function -that is used at each match to verify if the match should indeed be part -of the agenda view, and if not, how much should be skipped. +Org provides a special hook that can be used to narrow down the selection +made by these agenda views: @code{todo}, @code{alltodo}, @code{tags}, @code{tags-todo}, +@code{tags-tree}. You may specify a function that is used at each match to verify +if the match should indeed be part of the agenda view, and if not, how +much should be skipped. Let's say you want to produce a list of projects that contain a WAITING tag anywhere in the project tree. Let's further assume that you have @@ -14107,16 +14325,23 @@ @node Setting up the staging area, Pushing to MobileOrg, MobileOrg, MobileOrg @section Setting up the staging area -MobileOrg needs to interact with Emacs through directory on a -server@footnote{If you are using a public server, you might prefer to encrypt -the files on the server. This can be done with Org-mode 6.35 and, hopefully, -with MobileOrg 1.4 (please check before trying to use this). On the Emacs -side, configure the variables @code{org-mobile-use-encryption} and -@code{org-mobile-encryption-password}.}. The easiest way to create that -directory is to use a free @uref{http://dropbox.com,Dropbox.com} -account@footnote{If you cannot use Dropbox, or if your version of MobileOrg -does not support it, you can use a webdav server. For more information, -check out the the documentation of MobileOrg and also this +MobileOrg needs to interact with Emacs through directory on a server. If you +are using a public server, you should consider to encrypt the files that are +uploaded to the server. This can be done with Org-mode 7.02 and with +@i{MobileOrg 1.5} (iPhone version), and you need an @file{openssl} +installation on your system. To turn on encryption, set a password in +@i{MobileOrg} and, on the Emacs side, configure the variable +@code{org-mobile-use-encryption}@footnote{If you can safely store the +password in your Emacs setup, you might also want to configure +@code{org-mobile-encryption-password}. Please read the docstring of that +variable. Note that encryption will apply only to the contents of the +@file{.org} files. The file names themselves will remain visible.}. + +The easiest way to create that directory is to use a free +@uref{http://dropbox.com,Dropbox.com} account@footnote{If you cannot use +Dropbox, or if your version of MobileOrg does not support it, you can use a +webdav server. For more information, check out the the documentation of +MobileOrg and also this @uref{http://orgmode.org/worg/org-faq.php#mobileorg_webdav, FAQ entry}.}. When MobileOrg first connects to your Dropbox, it will create a directory @i{MobileOrg} inside the Dropbox. After the directory has been created, tell @@ -14139,15 +14364,17 @@ staged with path relative to @code{org-directory}, so all files should be inside this directory. The push operation also creates a special Org file @file{agendas.org} with all custom agenda view defined by the -user@footnote{While creating the agendas, Org-mode will force (see the -variable @code{org-mobile-force-id-on-agenda-items}) ID properties on all -referenced entries, so that these entries can be uniquely -identified if @i{MobileOrg} flags them for further action.}. Finally, Org -writes the file @file{index.org}, containing links to all other files. -@i{MobileOrg} first reads this file from the server, and then downloads all -agendas and Org files listed in it. To speed up the download, MobileOrg will -only read files whose checksums@footnote{stored automatically in the file -@file{checksums.dat}} have changed. +user@footnote{While creating the agendas, Org-mode will force ID properties +on all referenced entries, so that these entries can be uniquely identified +if @i{MobileOrg} flags them for further action. If you do not want to get +these properties in so many entries, you can set the variable +@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode will then +rely on outline paths, in the hope that these will be unique enough.}. +Finally, Org writes the file @file{index.org}, containing links to all other +files. @i{MobileOrg} first reads this file from the server, and then +downloads all agendas and Org files listed in it. To speed up the download, +MobileOrg will only read files whose checksums@footnote{stored automatically +in the file @file{checksums.dat}} have changed. @node Pulling from MobileOrg, , Pushing to MobileOrg, MobileOrg @section Pulling from MobileOrg @@ -14195,12 +14422,12 @@ @kindex C-c a ? If you are not able to process all flagged entries directly, you can always -return to this agenda view using @kbd{C-c a ?}. Note, however, that there is -a subtle difference. The view created automatically by @kbd{M-x -org-mobile-pull @key{RET}} is guaranteed to search all files that have been -addressed by the last pull. This might include a file that is not currently -in your list of agenda files. If you later use @kbd{C-c a ?} to regenerate -the view, only the current agenda files will be searched. +return to this agenda view@footnote{Note, however, that there is a subtle +difference. The view created automatically by @kbd{M-x org-mobile-pull +@key{RET}} is guaranteed to search all files that have been addressed by the +last pull. This might include a file that is not currently in your list of +agenda files. If you later use @kbd{C-c a ?} to regenerate the view, only +the current agenda files will be searched.} using @kbd{C-c a ?}. @node History and Acknowledgments, Main Index, MobileOrg, Top @appendix History and acknowledgments @@ -14331,6 +14558,8 @@ @item @i{Niels Giesen} had the idea to automatically archive DONE trees. @item +@i{Nicolas Goaziou} rewrote much of the plain list code. +@item @i{Kai Grossjohann} pointed out key-binding conflicts with other packages. @item @i{Bernt Hansen} has driven much of the support for auto-repeating tasks, @@ -14482,12 +14711,17 @@ @printindex cp -@node Key Index, Variable Index, Main Index, Top +@node Key Index, Command and Function Index, Main Index, Top @unnumbered Key index @printindex ky -@node Variable Index, , Key Index, Top +@node Command and Function Index, Variable Index, Key Index, Top +@unnumbered Command and function index + +@printindex fn + +@node Variable Index, , Command and Function Index, Top @unnumbered Variable index This is not a complete index of variables and faces, only the ones that are @@ -14504,6 +14738,7 @@ @c Local variables: @c fill-column: 77 +@c indent-tabs-mode: nil @c End:
--- a/etc/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/etc/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,11 @@ +2010-11-13 Eli Zaretskii <eliz@gnu.org> + + * NEWS: Document display of glyphless characters. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * refcards/orgcard.tex: Add new Babel key sequences. + 2010-10-26 Glenn Morris <rgm@gnu.org> * images/README: Add (un)checked.xpm @@ -5104,12 +5112,11 @@ ;; Local Variables: ;; coding: utf-8 -;; add-log-time-zone-rule: t ;; End: - Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2001 - 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002, + 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -5125,5 +5132,3 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; arch-tag: 094f3a51-bd72-44d0-8fac-2ac242c6c5b1
--- a/etc/NEWS Mon Nov 08 14:19:54 2010 +0900 +++ b/etc/NEWS Wed Nov 17 13:09:08 2010 +0900 @@ -138,6 +138,18 @@ Emacs.pane.menubar.faceName: Courier-12 Set faceName to none and use font to use the old X fonts. ++++ +** Enhanced support for characters that have no glyphs in available fonts +If a character has no glyphs in any of the available fonts, Emacs by +default will display it either as a hexadecimal code in a box or as a +thin 1-pixel space. In addition to these two methods, Emacs can +display these characters as empty box, as an acronym, or not display +them at all. To change how these characters are displayed, customize +the variable `glyphless-char-display-control'. + +On character terminals these methods are used for characters that +cannot be encoded by the `terminal-coding-system'. + ** On graphical displays, the mode-line no longer ends in dashes. ** Basic SELinux support has been added. @@ -213,6 +225,9 @@ * Editing Changes in Emacs 24.1 ++++ +** There is a new command `count-words-region', which does what you expect. + ** completion-at-point is now an alias for complete-symbol. ** Deletion changes @@ -289,6 +304,11 @@ * Changes in Specialized Modes and Packages in Emacs 24.1 +** shell-mode can track your cwd by reading it from your prompt. +Just set shell-dir-cookie-re to an appropriate regexp. + +** Modula-2 mode provides auto-indentation. + ** latex-electric-env-pair-mode keeps \begin..\end matched on the fly. ** FIXME: xdg-open for browse-url and reportbug, 2010/08. @@ -523,12 +543,11 @@ * New Modes and Packages in Emacs 24.1 -** New global minor modes electric-pair-mode and electric-indent-mode. +** New global minor modes electric-pair-mode, electric-indent-mode, +and electric-layout-mode. ** pcase.el provides the ML-style pattern matching macro `pcase'. -** smie.el is a package providing a simple generic indentation engine. - ** secrets.el is an implementation of the Secret Service API, an interface to password managers like GNOME Keyring or KDE Wallet. The Secret Service API requires D-Bus for communication. The command @@ -541,6 +560,11 @@ * Incompatible Lisp Changes in Emacs 24.1 +** For mouse click input events in the text area, the Y pixel +coordinate in the POSITION list now counts from the top of the text +area, excluding any header line. Previously, it counted from the top +of the header line. + ** Remove obsolete name `e' (use `float-e' instead). ** A backquote not followed by a space is now always treated as new-style.
--- a/etc/NEWS.23 Mon Nov 08 14:19:54 2010 +0900 +++ b/etc/NEWS.23 Wed Nov 17 13:09:08 2010 +0900 @@ -41,7 +41,10 @@ * New Modes and Packages in Emacs 23.3 - +** smie.el is a generic navigation and indentation engine. +It takes a simple BNF description of the grammar, and provides both +sexp-style navigation (jumping over begin..end pairs) as well as +indentation, which can be adjusted via ad-hoc indentation rules. * Incompatible Lisp Changes in Emacs 23.3 @@ -51,7 +54,7 @@ ** `e' and `pi' are now called `float-e' and `float-pi'. The old names are obsolete. ** The use of unintern without an obarray arg is declared obsolete. - +** The function `princ-list' is declared obsolete. ** New function byte-to-string, like char-to-string but for bytes.
--- a/etc/refcards/orgcard.tex Mon Nov 08 14:19:54 2010 +0900 +++ b/etc/refcards/orgcard.tex Wed Nov 17 13:09:08 2010 +0900 @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{7.01} +\def\orgversionnumber{7.3} \def\versionyear{2010} % latest update \def\year{2010} % latest copyright year @@ -480,14 +480,18 @@ \key{view expanded body of code block at point}{C-c C-v v} \key{go to named code block}{C-c C-v g} \key{go to named result}{C-c C-v r} +\key{go to the head of the current code block}{C-c C-v u} \key{go to the next code block}{C-c C-v n} \key{go to the previous code block}{C-c C-v p} +\key{demarcate a code block}{C-c C-v d} +\key{execute the next key sequence in the code edit buffer}{C-c C-v x} \key{execute all code blocks in current buffer}{C-c C-v b} \key{execute all code blocks in current subtree}{C-c C-v s} \key{tangle code blocks in current file}{C-c C-v t} \key{tangle code blocks in supplied file}{C-c C-v f} -\key{ingest all code blocks in supplied file into the Library of Babel}{C-c C-v l} +\key{ingest all code blocks in supplied file into the Library of Babel}{C-c C-v i} \key{switch to the session of the current code block}{C-c C-v z} +\key{load expanded body of the current code block into a session}{C-c C-v l} \key{view sha1 hash of the current code block}{C-c C-v a} % \section{Remember-mode Integration}
--- a/lib-src/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/lib-src/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,9 @@ +2010-11-15 Dan Nicolaescu <dann@ics.uci.edu> + + * test-distrib.c: Remove include guards for config.h and fcntl.h. + (O_RDONLY): Do not define. + (cool_read): Fix type for variable "sofar". + 2010-10-25 Glenn Morris <rgm@gnu.org> * makefile.w32-in (OTHER_PLATFORM_SUPPORT): Remove easymenu.elc.
--- a/lib-src/test-distrib.c Mon Nov 08 14:19:54 2010 +0900 +++ b/lib-src/test-distrib.c Wed Nov 17 13:09:08 2010 +0900 @@ -19,24 +19,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ -#ifdef HAVE_CONFIG_H #include <config.h> -#endif - #include <stdio.h> - -#ifdef HAVE_FCNTL_H #include <fcntl.h> -#endif #ifdef HAVE_UNISTD_H #include <unistd.h> #endif -#ifndef O_RDONLY -#define O_RDONLY 0 -#endif - /* Break string in two parts to avoid buggy C compilers that ignore characters after nulls in strings. */ @@ -55,7 +45,7 @@ cool_read (int fd, char *buf, size_t size) { ssize_t num; - size_t sofar = 0; + ssize_t sofar = 0; while (1) {
--- a/lisp/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,447 @@ +2010-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave-mod.el: Rely on elecric-*-modes. + (octave-mode-map): Don't bind ;, SPC, and LF. + (octave-auto-indent, octave-auto-newline): Remove. + (electric-layout-rules): Declare. + (octave-mode): Set electric-layout-rules. + (octave-indent-new-comment-line): Use reindent-then-newline-and-indent. + (octave-reindent-then-newline-and-indent, octave-electric-semi) + (octave-electric-space): Remove. + + * electric.el (electric-layout-mode): New minor mode. + (electric--after-char-pos): New function. + (electric-indent-post-self-insert-function): Use it. + (electric-layout-rules): New var. + (electric-layout-post-self-insert-function): New function. + (electric-indent-mode): Make them interact better. + +2010-11-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/checkdoc.el (checkdoc-syntax-table): Fix last change. + (checkdoc-sentencespace-region-engine, checkdoc-this-string-valid) + (checkdoc-proper-noun-region-engine): Use with-syntax-table. + +2010-11-15 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/flyspell.el (flyspell-generic-progmode-verify): + Make sure to check inside the word (Bug#6761). + +2010-11-14 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line): If the cursorColor resource is set, + change the cursor face-spec (Bug#7392). + +2010-11-13 Ken Manheimer <ken.manheimer@gmail.com> + + The main features of the following allout.el changes are: + - implement user customization for the allout key bindings + - add a customization control by which the user can inhibit use of + a trailing Ctrl-H, so by default it's reserved for use with + describe-prefix-bindings + - adapt to new version of called-interactively-p, while + maintaining backwards compatibility with old version + - fix hotspot navigation so i works properly with meta-modified keys + + * allout.el (allout-keybindings, allout-bind-keys) + (allout-keybindings-binding, allout-prefixed-keybindings) + (allout-unprefixed-keybindings, allout-preempt-trailing-ctrl-h) + (allout-keybindings-list, allout-mode-map-adjustments) + (allout-setup-mode-map): Establish allout-mode keymaps as user + customizable settings, and also establish a customizable setting which + regulates whether or not a trailing control-h is reserved for use with + describe-prefix-bindings - and inhibit it by default, so that control-h + *is* reserved for describe-prefix-bindings unless the user changes it. + + * allout.el (allout-hotspot-key-handler): Distinguish more explicitly + and accurately between modified and unmodified events, and handle + modified events more comprehensively. + + * allout.el (allout-substring-no-properties): + Alias to use or provide version of `substring-no-properties'. + (allout-solicit-alternate-bullet): Use `allout-substring-no-properties'. + + * allout.el (allout-next-single-char-property-change): + Alias to use or provide version of `next-single-char-property-change'. + (allout-annotate-hidden, allout-hide-by-annotation): + Use `allout-next-single-char-property-change'. + + * allout.el (allout-select-safe-coding-system): + Alias to use or provide version of `select-safe-coding-system'. + (allout-toggle-subtree-encryption): + Use `allout-select-safe-coding-system'. + + * allout.el (allout-set-buffer-multibyte): + Alias to use or provide version of `set-buffer-multibyte'. + (allout-encrypt-string): Use `allout-set-buffer-multibyte'. + + * allout.el (allout-called-interactively-p): Macro for using the + different versions of called-interactively-p identically, depending on + the subroutine's argument signature. + (allout-back-to-current-heading, allout-beginning-of-current-entry): + Use `(interactive "p")' instead of `(called-interactively-p)'. + + * allout.el (allout-init, allout-ascend, allout-end-of-level) + (allout-previous-visible-heading, allout-forward-current-level) + (allout-backward-current-level, allout-show-children): + Use `allout-called-interactively-p' instead of `called-interactively-p'. + + * allout.el (allout-before-change-handler): + Exempt edits to the (overlaid) character after the allout outline + bullet from edit confirmation prompt. + + * allout.el (allout-add-resumptions): + Ensure that it respects correct buffer for keybindings. + + * allout.el (allout-beginning-of-line): + Use `allout-previous-single-char-property-change' alias for the sake of + diverse compatibility. + + * allout.el (allout-end-of-line): + Use `allout-mark-active-p' to encapsulate respect for mark activity. + +2010-11-13 Chong Yidong <cyd@stupidchicken.com> + + * frame.el (frame-notice-user-settings): Don't clobber other + user-set parameters when calling face-set-after-frame-default in + response to background-color parameter (Bug#7373). + +2010-11-13 Eli Zaretskii <eliz@gnu.org> + + * international/characters.el (glyphless-char-display-control): + Renamed from glyphless-char-control; all users changed. Doc fix. + Signal an error if display method is not one of the recognized + symbols. + +2010-11-13 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-compat.el (tramp-compat-line-beginning-position) + (tramp-compat-line-end-position): Remove them. + + * net/tramp.el (tramp-parse-rhosts-group) + (tramp-parse-shosts-group, tramp-parse-sconfig-group) + (tramp-parse-hosts-group, tramp-parse-passwd-group) + (tramp-parse-netrc-group, tramp-parse-putty-group) + * net/tramp-cmds.el (tramp-append-tramp-buffers) + * net/tramp-sh.el (tramp-do-file-attributes-with-ls) + (tramp-sh-handle-file-selinux-context) + (tramp-sh-handle-file-name-all-completions) + (tramp-sh-handle-insert-directory) + (tramp-sh-handle-expand-file-name, tramp-find-executable) + (tramp-wait-for-output, tramp-send-command-and-read) + * net/tramp-smb.el (tramp-smb-read-file-entry) + (tramp-smb-get-cifs-capabilities): Use `point-at-eol'. + + * net/tramp-sh.el (tramp-sh-handle-insert-directory) Use + `point-at-bol'. + (tramp-remote-coding-commands): Add an alternative using "base64 + -d -i". This is needed for older base64 versions from GNU + coreutils. Reported by Klaus Reichl + <Klaus.Reichl@thalesgroup.com>. + +2010-11-13 Hrvoje Niksic <hniksic@xemacs.org> + + * simple.el (count-words-region): New function. + +2010-11-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * shell.el (shell-dir-cookie-re): New custom variable. + (shell-dir-cookie-watcher): New function. + + * vc/vc.el (vc-deduce-backend): Use default-directory in shell-mode + and compilation-mode (bug#7350). + + * vc/smerge-mode.el (smerge-refine): Choose better default part to + highlight when one of them is empty. + + * skeleton.el (skeleton-read): Don't use `newline' since it may strip + trailing space. + (skeleton-newline): New function. + (skeleton-internal-1): Use it. + + * simple.el (open-line): `newline' may strip trailing space. + +2010-11-12 Kevin Ryde <user42@zip.com.au> + + * international/mule-cmds.el (princ-list): Use mapc. + +2010-11-12 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-log-buffer): New constant. + Use it to replace all instances of "*Compile-Log*" + +2010-11-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase-let*, pcase-let): Add debug and + indentation specs. + +2010-11-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/modula2.el: Use SMIE and skeleton. + (m2-mode-syntax-table): (*..*) can be nested. + Add //...\n. Fix paren syntax. + (m2-mode-map): Remove LF and TAB bindings. + (m2-indent): Add safety property. + (m2-smie-grammar): New var. + (m2-smie-refine-colon, m2-smie-refine-of, m2-smie-backward-token) + (m2-smie-forward-token, m2-smie-refine-semi, m2-smie-rules): New funs. + (m2-mode): Use define-derived-mode. + (m2-newline, m2-tab): Remove. + (m2-begin, m2-case, m2-definition, m2-else, m2-for, m2-header) + (m2-if, m2-loop, m2-module, m2-or, m2-procedure, m2-with, m2-record) + (m2-stdio, m2-type, m2-until, m2-var, m2-while, m2-export) + (m2-import): Use define-skeleton. + +2010-11-11 Glenn Morris <rgm@gnu.org> + + * obsolete/lucid.el: Don't warn about any CL functions in this file. + + * ls-lisp.el (ls-lisp-ignore-case, ls-lisp-dirs-first) + (ls-lisp-verbosity): Add custom :set-after property. + (ls-lisp-verbosity, ls-lisp-use-localized-time-format): Doc fixes. + (ls-lisp-format, ls-lisp-format-time): Don't take `now' as an argument. + (ls-lisp-insert-directory): Update caller. + (ls-lisp-set-options): New function. + (ls-lisp-emulation): Use ls-lisp-set-options for custom :set. + Doc fix. + + * play/landmark.el (lm-prompt-for-move): + * play/gomoku.el (gomoku-prompt-for-move): Remove nonsensical code. + + * progmodes/idlw-complete-structtag.el: Remove unused dec `name'. + + * progmodes/idlwave.el (idlwave-routine-entry-compare-twins) + (idlwave-study-twins): Prefix dynamic local variable `name'. + (idlwave-routine-twin-compare): Update for above change. + + * progmodes/idlw-help.el (idlwave-do-mouse-completion-help): + Prefix dynamic local variables `name', `kwd', and `link'. + * progmodes/idlw-shell.el (idlwave-shell-complete-execcomm-help): + * progmodes/idlw-complete-structtag.el + (idlwave-complete-structure-tag-help): + * progmodes/idlwave.el (idlwave-complete-sysvar-help) + (idlwave-complete-sysvar-tag-help) + (idlwave-complete-class-structure-tag-help): + Update for above name changes. + +2010-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/browse-url.el (browse-url-browser-function): Change the + default to use `browse-url-mail' on mailto: URLs. + +2010-11-10 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-read-all-archive-contents): + Reset package-archive-contents to nil before re-reading. + +2010-11-10 Brandon Craig Rhodes <brandon@rhodesmill.org> (tiny change) + + * textmodes/flyspell.el (flyspell-word): Do not re-check words + already found as misspellings by (flyspell-large-region), just + do highlighting (bug#7322). + +2010-11-10 Glenn Morris <rgm@gnu.org> + + * progmodes/octave-mod.el (octave-mark-block): Update for smie change. + + * emulation/edt.el (edt-with-position): New macro. + (edt-find-forward, edt-find-backward, edt-find-next-forward) + (edt-find-next-backward, edt-sentence-forward, edt-sentence-backward) + (edt-paragraph-forward, edt-paragraph-backward): Use it. + + * emulation/tpu-extras.el (tpu-with-position): New macro. + (tpu-paragraph, tpu-page, tpu-search-internal): Use it. + + * textmodes/texnfo-upd.el (texinfo-pointer-name): Fix typo. + + * textmodes/texnfo-upd.el (texinfo-all-menus-update) + (texinfo-menu-copy-old-description, texinfo-start-menu-description) + (texinfo-master-menu, texinfo-insert-node-lines) + (texinfo-multiple-files-update): + * textmodes/texinfmt.el (texinfo-append-refill, texinfo-copying): + Use line-beginning-position. + + * progmodes/cperl-mode.el (cperl-find-pods-heres, cperl-write-tags): + No recent Emacs supports system-type `emx'. + + * progmodes/ada-xref.el (is-windows): Rename to ada-on-ms-windows. + (ada-command-separator, ada-default-prj-properties) + (ada-find-any-references): Update for above name change. + + * dirtrack.el (dirtrack-directory-function) + (dirtrack-canonicalize-function): + * filecache.el (file-cache-completion-ignore-case) + (file-cache-case-fold-search, file-cache-ignore-case): + * term.el (serial-port-is-file-p): Cosmetic change. + + * emulation/viper-init.el (viper-ms-style-os-p): Doc fix. + Remove non-existent `windows-95' system-type. + * dired.el (dired-chown-program): Remove non-existent `linux' + system-type. + + * net/net-utils.el (net-utils-remove-ctl-m): Use memq for system-types. + (ping-program-options): Remove non-existent `linux' system-type. + + * startup.el (package-initialize): Update declaration. + + * ls-lisp.el (ls-lisp-time-lessp, ls-lisp-time-to-seconds): Remove. + (ls-lisp-handle-switches): Use time-less-p. + (ls-lisp-format-time): Use float-time. + + * textmodes/remember.el (remember-time-to-seconds): Remove. + (remember-store-in-mailbox): Use float-time. + + * calendar/timeclock.el (timeclock-time-to-seconds): Make it an alias. + + * calendar/time-date.el (time-to-seconds): Always an alias on Emacs, + never a real function. + (with-no-warnings): Remove compat stub, now unused. + (time-less-p): Doc fix. + (time-to-number-of-days): Simplify. + + * eshell/esh-util.el (eshell-time-less-p, eshell-time-to-seconds): + Remove. + (eshell-read-passwd, eshell-read-hosts): Use time-less-p. + * eshell/esh-test.el (eshell-test, eshell-show-usage-metrics): + * eshell/em-unix.el (eshell-show-elapsed-time, eshell/time): + * eshell/em-pred.el (eshell-pred-file-time): Use float-time. + * eshell/em-ls.el (eshell-ls-sort-entries): Use time-less-p. + + * eshell/em-unix.el (eshell-remove-entries, eshell/rm) + (eshell-shuffle-files, eshell-shorthand-tar-command) + (eshell-mvcpln-template, eshell/mv, eshell/cp, eshell/ln): + Prefix dynamic locals `interactive', `preview', `recursive', `verbose'. + * eshell/em-glob.el (eshell-extended-glob, eshell-glob-entries): + Prefix dynamic local variable `matches'. + + * skeleton.el (skeleton-internal-list, skeleton-internal-1): + Prefix dynamic local variable `skeleton'. + +2010-11-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * net/browse-url.el (browse-url-mail): Insert body part of mailto url + in mail buffer; make yank-action always a command that yanks original + buffer. + +2010-11-09 Glenn Morris <rgm@gnu.org> + + * progmodes/tcl.el (tcl-hairy-scan-for-comment): Doc fix. + +2010-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (minibuffer-completion-help): Specify the end of the + completion field (bug#7211). + + * progmodes/python.el (python-font-lock-syntactic-keywords): (bug#7322) + Fix handling of backslash escapes. + (python-quote-syntax): Adjust accordingly. + +2010-11-09 Richard Levitte <richard@levitte.org> (tiny change) + + * vc-mtn.el (vc-mtn-working-revision, vc-mtn-after-dir-status) + (vc-mtn-workfile-branch): Adjust to new output format. + +2010-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/mule-cmds.el (princ-list): Mark as obsolete. + +2010-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el: New package. + +2010-11-09 Michael Albinus <michael.albinus@gmx.de> + + * files.el (backup-by-copying-when-mismatch): + Set `permanent-local' property. + + * net/tramp.el (tramp-handle-insert-file-contents): Do not set + `permanent-local' property for `backup-by-copying-when-mismatch'. + +2010-11-09 Eli Zaretskii <eliz@gnu.org> + + * ls-lisp.el (insert-directory): Doc fix. (bug#7285) + +2010-11-09 Wilson Snyder <wsnyder@wsnyder.org> + + * progmodes/verilog-mode.el (verilog-insert-one-definition) + (verilog-read-decls, verilog-read-sub-decls-sig): Fix AUTOWIRE and + AUTOINOUT for SV style multidimensional arrays, bug294. + Reported by Eric Mastromarchi. + (verilog-preprocess): Use with-current-buffer and + font-lock-fontify-buffer to cleanup style issues. + +2010-11-09 Glenn Morris <rgm@gnu.org> + + * locate.el (locate, locate-mode): Doc fixes. + +2010-11-09 Chong Yidong <cyd@stupidchicken.com> + + * server.el (server-start): New arg INHIBIT-PROMPT prevents asking + user for confirmation. + (server-force-stop): Use it. + (server-start): Use server-force-stop for kill-emacs-hook, to + avoid user interaction while killing Emacs. + +2010-11-09 Glenn Morris <rgm@gnu.org> + + * progmodes/meta-mode.el: Remove leading `*' from defcustom docs. + (meta-indent-line): Simplify. + + * vc/emerge.el (emerge-line-number-in-buf): + * textmodes/ispell.el (ispell-region): + * textmodes/fill.el (current-fill-column): + * progmodes/xscheme.el (xscheme-send-current-line): + * progmodes/vhdl-mode.el (vhdl-current-line, vhdl-line-copy): + * progmodes/tcl.el (tcl-hairy-scan-for-comment): + * progmodes/sh-script.el (sh-handle-prev-do): + * progmodes/meta-mode.el (meta-indent-line): + * progmodes/idlwave.el (idlwave-goto-comment, idlwave-fill-paragraph) + (idlwave-in-quote): + * progmodes/idlw-shell.el (idlwave-shell-current-frame) + (idlwave-shell-update-bp-overlays, idlwave-shell-sources-filter): + * progmodes/fortran.el (fortran-looking-at-if-then): + * progmodes/etags.el (find-tag-in-order, etags-snarf-tag): + * progmodes/cperl-mode.el (cperl-sniff-for-indent) + (cperl-find-pods-heres): + * progmodes/ada-mode.el (ada-get-current-indent, ada-narrow-to-defun): + * net/quickurl.el (quickurl-list-insert): + * net/ldap.el (ldap-search-internal): + * net/eudc.el (eudc-expand-inline): + * mail/sendmail.el (sendmail-send-it): + * mail/mspools.el (mspools-visit-spool, mspools-get-spool-name): + * emulation/viper-cmd.el (viper-paren-match, viper-backward-indent) + (viper-brac-function): + * calc/calc-yank.el (calc-do-grab-region): + * calc/calc-keypd.el (calc-keypad-press): + * term.el (term-move-columns, term-insert-spaces): + * speedbar.el (speedbar-highlight-one-tag-line): + * simple.el (current-word): + * mouse-drag.el (mouse-drag-should-do-col-scrolling): + * info.el (Info-find-node-in-buffer-1, Info-follow-reference) + (Info-scroll-down): + * hippie-exp.el (he-line-beg): + * epa.el (epa--marked-keys): + * dired-aux.el (dired-kill-line, dired-do-kill-lines) + (dired-update-file-line, dired-add-entry, dired-remove-entry) + (dired-relist-entry): + * buff-menu.el (Buffer-menu-buffer): + * array.el (current-line): + * allout.el (allout-resolve-xref) + (allout-latex-verbatim-quote-curr-line): + Replace yet more uses of end-of-line etc with line-end-position, etc. + +2010-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/checkdoc.el (checkdoc-display-status-buffer) + (checkdoc-interactive-loop, checkdoc-recursive-edit): Avoid princ-list. + (checkdoc-syntax-table): Initialize in the declaration. + (emacs-lisp-mode-hook): Use just checkdoc-minor-mode now that it turns + the mode on unconditionally. + + * emacs-lisp/cl-macs.el (extent-data, extent-face, extent-priority) + (extent-end-position, extent-start-position): Remove setf method for + non-existing functions (bug#7319). + 2010-11-07 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el: Simplify the smie-rules-function return values. @@ -924,7 +1368,7 @@ * newcomment.el (comment-dwim): Fix the intentation in the doc string. -010-10-21 Michael Albinus <michael.albinus@gmx.de> +2010-10-21 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-do-file-attributes-with-stat): Do not use space in stat format string.
--- a/lisp/Makefile.in Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/Makefile.in Wed Nov 17 13:09:08 2010 +0900 @@ -180,6 +180,7 @@ els=`echo $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | sed -e "s,$(lisp)/[^ ]*loaddefs[^ ]*,," -e "s,$(lisp)/ldefs-boot[^ ]*,,"`; \ ${ETAGS} -o $@ $$els + $(lisp)/emacs-lisp/smie.elc \ # The src/Makefile.in has its own set of dependencies and when they decide # that one Lisp file needs to be re-compiled, we had better recompile it as # well, otherwise every subsequent make will again call us, until we finally
--- a/lisp/allout.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/allout.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> ;; Created: Dec 1991 -- first release to usenet -;; Version: 2.2.1 +;; Version: 2.2.2 ;; Keywords: outlines wp languages ;; Website: http://myriadicity.net/Sundry/EmacsAllout @@ -98,21 +98,142 @@ ;;;_* USER CUSTOMIZATION VARIABLES: -;;;_ > defgroup allout +;;;_ > defgroup allout, allout-keybindings (defgroup allout nil "Extensive outline mode for use alone and with other modes." :prefix "allout-" :group 'outlines) +(defgroup allout-keybindings nil + "Allout outline mode keyboard bindings configuration." + :group 'allout) ;;;_ + Layout, Mode, and Topic Header Configuration -;;;_ = allout-command-prefix +;;;_ > allout-keybindings incidentals: +;;;_ > allout-bind-keys &optional varname value +(defun allout-bind-keys (&optional varname value) + "Rebuild the `allout-mode-map' according to the keybinding specs. + +Useful standalone, to init the map, or in customizing the +respective allout-mode keybinding variables, `allout-command-prefix', +`allout-prefixed-keybindings', and `allout-unprefixed-keybindings'" + ;; Set the customization variable, if any: + (when varname + (set-default varname value)) + (let ((map (make-sparse-keymap)) + key) + (when (boundp 'allout-prefixed-keybindings) + ;; Be tolerant of the moments when the variables are first being defined. + (dolist (entry allout-prefixed-keybindings) + (define-key map + ;; XXX vector vs non-vector key descriptions? + (vconcat allout-command-prefix + (car (read-from-string (car entry)))) + (cadr entry)))) + (when (boundp 'allout-unprefixed-keybindings) + (dolist (entry allout-unprefixed-keybindings) + (define-key map (car (read-from-string (car entry))) (cadr entry)))) + (setq allout-mode-map map) + map + )) +;;;_ = allout-command-prefix (defcustom allout-command-prefix "\C-c " "Key sequence to be used as prefix for outline mode command key bindings. Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're willing to let allout use a bunch of \C-c keybindings." :type 'string + :group 'allout-keybindings + :set 'allout-bind-keys) +;;;_ = allout-keybindings-binding +(define-widget 'allout-keybindings-binding 'lazy + "Structure of allout keybindings customization items." + :type '(repeat + (list (string :tag "Key" :value "[(meta control shift ?f)]") + (function :tag "Function name" + :value allout-forward-current-level)))) +;;;_ = allout-prefixed-keybindings +(defcustom allout-prefixed-keybindings + '(("[(control ?n)]" allout-next-visible-heading) + ("[(control ?p)]" allout-previous-visible-heading) +;; ("[(control ?u)]" allout-up-current-level) + ("[(control ?f)]" allout-forward-current-level) + ("[(control ?b)]" allout-backward-current-level) + ("[(control ?a)]" allout-beginning-of-current-entry) + ("[(control ?e)]" allout-end-of-entry) + ("[(control ?i)]" allout-show-children) + ("[(control ?i)]" allout-show-children) + ("[(control ?s)]" allout-show-current-subtree) + ("[(control ?t)]" allout-toggle-current-subtree-exposure) + ("[(control ?h)]" allout-hide-current-subtree) + ("[?h]" allout-hide-current-subtree) + ("[(control ?o)]" allout-show-current-entry) + ("[?!]" allout-show-all) + ("[?x]" allout-toggle-current-subtree-encryption) + ("[? ]" allout-open-sibtopic) + ("[?.]" allout-open-subtopic) + ("[?,]" allout-open-supertopic) + ("[?']" allout-shift-in) + ("[?>]" allout-shift-in) + ("[?<]" allout-shift-out) + ("[(control ?m)]" allout-rebullet-topic) + ("[?*]" allout-rebullet-current-heading) + ("[?']" allout-number-siblings) + ("[(control ?k)]" allout-kill-topic) + ("[??]" allout-copy-topic-as-kill) + ("[?@]" allout-resolve-xref) + ("[?=?c]" allout-copy-exposed-to-buffer) + ("[?=?i]" allout-indented-exposed-to-buffer) + ("[?=?t]" allout-latexify-exposed) + ("[?=?p]" allout-flatten-exposed-to-buffer) + ) + "Allout-mode key bindings that are prefixed with `allout-command-prefix'. + +See `allout-unprefixed-keybindings' for the list of keybindings +that are not prefixed. + +Use vector format for the keys: + - put literal keys after a '?' question mark, eg: '?a', '?.' + - enclose control, shift, or meta-modified keys as sequences within + parentheses, with the literal key, as above, preceded by the name(s) + of the modifers, eg: [(control ?a)] +See the existing keys for examples. + +Functions can be bound to multiple keys, but binding keys to +multiple functions will not work - the last binding for a key +prevails." + :type 'allout-keybindings-binding + :group 'allout-keybindings + :set 'allout-bind-keys + ) +;;;_ = allout-unprefixed-keybindings +(defcustom allout-unprefixed-keybindings + '(("[(control ?k)]" allout-kill-line) + ("[??(meta ?k)]" allout-copy-line-as-kill) + ("[(control ?y)]" allout-yank) + ("[??(meta ?y)]" allout-yank-pop) + ) + "Allout-mode functions bound to keys without any added prefix. + +This is in contrast to the majority of allout-mode bindings on +`allout-prefixed-bindings', whose bindings are created with a +preceeding command key. + +Use vector format for the keys: + - put literal keys after a '?' question mark, eg: '?a', '?.' + - enclose control, shift, or meta-modified keys as sequences within + parentheses, with the literal key, as above, preceded by the name(s) + of the modifers, eg: [(control ?a)] +See the existing keys for examples." + :type 'allout-keybindings-binding + :group 'allout-keybindings + :set 'allout-bind-keys + ) + +;;;_ = allout-preempt-trailing-ctrl-h +(defcustom allout-preempt-trailing-ctrl-h nil + "Use <prefix>-\C-h, instead of leaving it for describe-prefix-bindings?" + :type 'boolean :group 'allout) ;;;_ = allout-keybindings-list @@ -133,9 +254,13 @@ ("\C-a" allout-beginning-of-current-entry) ("\C-e" allout-end-of-entry) ; Exposure commands: - ("\C-i" allout-show-children) + ([(control i)] allout-show-children) ; xemacs translates "\C-i" to tab + ("\C-i" allout-show-children) ; but we still need this for hotspot ("\C-s" allout-show-current-subtree) - ("\C-h" allout-hide-current-subtree) + ;; binding to \C-h is included if allout-preempt-trailing-ctrl-h, + ;; so user controls whether or not to preempt the conventional ^H + ;; binding to help-command. + ("\C-h" allout-hide-current-subtree) ("\C-t" allout-toggle-current-subtree-exposure) ("h" allout-hide-current-subtree) ("\C-o" allout-show-current-entry) @@ -753,7 +878,7 @@ ;;;_ + Developer ;;;_ = allout-developer group (defgroup allout-developer nil - "Settings for topic encryption features of allout outliner." + "Allout settings developers care about, including topic encryption and more." :group 'allout) ;;;_ = allout-run-unit-tests-on-load (defcustom allout-run-unit-tests-on-load nil @@ -792,7 +917,7 @@ ;;;_ #1 Internal Outline Formatting and Configuration ;;;_ : Version ;;;_ = allout-version -(defvar allout-version "2.2.1" +(defvar allout-version "2.2.2" "Version of currently loaded outline package. (allout.el)") ;;;_ > allout-version (defun allout-version (&optional here) @@ -1163,6 +1288,13 @@ (car (cdr cell))))))) keymap-list) map)) +;;;_ > allout-mode-map-adjustments (base-map) +(defun allout-mode-map-adjustments (base-map) + "Do conditional additions to specified base-map, like inclusion of \\C-h." + (if allout-preempt-trailing-ctrl-h + (cons '("\C-h" allout-hide-current-subtree) base-map) + base-map) + ) ;;;_ : Menu bar (defvar allout-mode-exposure-menu) (defvar allout-mode-editing-menu) @@ -1278,7 +1410,7 @@ (void-variable nil))) (when (not (assoc name allout-mode-prior-settings)) ;; Not already added as a resumption, create the prior setting entry. - (if (local-variable-p name) + (if (local-variable-p name (current-buffer)) ;; is already local variable -- preserve the prior value: (push (list name prior-value) allout-mode-prior-settings) ;; wasn't local variable, indicate so for resumption by killing @@ -1541,6 +1673,14 @@ (goto-char (cadr allout-after-save-decrypt)) (setq allout-after-save-decrypt nil)) ) +;;;_ > allout-called-interactively-p () +(defmacro allout-called-interactively-p () + "A version of called-interactively-p independent of emacs version." + ;; ... to ease maintenance of allout without betraying deprecation. + (if (equal (subr-arity (symbol-function 'called-interactively-p)) + '(0 . 0)) + '(called-interactively-p) + '(called-interactively-p 'interactive))) ;;;_ = allout-inhibit-aberrance-doublecheck nil ;; In some exceptional moments, disparate topic depths need to be allowed ;; momentarily, eg when one topic is being yanked into another and they're @@ -1554,7 +1694,7 @@ This should only be momentarily let-bound non-nil, not set non-nil in a lasting way.") -;;;_ #2 Mode activation +;;;_ #2 Mode environment and activation ;;;_ = allout-explicitly-deactivated (defvar allout-explicitly-deactivated nil "If t, `allout-mode's last deactivation was deliberate. @@ -1590,7 +1730,7 @@ \(allout-init t)" (interactive) - (if (called-interactively-p 'interactive) + (if (allout-called-interactively-p) (progn (setq mode (completing-read @@ -1614,7 +1754,7 @@ (cond ((not mode) (set find-file-hook-var-name (delq hook (symbol-value find-file-hook-var-name))) - (if (called-interactively-p 'interactive) + (if (allout-called-interactively-p) (message "Allout outline mode auto-activation inhibited."))) ((eq mode 'report) (if (not (memq hook (symbol-value find-file-hook-var-name))) @@ -1656,7 +1796,7 @@ (setplist 'allout-exposure-category nil) (put 'allout-exposure-category 'invisible 'allout) (put 'allout-exposure-category 'evaporate t) - ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The + ;; ??? We use isearch-open-invisible *and* isearch-mode-end-hook. The ;; latter would be sufficient, but it seems that a separate behavior -- ;; the _transient_ opening of invisible text during isearch -- is keyed to ;; presence of the isearch-open-invisible property -- even though this @@ -2116,9 +2256,11 @@ (defun allout-setup-mode-map () "Establish allout-mode bindings." (setq-default allout-mode-map - (produce-allout-mode-map allout-keybindings-list)) + (produce-allout-mode-map + (allout-mode-map-adjustments allout-keybindings-list))) (setq allout-mode-map - (produce-allout-mode-map allout-keybindings-list)) + (produce-allout-mode-map + (allout-mode-map-adjustments allout-keybindings-list))) (substitute-key-definition 'beginning-of-line 'allout-beginning-of-line allout-mode-map global-map) @@ -2153,7 +2295,7 @@ ;;;_ - Position Assessment ;;;_ > allout-hidden-p (&optional pos) (defsubst allout-hidden-p (&optional pos) - "Non-nil if the character after point is invisible." + "Non-nil if the character after point was made invisible by allout." (eq (get-char-property (or pos (point)) 'invisible) 'allout)) ;;;_ > allout-overlay-insert-in-front-handler (ol after beg end @@ -2162,8 +2304,8 @@ &optional prelen) "Shift the overlay so stuff inserted in front of it is excluded." (if after - ;; XXX Shouldn't moving the overlay should be unnecessary, if overlay - ;; front-advance on the overlay worked as it should? + ;; ??? Shouldn't moving the overlay should be unnecessary, if overlay + ;; front-advance on the overlay worked as expected? (move-overlay ol (1+ beg) (overlay-end ol)))) ;;;_ > allout-overlay-interior-modification-handler (ol after beg end ;;; &optional prelen) @@ -2225,8 +2367,9 @@ (save-excursion (goto-char beg) (let ((overlay (allout-get-invisibility-overlay))) - (allout-overlay-interior-modification-handler - overlay nil beg end nil))))) + (if overlay + (allout-overlay-interior-modification-handler + overlay nil beg end nil)))))) ;;;_ > allout-isearch-end-handler (&optional overlay) (defun allout-isearch-end-handler (&optional overlay) "Reconcile allout outline exposure on arriving in hidden text after isearch. @@ -2508,7 +2651,7 @@ ;;;_ > allout-end-of-current-line () (defun allout-end-of-current-line () "Move to the end of line, past concealed text if any." - ;; XXX This is for symmetry with `allout-beginning-of-current-line' -- + ;; This is for symmetry with `allout-beginning-of-current-line' -- ;; `move-end-of-line' doesn't suffer the same problem as ;; `move-beginning-of-line'. (let ((inhibit-field-text-motion t)) @@ -2527,7 +2670,7 @@ (progn (if (and (not (bolp)) (allout-hidden-p (1- (point)))) - (goto-char (previous-single-char-property-change + (goto-char (allout-previous-single-char-property-change (1- (point)) 'invisible))) (move-beginning-of-line 1)) (allout-depth) @@ -2573,9 +2716,20 @@ (allout-back-to-current-heading) (allout-end-of-current-line)) (t - (if (not (and transient-mark-mode mark-active)) + (if (not (allout-mark-active-p)) (push-mark)) (allout-end-of-entry)))))) +;;;_ > allout-mark-active-p () +(defun allout-mark-active-p () + "True if the mark is currently or always active." + ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler + ;; provisions, at least in fsf emacs to prevent warnings about lack of, + ;; eg, region-active-p. + (cond ((boundp 'mark-active) + mark-active) + ((fboundp 'region-active-p) + (region-active-p)) + (t))) ;;;_ > allout-next-heading () (defsubst allout-next-heading () "Move to the heading for the topic (possibly invisible) after this one. @@ -2888,8 +3042,8 @@ (if (not (allout-current-depth)) nil (1- allout-recent-prefix-end))) -;;;_ > allout-back-to-current-heading () -(defun allout-back-to-current-heading () +;;;_ > allout-back-to-current-heading (&optional interactive) +(defun allout-back-to-current-heading (&optional interactive) "Move to heading line of current topic, or beginning if not in a topic. If interactive, we position at the end of the prefix. @@ -2897,11 +3051,13 @@ Return value of resulting point, unless we started outside of (before any) topics, in which case we return nil." + (interactive "p") + (allout-beginning-of-current-line) (let ((bol-point (point))) (if (allout-goto-prefix-doublechecked) (if (<= (point) bol-point) - (if (called-interactively-p 'interactive) + (if interactive (allout-end-of-prefix) (point)) (goto-char (point-min)) @@ -2955,20 +3111,20 @@ Returns the value of point." (interactive) (allout-end-of-subtree t include-trailing-blank)) -;;;_ > allout-beginning-of-current-entry () -(defun allout-beginning-of-current-entry () +;;;_ > allout-beginning-of-current-entry (&optional interactive) +(defun allout-beginning-of-current-entry (&optional interactive) "When not already there, position point at beginning of current topic header. If already there, move cursor to bullet for hot-spot operation. \(See `allout-mode' doc string for details of hot-spot operation.)" - (interactive) + (interactive "p") (let ((start-point (point))) (move-beginning-of-line 1) (if (< 0 (allout-current-depth)) (goto-char allout-recent-prefix-end) (goto-char (point-min))) (allout-end-of-prefix) - (if (and (called-interactively-p 'interactive) + (if (and interactive (= (point) start-point)) (goto-char (allout-current-bullet-pos))))) ;;;_ > allout-end-of-entry (&optional inclusive) @@ -3018,9 +3174,9 @@ (while (and (< depth allout-recent-depth) (setq last-ascended (allout-ascend)))) (goto-char allout-recent-prefix-beginning) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)) + (if (allout-called-interactively-p) (allout-end-of-prefix)) (and last-ascended allout-recent-depth)))) -;;;_ > allout-ascend () +;;;_ > allout-ascend (&optional dont-move-if-unsuccessful) (defun allout-ascend (&optional dont-move-if-unsuccessful) "Ascend one level, returning resulting depth if successful, nil if not. @@ -3046,7 +3202,7 @@ (goto-char bolevel) (allout-depth) nil)))) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)))) + (if (allout-called-interactively-p) (allout-end-of-prefix)))) ;;;_ > allout-descend-to-depth (depth) (defun allout-descend-to-depth (depth) "Descend to depth DEPTH within current topic. @@ -3074,7 +3230,7 @@ (if (not (allout-ascend)) (progn (goto-char start-point) (error "Can't ascend past outermost level")) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)) + (if (allout-called-interactively-p) (allout-end-of-prefix)) allout-recent-prefix-beginning))) ;;;_ - Linear @@ -3219,7 +3375,7 @@ (let ((depth (allout-depth))) (while (allout-previous-sibling depth nil)) (prog1 allout-recent-depth - (if (called-interactively-p 'interactive) (allout-end-of-prefix))))) + (if (allout-called-interactively-p) (allout-end-of-prefix))))) ;;;_ > allout-next-visible-heading (arg) (defun allout-next-visible-heading (arg) "Move to the next ARG'th visible heading line, backward if arg is negative. @@ -3272,7 +3428,7 @@ matches)." (interactive "p") (prog1 (allout-next-visible-heading (- arg)) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)))) + (if (allout-called-interactively-p) (allout-end-of-prefix)))) ;;;_ > allout-forward-current-level (arg) (defun allout-forward-current-level (arg) "Position point at the next heading of the same level. @@ -3293,7 +3449,7 @@ (allout-previous-sibling) (allout-next-sibling))) (setq arg (1- arg))) - (if (not (called-interactively-p 'interactive)) + (if (not (allout-called-interactively-p)) nil (allout-end-of-prefix) (if (not (zerop arg)) @@ -3306,7 +3462,7 @@ (defun allout-backward-current-level (arg) "Inverse of `allout-forward-current-level'." (interactive "p") - (if (called-interactively-p 'interactive) + (if (allout-called-interactively-p) (let ((current-prefix-arg (* -1 arg))) (call-interactively 'allout-forward-current-level)) (allout-forward-current-level (* -1 arg)))) @@ -3391,8 +3547,10 @@ Returns the qualifying command, if any, else nil." (interactive) - (let* ((key-string (if (numberp last-command-event) - (char-to-string last-command-event))) + (let* ((modified (event-modifiers last-command-event)) + (key-string (if (numberp last-command-event) + (char-to-string + (event-basic-type last-command-event)))) (key-num (cond ((numberp last-command-event) last-command-event) ;; for XEmacs character type: ((and (fboundp 'characterp) @@ -3406,6 +3564,7 @@ (if (and ;; exclude control chars and escape: + (not modified) (<= 33 key-num) (setq mapped-binding (or (and (assoc key-string allout-keybindings-list) @@ -3413,22 +3572,22 @@ (cadr (assoc key-string allout-keybindings-list))) ;; translate as a keybinding: (key-binding (vconcat allout-command-prefix - (char-to-string - (if (and (<= 97 key-num) ; "a" - (>= 122 key-num)) ; "z" - (- key-num 96) key-num))) + (vector + (if (and (<= 97 key-num) ; "a" + (>= 122 key-num)) ; "z" + (- key-num 96) key-num))) t)))) ;; Qualified as an allout command -- do hot-spot operation. (setq allout-post-goto-bullet t) - ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. - (setq mapped-binding (key-binding (char-to-string key-num)))) + ;; accept-defaults nil, or else we get allout-item-icon-key-handler. + (setq mapped-binding (key-binding (vector key-num)))) (while (keymapp mapped-binding) (setq mapped-binding (lookup-key mapped-binding (vector (read-char))))) - (if mapped-binding - (setq this-command mapped-binding))))) + (when mapped-binding + (setq this-command mapped-binding))))) ;;;_ > allout-find-file-hook () (defun allout-find-file-hook () @@ -3457,7 +3616,7 @@ (setq choice (solicit-char-in-string (format "Select bullet: %s ('%s' default): " sans-escapes - (substring-no-properties default-bullet)) + (allout-substring-no-properties default-bullet)) sans-escapes t))) (message "") @@ -4455,9 +4614,9 @@ (if (not (allout-hidden-p)) (setq next (max (1+ (point)) - (next-single-char-property-change (point) - 'invisible - nil end)))) + (allout-next-single-char-property-change (point) + 'invisible + nil end)))) (if (or (not next) (eq prev next)) ;; still not at start of hidden area -- must not be any left. (setq done t) @@ -4496,9 +4655,8 @@ (while (not done) ;; at or advance to start of next annotation: (if (not (get-text-property (point) 'allout-was-hidden)) - (setq next (next-single-char-property-change (point) - 'allout-was-hidden - nil end))) + (setq next (allout-next-single-char-property-change + (point) 'allout-was-hidden nil end))) (if (or (not next) (eq prev next)) ;; no more or not advancing -- must not be any left. (setq done t) @@ -4508,9 +4666,8 @@ ;; still not at start of annotation. (setq done t) ;; advance to just after end of this annotation: - (setq next (next-single-char-property-change (point) - 'allout-was-hidden - nil end)) + (setq next (allout-next-single-char-property-change + (point) 'allout-was-hidden nil end)) (overlay-put (make-overlay prev next nil 'front-advance) 'category 'allout-exposure-category) (allout-deannotate-hidden prev next) @@ -4725,7 +4882,7 @@ (save-match-data (save-excursion (let* ((text-start allout-recent-prefix-end) - (heading-end (progn (end-of-line) (point)))) + (heading-end (point-at-eol))) (goto-char text-start) (setq file-name (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) @@ -4766,7 +4923,10 @@ (when (featurep 'xemacs) (let ((props (symbol-plist 'allout-exposure-category))) (while props - (overlay-put o (pop props) (pop props))))))) + (condition-case nil + ;; as of 2008-02-27, xemacs lacks modification-hooks + (overlay-put o (pop props) (pop props)) + (error nil))))))) (run-hooks 'allout-view-change-hook) (run-hook-with-args 'allout-exposure-change-hook from to flag)) ;;;_ > allout-flag-current-subtree (flag) @@ -4845,7 +5005,7 @@ (to-reveal (or (allout-chart-to-reveal chart chart-level) ;; interactive, show discontinuous children: (and chart - (called-interactively-p 'interactive) + (allout-called-interactively-p) (save-excursion (allout-back-to-current-heading) (setq depth (allout-current-depth)) @@ -5672,8 +5832,7 @@ (let ((inhibit-field-text-motion t)) (beginning-of-line) (let ((beg (point)) - (end (progn (end-of-line)(point)))) - (goto-char beg) + (end (point-at-eol))) (save-match-data (while (re-search-forward "\\\\" ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" @@ -5976,7 +6135,7 @@ ;; they're encrypted, so the coding system is set to accommodate ;; them. (setq buffer-file-coding-system - (select-safe-coding-system subtree-beg subtree-end)) + (allout-select-safe-coding-system subtree-beg subtree-end)) ;; if the coding system for the text being encrypted is different ;; than that prevailing, then there a real risk that the coding ;; system can't be noticed by emacs when the file is visited. to @@ -6119,7 +6278,7 @@ (insert text) ;; convey the text characteristics of the original buffer: - (set-buffer-multibyte multibyte) + (allout-set-buffer-multibyte multibyte) (when encoding (set-buffer-file-coding-system encoding) (if (not decrypt) @@ -6831,6 +6990,14 @@ ((atom (car list)) (cons (car list) (allout-flatten (cdr list)))) (t (append (allout-flatten (car list)) (allout-flatten (cdr list)))))) ;;;_ : Compatibility: +;;;_ : xemacs undo-in-progress provision: +(unless (boundp 'undo-in-progress) + (defvar undo-in-progress nil + "Placeholder defvar for XEmacs compatibility from allout.el.") + (defadvice undo-more (around allout activate) + ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs. + (let ((undo-in-progress t)) ad-do-it))) + ;;;_ > allout-mark-marker to accommodate divergent emacsen: (defun allout-mark-marker (&optional force buffer) "Accommodate the different signature for `mark-marker' across Emacsen. @@ -6941,7 +7108,7 @@ (skip-chars-backward "^\n")) (vertical-motion 0)) ) -;;;_ > move-end-of-line if necessary -- older emacs, xemacs +;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs (if (not (fboundp 'move-end-of-line)) (defun move-end-of-line (arg) "Move point to end of current line as displayed. @@ -6991,6 +7158,42 @@ (setq arg 1) (setq done t))))))) ) +;;;_ > allout-next-single-char-property-change -- alias unless lacking +(defalias 'allout-next-single-char-property-change + (if (fboundp 'next-single-char-property-change) + 'next-single-char-property-change + 'next-single-property-change) + ;; No docstring because xemacs defalias doesn't support it. + ) +;;;_ > allout-previous-single-char-property-change -- alias unless lacking +(defalias 'allout-previous-single-char-property-change + (if (fboundp 'previous-single-char-property-change) + 'previous-single-char-property-change + 'previous-single-property-change) + ;; No docstring because xemacs defalias doesn't support it. + ) +;;;_ > allout-set-buffer-multibyte +;; define as alias first, so byte compiler is happy. +(defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte) +;; then supplant with definition if underlying alias absent. +(if (not (fboundp 'set-buffer-multibyte)) + (defun allout-set-buffer-multibyte (is-multibyte) + (setq enable-multibyte-characters is-multibyte)) + ) +;;;_ > allout-select-safe-coding-system +(defalias 'allout-select-safe-coding-system + (if (fboundp 'select-safe-coding-system) + 'select-safe-coding-system + 'detect-coding-region) + ) +;;;_ > allout-substring-no-properties +;; define as alias first, so byte compiler is happy. +(defalias 'allout-substring-no-properties 'substring-no-properties) +;; then supplant with definition if underlying alias absent. +(if (not (fboundp 'substring-no-properties)) + (defun allout-substring-no-properties (string &optional start end) + (substring string (or start 0) end)) + ) ;;;_ #10 Unfinished ;;;_ > allout-bullet-isearch (&optional bullet) @@ -7022,7 +7225,7 @@ ;;;_ > allout-tests-obliterate-variable (name) (defun allout-tests-obliterate-variable (name) "Completely unbind variable with NAME." - (if (local-variable-p name) (kill-local-variable name)) + (if (local-variable-p name (current-buffer)) (kill-local-variable name)) (while (boundp name) (makunbound name))) ;;;_ > allout-test-resumptions () (defvar allout-tests-globally-unbound nil @@ -7041,11 +7244,12 @@ (allout-tests-obliterate-variable 'allout-tests-globally-unbound) (allout-add-resumptions '(allout-tests-globally-unbound t)) (assert (not (default-boundp 'allout-tests-globally-unbound))) - (assert (local-variable-p 'allout-tests-globally-unbound)) + (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) (assert (boundp 'allout-tests-globally-unbound)) (assert (equal allout-tests-globally-unbound t)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-unbound))) + (assert (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) (assert (not (boundp 'allout-tests-globally-unbound)))) ;; ensure that variable with prior global value is resumed @@ -7054,10 +7258,11 @@ (setq allout-tests-globally-true t) (allout-add-resumptions '(allout-tests-globally-true nil)) (assert (equal (default-value 'allout-tests-globally-true) t)) - (assert (local-variable-p 'allout-tests-globally-true)) + (assert (local-variable-p 'allout-tests-globally-true (current-buffer))) (assert (equal allout-tests-globally-true nil)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-true))) + (assert (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) (assert (boundp 'allout-tests-globally-true)) (assert (equal allout-tests-globally-true t))) @@ -7068,16 +7273,16 @@ (assert (not (default-boundp 'allout-tests-locally-true)) nil (concat "Test setup mistake -- variable supposed to" " not have global binding, but it does.")) - (assert (local-variable-p 'allout-tests-locally-true) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer)) nil (concat "Test setup mistake -- variable supposed to have" " local binding, but it lacks one.")) (allout-add-resumptions '(allout-tests-locally-true nil)) (assert (not (default-boundp 'allout-tests-locally-true))) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true nil)) (allout-do-resumptions) (assert (boundp 'allout-tests-locally-true)) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true t)) (assert (not (default-boundp 'allout-tests-locally-true)))) @@ -7096,22 +7301,24 @@ '(allout-tests-locally-true 4)) ;; reestablish many of the basic conditions are maintained after re-add: (assert (not (default-boundp 'allout-tests-globally-unbound))) - (assert (local-variable-p 'allout-tests-globally-unbound)) + (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) (assert (equal allout-tests-globally-unbound 2)) (assert (default-boundp 'allout-tests-globally-true)) - (assert (local-variable-p 'allout-tests-globally-true)) + (assert (local-variable-p 'allout-tests-globally-true (current-buffer))) (assert (equal allout-tests-globally-true 3)) (assert (not (default-boundp 'allout-tests-locally-true))) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true 4)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-unbound))) + (assert (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) (assert (not (boundp 'allout-tests-globally-unbound))) - (assert (not (local-variable-p 'allout-tests-globally-true))) + (assert (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) (assert (boundp 'allout-tests-globally-true)) (assert (equal allout-tests-globally-true t)) (assert (boundp 'allout-tests-locally-true)) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true t)) (assert (not (default-boundp 'allout-tests-locally-true)))) @@ -7147,5 +7354,4 @@ ;;allout-layout: (0 : -1 -1 0) ;;End: -;; arch-tag: cf38fbc3-c044-450f-8bff-afed8ba5681c ;;; allout.el ends here
--- a/lisp/array.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/array.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; array.el --- array editing commands for GNU Emacs ;; Copyright (C) 1987, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David M. Brown ;; Maintainer: FSF @@ -748,9 +748,7 @@ (defun current-line () "Return the current buffer line at point. The first line is 0." - (save-excursion - (beginning-of-line) - (count-lines (point-min) (point)))) + (count-lines (point-min) (line-beginning-position))) (defun move-to-column-untabify (column) "Move to COLUMN on the current line, untabifying if necessary. @@ -903,5 +901,4 @@ (provide 'array) -;; arch-tag: 0086605d-79fe-4a1a-992a-456417261f80 ;;; array.el ends here
--- a/lisp/buff-menu.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/buff-menu.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,8 @@ ;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*- -;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: convenience @@ -303,9 +304,7 @@ (defun Buffer-menu-buffer (error-if-non-existent-p) "Return buffer described by this line of buffer menu." - (let* ((where (save-excursion - (beginning-of-line) - (+ (point) Buffer-menu-buffer-column))) + (let* ((where (+ (line-beginning-position) Buffer-menu-buffer-column)) (name (and (not (eobp)) (get-text-property where 'buffer-name))) (buf (and (not (eobp)) (get-text-property where 'buffer)))) (if name @@ -924,5 +923,4 @@ (set-buffer-modified-p nil) (current-buffer)))) -;; arch-tag: e7dfcfc9-6cb2-46e4-bf55-8ef1936d83c6 ;;; buff-menu.el ends here
--- a/lisp/calc/calc-keypd.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/calc/calc-keypd.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; calc-keypd.el --- mouse-capable keypad input for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -390,9 +390,7 @@ (interactive) (unless (eq major-mode 'calc-keypad-mode) (error "Must be in *Calc Keypad* buffer for this command")) - (let* ((row (save-excursion - (beginning-of-line) - (count-lines (point-min) (point)))) + (let* ((row (count-lines (point-min) (point-at-bol))) (y (/ row 2)) (x (/ (current-column) (if (>= y 4) 6 5))) radix frac inv @@ -619,5 +617,4 @@ (provide 'calc-keypd) -;; arch-tag: 4ba0d360-2bb6-40b8-adfa-eb373765b3f9 ;;; calc-keypd.el ends here
--- a/lisp/calc/calc-yank.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/calc/calc-yank.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; calc-yank.el --- kill-ring functionality for Calc -;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> @@ -282,11 +282,8 @@ (setq single t) (setq arg (prefix-numeric-value arg)) (if (= arg 0) - (save-excursion - (beginning-of-line) - (setq top (point)) - (end-of-line) - (setq bot (point))) + (setq top (point-at-bol) + bot (point-at-eol)) (save-excursion (setq top (point)) (forward-line arg) @@ -713,5 +710,4 @@ ;; generated-autoload-file: "calc-loaddefs.el" ;; End: -;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5 ;;; calc-yank.el ends here
--- a/lisp/calendar/time-date.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/calendar/time-date.el Wed Nov 17 13:09:08 2010 +0900 @@ -112,27 +112,24 @@ ;; Bit of a mess. Emacs has float-time since at least 21.1. ;; This file is synced to Gnus, and XEmacs packages may have been written ;; using time-to-seconds from the Gnus library. -;;;###autoload(if (and (fboundp 'float-time) -;;;###autoload (subrp (symbol-function 'float-time))) +;;;###autoload(if (or (featurep 'emacs) +;;;###autoload (and (fboundp 'float-time) +;;;###autoload (subrp (symbol-function 'float-time)))) ;;;###autoload (progn ;;;###autoload (defalias 'time-to-seconds 'float-time) ;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1")) ;;;###autoload (autoload 'time-to-seconds "time-date")) -(eval-and-compile - (unless (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) - (defun time-to-seconds (time) - "Convert time value TIME to a floating point number." - (with-decoded-time-value ((high low micro time)) - (+ (* 1.0 high 65536) - low - (/ micro 1000000.0)))))) - (eval-when-compile - (unless (fboundp 'with-no-warnings) - (defmacro with-no-warnings (&rest body) - `(progn ,@body)))) + (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (defun time-to-seconds (time) + "Convert time value TIME to a floating point number." + (with-decoded-time-value ((high low micro time)) + (+ (* 1.0 high 65536) + low + (/ micro 1000000.0)))))) ;;;###autoload (defun seconds-to-time (seconds) @@ -143,7 +140,7 @@ ;;;###autoload (defun time-less-p (t1 t2) - "Say whether time value T1 is less than time value T2." + "Return non-nil if time value T1 is earlier than time value T2." (with-decoded-time-value ((high1 low1 micro1 t1) (high2 low2 micro2 t2)) (or (< high1 high2) @@ -256,17 +253,15 @@ (- (/ (1- year) 100)) ; - century years (/ (1- year) 400)))) ; + Gregorian leap years -(eval-and-compile - (if (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) - (defun time-to-number-of-days (time) - "Return the number of days represented by TIME. -The number of days will be returned as a floating point number." - (/ (float-time time) (* 60 60 24))) - (defun time-to-number-of-days (time) - "Return the number of days represented by TIME. -The number of days will be returned as a floating point number." - (/ (with-no-warnings (time-to-seconds time)) (* 60 60 24))))) +(defun time-to-number-of-days (time) + "Return the number of days represented by TIME. +Returns a floating point number." + (/ (funcall (eval-when-compile + (if (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time)))) + 'float-time + 'time-to-seconds)) time) (* 60 60 24))) ;;;###autoload (defun safe-date-to-time (date)
--- a/lisp/calendar/timeclock.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/calendar/timeclock.el Wed Nov 17 13:09:08 2010 +0900 @@ -543,11 +543,8 @@ (message "%s" string) string))) -(defsubst timeclock-time-to-seconds (time) - "Convert TIME to a floating point number." - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (nth 2 time) 0) 1000000.0))) +(defalias 'timeclock-time-to-seconds (if (fboundp 'float-time) 'float-time + 'time-to-seconds)) (defsubst timeclock-seconds-to-time (seconds) "Convert SECONDS (a floating point number) to an Emacs time structure." @@ -1419,5 +1416,4 @@ (if (file-readable-p timeclock-file) (timeclock-reread-log)) -;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40 ;;; timeclock.el ends here
--- a/lisp/cedet/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,20 @@ +2010-11-12 Glenn Morris <rgm@gnu.org> + + * semantic/wisent/comp.el: Remove unnecessary eval-when-compiles. + +2010-11-10 Glenn Morris <rgm@gnu.org> + + * semantic/bovine/c.el: Test system-type with memq. + +2010-11-09 Glenn Morris <rgm@gnu.org> + + * semantic/lex.el (semantic-lex-ignore-comments, semantic-flex): + * semantic/grammar.el (semantic-grammar-epilogue): + * ede/speedbar.el (ede-find-nearest-file-line): + * ede/pmake.el (ede-proj-makefile-insert-dist-rules): + * ede/autoconf-edit.el (autoconf-delete-parameter): + Use point-at-bol and point-at-eol. + 2010-11-07 Glenn Morris <rgm@gnu.org> * ede/proj-elisp.el (ede-proj-flush-autoconf): Use point-at-bol.
--- a/lisp/cedet/ede/autoconf-edit.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/ede/autoconf-edit.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,6 +1,7 @@ ;;; ede/autoconf-edit.el --- Keymap for autoconf -;; Copyright (C) 1998, 1999, 2000, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project @@ -381,9 +382,7 @@ (down-list 1) (re-search-forward ", ?" nil nil (1- index)) (let ((end (save-excursion - (re-search-forward ",\\|)" (save-excursion - (end-of-line) - (point))) + (re-search-forward ",\\|)" (point-at-eol)) (forward-char -1) (point)))) (setq autoconf-deleted-text (buffer-substring (point) end)) @@ -417,5 +416,4 @@ (provide 'ede/autoconf-edit) -;; arch-tag: 5932c433-4fd4-4d5e-ab35-8effd95a405f ;;; ede/autoconf-edit.el ends here
--- a/lisp/cedet/ede/pmake.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/ede/pmake.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; ede-pmake.el --- EDE Generic Project Makefile code generator. -;;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -565,10 +565,7 @@ (cond ((eq (cdr sv) 'share) ;; This variable may be shared between multiple targets. (if (re-search-backward (concat "\\$(" (car sv) ")") - (save-excursion - (beginning-of-line) - (point)) - t) + (point-at-bol) t) ;; If its already in the dist target, then skip it. nil (setq sv (car sv)))) @@ -693,5 +690,4 @@ (provide 'ede/pmake) -;; arch-tag: 7ad8e19f-cdee-484c-8caf-f15cb0fc4df2 ;;; ede/pmake.el ends here
--- a/lisp/cedet/ede/speedbar.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/ede/speedbar.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; ede/speedbar.el --- Speedbar viewing of EDE projects -;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2005, 2007, 2008, 2009, 2010 -;;; Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2005, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make, tags @@ -176,10 +176,7 @@ (beginning-of-line) (looking-at "^\\([0-9]+\\):") (let ((depth (string-to-number (match-string 1)))) - (while (not (re-search-forward "[]] [^ ]" - (save-excursion (end-of-line) - (point)) - t)) + (while (not (re-search-forward "[]] [^ ]" (point-at-eol) t)) (re-search-backward (format "^%d:" (1- depth))) (setq depth (1- depth))) (speedbar-line-token)))) @@ -358,5 +355,4 @@ ;; generated-autoload-load-name: "ede/speedbar" ;; End: -;; arch-tag: 56721fc9-8eb5-4115-8511-18cf8397ec87 ;;; ede/speedbar.el ends here
--- a/lisp/cedet/semantic/bovine/c.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/semantic/bovine/c.el Wed Nov 17 13:09:08 2010 +0900 @@ -94,8 +94,8 @@ ;; Compiler options need to show up after path setup, but before ;; the preprocessor section. -(when (member system-type '(gnu gnu/linux darwin cygwin)) - (semantic-gcc-setup)) +(if (memq system-type '(gnu gnu/linux darwin cygwin)) + (semantic-gcc-setup)) ;;; Pre-processor maps ;;
--- a/lisp/cedet/semantic/grammar.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/semantic/grammar.el Wed Nov 17 13:09:08 2010 +0900 @@ -248,10 +248,7 @@ (skip-chars-backward "\r\n\t") ;; If a grammar footer is found, skip it. (re-search-backward "^;;;\\s-+\\S-+\\s-+ends here" - (save-excursion - (beginning-of-line) - (point)) - t) + (point-at-bol) t) (skip-chars-backward "\r\n\t") (point))) "\n")) @@ -1897,5 +1894,4 @@ (provide 'semantic/grammar) -;; arch-tag: 12ffc9d5-557d-49af-a5fd-a66a006ddb3e ;;; semantic/grammar.el ends here
--- a/lisp/cedet/semantic/lex.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/semantic/lex.el Wed Nov 17 13:09:08 2010 +0900 @@ -1427,10 +1427,7 @@ ;; to work properly. Lets try and move over ;; whatever white space we matched to begin ;; with. - (skip-syntax-forward "-.'" - (save-excursion - (end-of-line) - (point))) + (skip-syntax-forward "-.'" (point-at-eol)) ;; We may need to back up so newlines or whitespace is generated. (if (bolp) (backward-char 1))) @@ -1997,10 +1994,7 @@ ;; to work properly. Lets try and move over ;; whatever white space we matched to begin ;; with. - (skip-syntax-forward "-.'" - (save-excursion - (end-of-line) - (point))) + (skip-syntax-forward "-.'" (point-at-eol)) ;;(forward-comment 1) ;; Generate newline token if enabled (if (and semantic-flex-enable-newlines @@ -2049,5 +2043,4 @@ ;; generated-autoload-load-name: "semantic/lex" ;; End: -;; arch-tag: a47664fc-48d9-4b36-921f-cab0ea8cdf92 ;;; semantic/lex.el ends here
--- a/lisp/cedet/semantic/wisent/comp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/cedet/semantic/wisent/comp.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,8 @@ ;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler ;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: David Ponce <david@dponce.com> ;; Maintainer: David Ponce <david@dponce.com> @@ -160,12 +161,6 @@ (not (zerop (logand (aref x (/ i wisent-BITS-PER-WORD)) (lsh 1 (% i wisent-BITS-PER-WORD)))))) -(eval-when-compile - (or (fboundp 'noninteractive) - ;; Silence the Emacs byte compiler - (defun noninteractive nil)) - ) - (defsubst wisent-noninteractive () "Return non-nil if running without interactive terminal." (if (featurep 'xemacs) @@ -205,7 +200,7 @@ `(with-current-buffer (wisent-log-buffer) (erase-buffer))) -(eval-when-compile (defvar byte-compile-current-file)) +(defvar byte-compile-current-file) (defun wisent-source () "Return the current source file name or nil." @@ -3536,5 +3531,4 @@ (provide 'semantic/wisent/comp) -;; arch-tag: 758ea04c-ea97-466b-9b35-aea0861033c9 ;;; semantic/wisent/comp.el ends here
--- a/lisp/dired-aux.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/dired-aux.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,8 @@ ;;; dired-aux.el --- less commonly used parts of dired ;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>. ;; Maintainer: FSF @@ -700,7 +701,7 @@ (save-excursion (and file (dired-goto-subdir file) (dired-kill-subdir))) - (delete-region (progn (beginning-of-line) (point)) + (delete-region (line-beginning-position) (progn (forward-line 1) (point))) (if (> arg 0) (setq arg (1- arg)) @@ -734,7 +735,7 @@ (while (and (not (eobp)) (re-search-forward regexp nil t)) (setq count (1+ count)) - (delete-region (progn (beginning-of-line) (point)) + (delete-region (line-beginning-position) (progn (forward-line 1) (point)))) (or (equal "" fmt) (message (or fmt "Killed %d line%s.") count (dired-plural-s count))) @@ -1037,10 +1038,10 @@ ;; Keeps any marks that may be present in column one (doing this ;; here is faster than with dired-add-entry's optional arg). ;; Does not update other dired buffers. Use dired-relist-entry for that. - (beginning-of-line) - (let ((char (following-char)) (opoint (point)) + (let ((char (following-char)) + (opoint (line-beginning-position)) (buffer-read-only)) - (delete-region (point) (progn (forward-line 1) (point))) + (delete-region opoint (progn (forward-line 1) (point))) (if file (progn (dired-add-entry file nil t) @@ -1133,8 +1134,7 @@ (save-excursion ;; ...so we can run it right now: (save-restriction (beginning-of-line) - (narrow-to-region (point) (save-excursion - (forward-line 1) (point))) + (narrow-to-region (point) (line-beginning-position 2)) (run-hooks 'dired-after-readin-hook)))) (dired-move-to-filename)) ;; return nil if all went well @@ -1167,7 +1167,7 @@ (and (dired-goto-file file) (let (buffer-read-only) (delete-region (progn (beginning-of-line) (point)) - (save-excursion (forward-line 1) (point))))))) + (line-beginning-position 2)))))) ;;;###autoload (defun dired-relist-file (file) @@ -1188,7 +1188,7 @@ (delete-region (progn (beginning-of-line) (setq marker (following-char)) (point)) - (save-excursion (forward-line 1) (point)))) + (line-beginning-position 2))) (setq file (directory-file-name file)) (dired-add-entry file (if (eq ?\040 marker) nil marker))))) @@ -2482,5 +2482,4 @@ ;; generated-autoload-file: "dired.el" ;; End: -;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60 ;;; dired-aux.el ends here
--- a/lisp/dired.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/dired.el Wed Nov 17 13:09:08 2010 +0900 @@ -73,7 +73,7 @@ ;;;###autoload (defvar dired-chown-program (purecopy - (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin)) + (if (memq system-type '(hpux usg-unix-v irix gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" @@ -3539,7 +3539,7 @@ ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "416d272299fd4774c47c2f677ee640a4") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "1628b7a7d379fb4da8ae4bf29faad4b5") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\
--- a/lisp/dirtrack.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/dirtrack.el Wed Nov 17 13:09:08 2010 +0900 @@ -144,7 +144,7 @@ :type 'string) (defcustom dirtrack-directory-function - (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (if (memq system-type '(ms-dos windows-nt cygwin)) 'dirtrack-windows-directory-function 'file-name-as-directory) "Function to apply to the prompt directory for comparison purposes." @@ -152,7 +152,7 @@ :type 'function) (defcustom dirtrack-canonicalize-function - (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (if (memq system-type '(ms-dos windows-nt cygwin)) 'downcase 'identity) "Function to apply to the default directory for comparison purposes." :group 'dirtrack @@ -269,5 +269,4 @@ (provide 'dirtrack) -;; arch-tag: 168de071-be88-4937-aff6-2aba9f328d5a ;;; dirtrack.el ends here
--- a/lisp/electric.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/electric.el Wed Nov 17 13:09:08 2010 +0900 @@ -176,6 +176,20 @@ "Electric behavior for self inserting keys." :group 'editing) +(defun electric--after-char-pos () + "Return the position after the char we just inserted. +Returns nil when we can't find this char." + (let ((pos (point))) + (when (or (eq (char-before) last-command-event) ;; Sanity check. + (save-excursion + (or (progn (skip-chars-backward " \t") + (setq pos (point)) + (eq (char-before) last-command-event)) + (progn (skip-chars-backward " \n\t") + (setq pos (point)) + (eq (char-before) last-command-event))))) + pos))) + ;; Electric indentation. ;; Autoloading variables is generally undesirable, but major modes @@ -193,35 +207,35 @@ ;; electric-pair-mode wrapping a region with a pair of parens. ;; There might be a way to get it working by analyzing buffer-undo-list, but ;; it looks challenging. - (when (and (memq last-command-event electric-indent-chars) - ;; Don't reindent while inserting spaces at beginning of line. - (or (not (memq last-command-event '(?\s ?\t))) - (save-excursion (skip-chars-backward " \t") (not (bolp)))) - ;; Not in a string or comment. - (not (nth 8 (syntax-ppss)))) - ;; For newline, we want to reindent both lines and basically behave like - ;; reindent-then-newline-and-indent (whose code we hence copied). - (when (and (eq last-command-event ?\n) - ;; Don't reindent the previous line if the indentation function - ;; is not a real one. - (not (memq indent-line-function - '(indent-relative indent-relative-maybe))) - ;; Sanity check. - (eq (char-before) last-command-event)) - (let ((pos (copy-marker (1- (point)) t))) - (save-excursion - (goto-char pos) - (indent-according-to-mode) - ;; We are at EOL before the call to indent-according-to-mode, and - ;; after it we usually are as well, but not always. We tried to - ;; address it with `save-excursion' but that uses a normal marker - ;; whereas we need `move after insertion', so we do the - ;; save/restore by hand. - (goto-char pos) - ;; Remove the trailing whitespace after indentation because - ;; indentation may (re)introduce the whitespace. - (delete-horizontal-space t)))) - (indent-according-to-mode))) + (let (pos) + (when (and (memq last-command-event electric-indent-chars) + ;; Don't reindent while inserting spaces at beginning of line. + (or (not (memq last-command-event '(?\s ?\t))) + (save-excursion (skip-chars-backward " \t") (not (bolp)))) + (setq pos (electric--after-char-pos)) + ;; Not in a string or comment. + (not (nth 8 (save-excursion (syntax-ppss pos))))) + ;; For newline, we want to reindent both lines and basically behave like + ;; reindent-then-newline-and-indent (whose code we hence copied). + (when (and (< (1- pos) (line-beginning-position)) + ;; Don't reindent the previous line if the indentation + ;; function is not a real one. + (not (memq indent-line-function + '(indent-relative indent-relative-maybe)))) + (let ((before (copy-marker (1- pos) t))) + (save-excursion + (goto-char before) + (indent-according-to-mode) + ;; We are at EOL before the call to indent-according-to-mode, and + ;; after it we usually are as well, but not always. We tried to + ;; address it with `save-excursion' but that uses a normal marker + ;; whereas we need `move after insertion', so we do the + ;; save/restore by hand. + (goto-char before) + ;; Remove the trailing whitespace after indentation because + ;; indentation may (re)introduce the whitespace. + (delete-horizontal-space t)))) + (indent-according-to-mode)))) ;;;###autoload (define-minor-mode electric-indent-mode @@ -233,7 +247,17 @@ (add-hook 'post-self-insert-hook #'electric-indent-post-self-insert-function) (remove-hook 'post-self-insert-hook - #'electric-indent-post-self-insert-function))) + #'electric-indent-post-self-insert-function)) + ;; FIXME: electric-indent-mode and electric-layout-mode interact + ;; in non-trivial ways. It turns out that electric-indent-mode works + ;; better if it is run *after* electric-layout-mode's hook. + (when (memq #'electric-layout-post-self-insert-function + (memq #'electric-indent-post-self-insert-function + (default-value 'post-self-insert-hook))) + (remove-hook 'post-self-insert-hook + #'electric-layout-post-self-insert-function) + (add-hook 'post-self-insert-hook + #'electric-layout-post-self-insert-function))) ;; Electric pairing. @@ -302,7 +326,48 @@ #'electric-pair-post-self-insert-function) (remove-hook 'post-self-insert-hook #'electric-pair-post-self-insert-function))) - + +;; Automatically add newlines after/before/around some chars. + +(defvar electric-layout-rules '() + "List of rules saying where to automatically insert newlines. +Each rule has the form (CHAR . WHERE) where CHAR is the char +that was just inserted and WHERE specifies where to insert newlines +and can be: nil, `before', `after', `around', or a function that returns +one of those symbols.") + +(defun electric-layout-post-self-insert-function () + (let* ((rule (cdr (assq last-command-event electric-layout-rules))) + pos) + (when (and rule + (setq pos (electric--after-char-pos)) + ;; Not in a string or comment. + (not (nth 8 (save-excursion (syntax-ppss pos))))) + (let ((end (copy-marker (point) t))) + (goto-char pos) + (case (if (functionp rule) (funcall rule) rule) + ;; FIXME: we used `newline' down here which called + ;; self-insert-command and ran post-self-insert-hook recursively. + ;; It happened to make electric-indent-mode work automatically with + ;; electric-layout-mode (at the cost of re-indenting lines + ;; multiple times), but I'm not sure it's what we want. + (before (goto-char (1- pos)) (insert "\n")) + (after (insert "\n")) + (around (goto-char (1- pos)) (insert "\n") + (forward-char 1) (insert "\n"))) + (goto-char end))))) + +;;;###autoload +(define-minor-mode electric-layout-mode + "Automatically insert newlines around some chars." + :global t + :group 'electricity + (if electric-layout-mode + (add-hook 'post-self-insert-hook + #'electric-layout-post-self-insert-function) + (remove-hook 'post-self-insert-hook + #'electric-layout-post-self-insert-function))) + (provide 'electric) ;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8
--- a/lisp/emacs-lisp/bytecomp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emacs-lisp/bytecomp.el Wed Nov 17 13:09:08 2010 +0900 @@ -248,10 +248,14 @@ :type 'boolean) ;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp) +(defconst byte-compile-log-buffer "*Compile-Log*" + "Name of the byte-compiler's log buffer.") + (defcustom byte-optimize-log nil - "If true, the byte-compiler will log its optimizations into *Compile-Log*. + "If non-nil, the byte-compiler will log its optimizations. If this is 'source, then only source-level optimizations will be logged. -If it is 'byte, then only byte-level optimizations will be logged." +If it is 'byte, then only byte-level optimizations will be logged. +The information is logged to `byte-compile-log-buffer'." :group 'bytecomp :type '(choice (const :tag "none" nil) (const :tag "all" t) @@ -885,7 +889,7 @@ ;; Log something that isn't a warning. (defun byte-compile-log-1 (string) - (with-current-buffer "*Compile-Log*" + (with-current-buffer byte-compile-log-buffer (let ((inhibit-read-only t)) (goto-char (point-max)) (byte-compile-warning-prefix nil nil) @@ -993,13 +997,13 @@ ;; (compile-mode) will cause this to be loaded. (declare-function compilation-forget-errors "compile" ()) -;; Log the start of a file in *Compile-Log*, and mark it as done. +;; Log the start of a file in `byte-compile-log-buffer', and mark it as done. ;; Return the position of the start of the page in the log buffer. ;; But do nothing in batch mode. (defun byte-compile-log-file () (and (not (equal byte-compile-current-file byte-compile-last-logged-file)) (not noninteractive) - (with-current-buffer (get-buffer-create "*Compile-Log*") + (with-current-buffer (get-buffer-create byte-compile-log-buffer) (goto-char (point-max)) (let* ((inhibit-read-only t) (dir (and byte-compile-current-file @@ -1030,14 +1034,14 @@ (compilation-forget-errors) pt)))) -;; Log a message STRING in *Compile-Log*. +;; Log a message STRING in `byte-compile-log-buffer'. ;; Also log the current function and file if not already done. (defun byte-compile-log-warning (string &optional fill level) (let ((warning-prefix-function 'byte-compile-warning-prefix) (warning-type-format "") (warning-fill-prefix (if fill " ")) (inhibit-read-only t)) - (display-warning 'bytecomp string level "*Compile-Log*"))) + (display-warning 'bytecomp string level byte-compile-log-buffer))) (defun byte-compile-warn (format &rest args) "Issue a byte compiler warning; use (format FORMAT ARGS...) for message." @@ -1453,7 +1457,7 @@ (warning-series-started (and (markerp warning-series) (eq (marker-buffer warning-series) - (get-buffer "*Compile-Log*"))))) + (get-buffer byte-compile-log-buffer))))) (byte-compile-find-cl-functions) (if (or (eq warning-series 'byte-compile-warning-series) warning-series-started) @@ -1515,7 +1519,7 @@ nil (save-some-buffers) (force-mode-line-update)) - (with-current-buffer (get-buffer-create "*Compile-Log*") + (with-current-buffer (get-buffer-create byte-compile-log-buffer) (setq default-directory (expand-file-name bytecomp-directory)) ;; compilation-mode copies value of default-directory. (unless (eq major-mode 'compilation-mode)
--- a/lisp/emacs-lisp/checkdoc.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emacs-lisp/checkdoc.el Wed Nov 17 13:09:08 2010 +0900 @@ -201,9 +201,9 @@ The value `never' is the same as nil, never ask or change anything." :group 'checkdoc :type '(choice (const automatic) - (const query) - (const never) - (other :tag "semiautomatic" semiautomatic))) + (const query) + (const never) + (other :tag "semiautomatic" semiautomatic))) (defcustom checkdoc-bouncy-flag t "Non-nil means to \"bounce\" to auto-fix locations. @@ -250,10 +250,10 @@ t - Always spell-check" :group 'checkdoc :type '(choice (const nil) - (const defun) - (const buffer) - (const interactive) - (const t))) + (const defun) + (const buffer) + (const interactive) + (const t))) (defvar checkdoc-ispell-lisp-words '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs") @@ -429,19 +429,15 @@ the value of `checkdoc-common-verbs-regexp' to nil which cause it to be re-created.") -(defvar checkdoc-syntax-table nil +(defvar checkdoc-syntax-table + (let ((st (make-syntax-table emacs-lisp-mode-syntax-table))) + ;; When dealing with syntax in doc strings, make sure that - are + ;; encompassed in words so we can use cheap \\> to get the end of a symbol, + ;; not the end of a word in a conglomerate. + (modify-syntax-entry ?- "w" st) + st) "Syntax table used by checkdoc in document strings.") -(if checkdoc-syntax-table - nil - (setq checkdoc-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table)) - ;; When dealing with syntax in doc strings, make sure that - are encompassed - ;; in words so we can use cheap \\> to get the end of a symbol, not the - ;; end of a word in a conglomerate. - (modify-syntax-entry ?- "w" checkdoc-syntax-table) - ) - - ;;; Compatibility ;; (defalias 'checkdoc-make-overlay @@ -515,12 +511,11 @@ test; the nth string describes the status of the nth test." (let (temp-buffer-setup-hook) (with-output-to-temp-buffer "*Checkdoc Status*" - (princ-list - "Buffer comments and tags: " (nth 0 check) "\n" - "Documentation style: " (nth 1 check) "\n" - "Message/Query text style: " (nth 2 check) "\n" - "Unwanted Spaces: " (nth 3 check) - ))) + (mapc #'princ + (list "Buffer comments and tags: " (nth 0 check) + "\nDocumentation style: " (nth 1 check) + "\nMessage/Query text style: " (nth 2 check) + "\nUnwanted Spaces: " (nth 3 check))))) (shrink-window-if-larger-than-buffer (get-buffer-window "*Checkdoc Status*")) (message nil) @@ -623,7 +618,7 @@ (recenter (/ (- (window-height) l) 2)))) (recenter)) (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text - (car (car err-list))) + (car (car err-list))) (if (checkdoc-error-unfixable (car (car err-list))) "" "f,")) (save-excursion @@ -713,20 +708,21 @@ (delete-window (get-buffer-window "*Checkdoc Help*")) (kill-buffer "*Checkdoc Help*")) (with-output-to-temp-buffer "*Checkdoc Help*" - (princ-list - "Checkdoc Keyboard Summary:\n" - (if (checkdoc-error-unfixable (car (car err-list))) - "" - (concat - "f, y - auto Fix this warning without asking (if\ + (with-current-buffer standard-output + (insert + "Checkdoc Keyboard Summary:\n" + (if (checkdoc-error-unfixable (car (car err-list))) + "" + (concat + "f, y - auto Fix this warning without asking (if\ available.)\n" - " Very complex operations will still query.\n") - ) - "e - Enter recursive Edit. Press C-M-c to exit.\n" - "SPC, n - skip to the Next error.\n" - "DEL, p - skip to the Previous error.\n" - "q - Quit checkdoc.\n" - "C-h - Toggle this help buffer.")) + " Very complex operations will still query.\n") + ) + "e - Enter recursive Edit. Press C-M-c to exit.\n" + "SPC, n - skip to the Next error.\n" + "DEL, p - skip to the Previous error.\n" + "q - Quit checkdoc.\n" + "C-h - Toggle this help buffer."))) (shrink-window-if-larger-than-buffer (get-buffer-window "*Checkdoc Help*")))))) (if cdo (checkdoc-delete-overlay cdo))))) @@ -826,9 +822,9 @@ "Enter recursive edit to permit a user to fix some error checkdoc has found. MSG is the error that was found, which is displayed in a help buffer." (with-output-to-temp-buffer "*Checkdoc Help*" - (princ-list - "Error message:\n " msg - "\n\nEdit to fix this problem, and press C-M-c to continue.")) + (mapc #'princ + (list "Error message:\n " msg + "\n\nEdit to fix this problem, and press C-M-c to continue."))) (shrink-window-if-larger-than-buffer (get-buffer-window "*Checkdoc Help*")) (message "When you're done editing press C-M-c to continue.") @@ -947,14 +943,14 @@ (interactive "P") (if take-notes (checkdoc-start-section "checkdoc-comments")) (if (not buffer-file-name) - (error "Can only check comments for a file buffer")) + (error "Can only check comments for a file buffer")) (let* ((checkdoc-spellcheck-documentation-flag (car (memq checkdoc-spellcheck-documentation-flag '(buffer t)))) (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) (e (checkdoc-file-comments-engine)) - (checkdoc-generate-compile-warnings-flag - (or take-notes checkdoc-generate-compile-warnings-flag))) + (checkdoc-generate-compile-warnings-flag + (or take-notes checkdoc-generate-compile-warnings-flag))) (if e (error "%s" (checkdoc-error-text e))) (checkdoc-show-diagnostics) e)) @@ -970,8 +966,8 @@ (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces")) (let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag)) (e (checkdoc-rogue-space-check-engine nil nil interact)) - (checkdoc-generate-compile-warnings-flag - (or take-notes checkdoc-generate-compile-warnings-flag))) + (checkdoc-generate-compile-warnings-flag + (or take-notes checkdoc-generate-compile-warnings-flag))) (if (not (called-interactively-p 'interactive)) e (if e @@ -1210,34 +1206,34 @@ ;; Add in a menubar with easy-menu (easy-menu-define - nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu" - '("CheckDoc" - ["Interactive Buffer Style Check" checkdoc t] - ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t] - ["Check Buffer" checkdoc-current-buffer t] - ["Check and Spell Buffer" checkdoc-ispell-current-buffer t] - "---" - ["Interactive Style Check" checkdoc-interactive t] - ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t] - ["Find First Style Error" checkdoc-start t] - ["Find First Style or Spelling Error" checkdoc-ispell-start t] - ["Next Style Error" checkdoc-continue t] - ["Next Style or Spelling Error" checkdoc-ispell-continue t] - ["Interactive Message Text Style Check" checkdoc-message-interactive t] - ["Interactive Message Text Style and Spelling Check" - checkdoc-ispell-message-interactive t] - ["Check Message Text" checkdoc-message-text t] - ["Check and Spell Message Text" checkdoc-ispell-message-text t] - ["Check Comment Style" checkdoc-comments buffer-file-name] - ["Check Comment Style and Spelling" checkdoc-ispell-comments - buffer-file-name] - ["Check for Rogue Spaces" checkdoc-rogue-spaces t] - "---" - ["Check Defun" checkdoc-defun t] - ["Check and Spell Defun" checkdoc-ispell-defun t] - ["Check and Evaluate Defun" checkdoc-eval-defun t] - ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t] - )) + nil checkdoc-minor-mode-map "Checkdoc Minor Mode Menu" + '("CheckDoc" + ["Interactive Buffer Style Check" checkdoc t] + ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t] + ["Check Buffer" checkdoc-current-buffer t] + ["Check and Spell Buffer" checkdoc-ispell-current-buffer t] + "---" + ["Interactive Style Check" checkdoc-interactive t] + ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t] + ["Find First Style Error" checkdoc-start t] + ["Find First Style or Spelling Error" checkdoc-ispell-start t] + ["Next Style Error" checkdoc-continue t] + ["Next Style or Spelling Error" checkdoc-ispell-continue t] + ["Interactive Message Text Style Check" checkdoc-message-interactive t] + ["Interactive Message Text Style and Spelling Check" + checkdoc-ispell-message-interactive t] + ["Check Message Text" checkdoc-message-text t] + ["Check and Spell Message Text" checkdoc-ispell-message-text t] + ["Check Comment Style" checkdoc-comments buffer-file-name] + ["Check Comment Style and Spelling" checkdoc-ispell-comments + buffer-file-name] + ["Check for Rogue Spaces" checkdoc-rogue-spaces t] + "---" + ["Check Defun" checkdoc-defun t] + ["Check and Spell Defun" checkdoc-ispell-defun t] + ["Check and Evaluate Defun" checkdoc-eval-defun t] + ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t] + )) ;; XEmacs requires some weird stuff to add this menu in a minor mode. ;; What is it? @@ -1374,12 +1370,8 @@ documentation string") (point) (+ (point) 1) t))))) (if (and (not err) (looking-at "\"")) - (let ((old-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table checkdoc-syntax-table) - (checkdoc-this-string-valid-engine fp)) - (set-syntax-table old-syntax-table))) + (with-syntax-table checkdoc-syntax-table + (checkdoc-this-string-valid-engine fp)) err))) (defun checkdoc-this-string-valid-engine (fp) @@ -1991,49 +1983,45 @@ If the offending word is in a piece of quoted text, then it is skipped." (save-excursion (let ((case-fold-search nil) - (errtxt nil) bb be - (old-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table checkdoc-syntax-table) - (goto-char begin) - (while (re-search-forward checkdoc-proper-noun-regexp end t) - (let ((text (match-string 1)) - (b (match-beginning 1)) - (e (match-end 1))) - (if (and (not (save-excursion - (goto-char b) - (forward-char -1) - (looking-at "`\\|\"\\|\\.\\|\\\\"))) - ;; surrounded by /, as in a URL or filename: /emacs/ - (not (and (= ?/ (char-after e)) - (= ?/ (char-before b)))) - (not (checkdoc-in-example-string-p begin end)) - ;; info or url links left alone - (not (thing-at-point-looking-at - help-xref-info-regexp)) - (not (thing-at-point-looking-at - help-xref-url-regexp))) - (if (checkdoc-autofix-ask-replace - b e (format "Text %s should be capitalized. Fix? " - text) - (capitalize text) t) - nil - (if errtxt - ;; If there is already an error, then generate - ;; the warning output if applicable - (if checkdoc-generate-compile-warnings-flag - (checkdoc-create-error - (format - "Name %s should appear capitalized as %s" - text (capitalize text)) - b e)) - (setq errtxt - (format - "Name %s should appear capitalized as %s" - text (capitalize text)) - bb b be e))))))) - (set-syntax-table old-syntax-table)) + (errtxt nil) bb be) + (with-syntax-table checkdoc-syntax-table + (goto-char begin) + (while (re-search-forward checkdoc-proper-noun-regexp end t) + (let ((text (match-string 1)) + (b (match-beginning 1)) + (e (match-end 1))) + (if (and (not (save-excursion + (goto-char b) + (forward-char -1) + (looking-at "`\\|\"\\|\\.\\|\\\\"))) + ;; surrounded by /, as in a URL or filename: /emacs/ + (not (and (= ?/ (char-after e)) + (= ?/ (char-before b)))) + (not (checkdoc-in-example-string-p begin end)) + ;; info or url links left alone + (not (thing-at-point-looking-at + help-xref-info-regexp)) + (not (thing-at-point-looking-at + help-xref-url-regexp))) + (if (checkdoc-autofix-ask-replace + b e (format "Text %s should be capitalized. Fix? " + text) + (capitalize text) t) + nil + (if errtxt + ;; If there is already an error, then generate + ;; the warning output if applicable + (if checkdoc-generate-compile-warnings-flag + (checkdoc-create-error + (format + "Name %s should appear capitalized as %s" + text (capitalize text)) + b e)) + (setq errtxt + (format + "Name %s should appear capitalized as %s" + text (capitalize text)) + bb b be e))))))) (if errtxt (checkdoc-create-error errtxt bb be))))) (defun checkdoc-sentencespace-region-engine (begin end) @@ -2041,43 +2029,39 @@ (if sentence-end-double-space (save-excursion (let ((case-fold-search nil) - (errtxt nil) bb be - (old-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table checkdoc-syntax-table) - (goto-char begin) - (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t) - (let ((b (match-beginning 1)) - (e (match-end 1))) - (unless (or (checkdoc-in-sample-code-p begin end) - (checkdoc-in-example-string-p begin end) - (save-excursion - (goto-char b) - (condition-case nil - (progn - (forward-sexp -1) - ;; piece of an abbreviation - ;; FIXME etc - (looking-at - "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\.")) - (error t)))) - (if (checkdoc-autofix-ask-replace - b e - "There should be two spaces after a period. Fix? " - ". ") - nil - (if errtxt - ;; If there is already an error, then generate - ;; the warning output if applicable - (if checkdoc-generate-compile-warnings-flag - (checkdoc-create-error - "There should be two spaces after a period" - b e)) - (setq errtxt - "There should be two spaces after a period" - bb b be e))))))) - (set-syntax-table old-syntax-table)) + (errtxt nil) bb be) + (with-syntax-table checkdoc-syntax-table + (goto-char begin) + (while (re-search-forward "[^ .0-9]\\(\\. \\)[^ \n]" end t) + (let ((b (match-beginning 1)) + (e (match-end 1))) + (unless (or (checkdoc-in-sample-code-p begin end) + (checkdoc-in-example-string-p begin end) + (save-excursion + (goto-char b) + (condition-case nil + (progn + (forward-sexp -1) + ;; piece of an abbreviation + ;; FIXME etc + (looking-at + "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\.")) + (error t)))) + (if (checkdoc-autofix-ask-replace + b e + "There should be two spaces after a period. Fix? " + ". ") + nil + (if errtxt + ;; If there is already an error, then generate + ;; the warning output if applicable + (if checkdoc-generate-compile-warnings-flag + (checkdoc-create-error + "There should be two spaces after a period" + b e)) + (setq errtxt + "There should be two spaces after a period" + bb b be e))))))) (if errtxt (checkdoc-create-error errtxt bb be)))))) ;;; Ispell engine @@ -2657,8 +2641,7 @@ (setq checkdoc-pending-errors nil) nil))) -(custom-add-option 'emacs-lisp-mode-hook - (lambda () (checkdoc-minor-mode 1))) +(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode) (add-to-list 'debug-ignored-errors "Argument `.*' should appear (as .*) in the doc string")
--- a/lisp/emacs-lisp/cl-loaddefs.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emacs-lisp/cl-loaddefs.el Wed Nov 17 13:09:08 2010 +0900 @@ -282,7 +282,7 @@ ;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from ;;;;;; return block etypecase typecase ecase case load-time-value ;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp -;;;;;; gensym) "cl-macs" "cl-macs.el" "82f8370745a60dc26536a0237cba893f") +;;;;;; gensym) "cl-macs" "cl-macs.el" "979862b54946a5fcbbccdd90fa3f84d8") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\
--- a/lisp/emacs-lisp/cl-macs.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emacs-lisp/cl-macs.el Wed Nov 17 13:09:08 2010 +0900 @@ -1748,15 +1748,6 @@ (defsetf default-file-modes set-default-file-modes t) (defsetf default-value set-default) (defsetf documentation-property put) -(defsetf extent-data set-extent-data) -(defsetf extent-face set-extent-face) -(defsetf extent-priority set-extent-priority) -(defsetf extent-end-position (ext) (store) - (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext) - store) store)) -(defsetf extent-start-position (ext) (store) - (list 'progn (list 'set-extent-endpoints store - (list 'extent-end-position ext)) store)) (defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) (defsetf face-background-pixmap (f &optional s) (x) (list 'set-face-background-pixmap f x s))
--- a/lisp/emacs-lisp/package.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emacs-lisp/package.el Wed Nov 17 13:09:08 2010 +0900 @@ -753,6 +753,7 @@ (defun package-read-all-archive-contents () "Re-read `archive-contents', if it exists. If successful, set `package-archive-contents'." + (setq package-archive-contents nil) (dolist (archive package-archives) (package-read-archive-contents (car archive))))
--- a/lisp/emacs-lisp/pcase.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emacs-lisp/pcase.el Wed Nov 17 13:09:08 2010 +0900 @@ -75,7 +75,7 @@ E.g. you can match pairs where the cdr is larger than the car with a pattern like `(,a . ,(pred (< a))) or, with more checks: `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" - (declare (indent 1) (debug case)) + (declare (indent 1) (debug case)) ;FIXME: edebug `guard' and vars. (or (gethash (cons exp cases) pcase-memoize) (puthash (cons exp cases) (pcase-expand exp cases) @@ -86,6 +86,7 @@ "Like `let*' but where you can use `pcase' patterns for bindings. BODY should be an expression, and BINDINGS should be a list of bindings of the form (UPAT EXP)." + (declare (indent 1) (debug let)) (if (null bindings) body `(pcase ,(cadr (car bindings)) (,(caar bindings) (pcase-let* ,(cdr bindings) ,body)) @@ -98,6 +99,7 @@ "Like `let' but where you can use `pcase' patterns for bindings. BODY should be an expression, and BINDINGS should be a list of bindings of the form (UPAT EXP)." + (declare (indent 1) (debug let)) (if (null (cdr bindings)) `(pcase-let* ,bindings ,body) (setq bindings (mapcar (lambda (x) (cons (make-symbol "x") x)) bindings))
--- a/lisp/emulation/edt.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emulation/edt.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,4 +1,4 @@ -;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs 19 +;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs ;; Copyright (C) 1986, 1992, 1993, 1994, 1995, 2000, 2001, 2002, 2003, ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 @@ -28,7 +28,7 @@ ;;; Commentary: ;; -;; This is Version 4.0 of the EDT Emulation for Emacs 19 and above. +;; This is Version 4.0 of the EDT Emulation for Emacs. ;; It comes with special functions which replicate nearly all of EDT's ;; keypad mode behavior. It sets up default keypad and function key ;; bindings which closely match those found in EDT. Support is @@ -89,8 +89,8 @@ ;; settings for that session. ;; ;; NOTE: Another way to set the scroll margins is to use the -;; Emacs customization feature (not available in Emacs 19) to set -;; the following two variables directly: +;; Emacs customization feature to set the following two variables +;; directly: ;; ;; edt-top-scroll-margin and edt-bottom-scroll-margin ;; @@ -667,6 +667,25 @@ (goto-char (point-max)) (edt-line-to-bottom-of-window)) +(defmacro edt-with-position (&rest body) + "Execute BODY with some position-related variables bound." + `(let* ((left nil) + (beg (edt-current-line)) + (height (window-height)) + (top-percent + (if (zerop edt-top-scroll-margin) 10 edt-top-scroll-margin)) + (bottom-percent + (if (zerop edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) + (top-margin (/ (* height top-percent) 100)) + (bottom-up-margin (1+ (/ (* height bottom-percent) 100))) + (bottom-margin (max beg (- height bottom-up-margin 1))) + (top (save-excursion (move-to-window-line top-margin) (point))) + (bottom (save-excursion (move-to-window-line bottom-margin) (point))) + (far (save-excursion + (goto-char bottom) + (point-at-bol (1- height))))) + ,@body)) + ;;; ;;; FIND ;;; @@ -675,57 +694,29 @@ "Find first occurrence of a string in forward direction and save it. Optional argument FIND is t is this function is called from `edt-find'." (interactive) - (if (not find) - (set 'edt-find-last-text (read-string "Search forward: "))) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (if (search-forward edt-find-last-text) - (progn - (search-backward edt-find-last-text) - (edt-set-match) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))))) + (or find + (setq edt-find-last-text (read-string "Search forward: "))) + (edt-with-position + (when (search-forward edt-find-last-text) ; FIXME noerror? + (search-backward edt-find-last-text) + (edt-set-match) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin))))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-find-backward (&optional find) "Find first occurrence of a string in the backward direction and save it. Optional argument FIND is t if this function is called from `edt-find'." (interactive) - (if (not find) - (set 'edt-find-last-text (read-string "Search backward: "))) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (if (search-backward edt-find-last-text) - (edt-set-match)) - (and (< (point) top) (recenter (min beg top-margin)))) + (or find + (setq edt-find-last-text (read-string "Search backward: "))) + (edt-with-position + (if (search-backward edt-find-last-text) + (edt-set-match)) + (and (< (point) top) (recenter (min beg top-margin)))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-find () @@ -744,58 +735,29 @@ (defun edt-find-next-forward () "Find next occurrence of a string in forward direction." (interactive) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (forward-char 1) - (if (search-forward edt-find-last-text nil t) - (progn - (search-backward edt-find-last-text) - (edt-set-match) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))) - (progn - (backward-char 1) - (error "Search failed: \"%s\"" edt-find-last-text)))) + (edt-with-position + (forward-char 1) + (if (search-forward edt-find-last-text nil t) + (progn + (search-backward edt-find-last-text) + (edt-set-match) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) + (backward-char 1) + (error "Search failed: \"%s\"" edt-find-last-text))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-find-next-backward () "Find next occurrence of a string in backward direction." (interactive) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (if (not (search-backward edt-find-last-text nil t)) - (error "Search failed: \"%s\"" edt-find-last-text) - (progn - (edt-set-match) - (and (< (point) top) (recenter (min beg top-margin)))))) + (edt-with-position + (if (not (search-backward edt-find-last-text nil t)) + (error "Search failed: \"%s\"" edt-find-last-text) + (edt-set-match) + (and (< (point) top) (recenter (min beg top-margin))))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-find-next () @@ -1318,33 +1280,17 @@ Argument NUM is the positive number of sentences to move." (interactive "p") (edt-check-prefix num) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (if (eobp) - (progn - (error "End of buffer")) - (progn - (forward-sentence num) - (forward-word 1) - (backward-sentence))) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))) + (edt-with-position + (if (eobp) + (error "End of buffer") + (forward-sentence num) + (forward-word 1) + (backward-sentence)) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-sentence-backward (num) @@ -1352,25 +1298,11 @@ Argument NUM is the positive number of sentences to move." (interactive "p") (edt-check-prefix num) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (if (eobp) - (progn - (error "End of buffer")) - (backward-sentence num)) - (and (< (point) top) (recenter (min beg top-margin)))) + (edt-with-position + (if (eobp) + (error "End of buffer") + (backward-sentence num)) + (and (< (point) top) (recenter (min beg top-margin)))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-sentence (num) @@ -1390,32 +1322,18 @@ Argument NUM is the positive number of paragraphs to move." (interactive "p") (edt-check-prefix num) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (while (> num 0) - (forward-paragraph (+ num 1)) - (start-of-paragraph-text) - (if (eolp) - (forward-line 1)) - (setq num (1- num))) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))) + (edt-with-position + (while (> num 0) + (forward-paragraph (+ num 1)) + (start-of-paragraph-text) + (if (eolp) + (forward-line 1)) + (setq num (1- num))) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-paragraph-backward (num) @@ -1423,24 +1341,11 @@ Argument NUM is the positive number of paragraphs to move." (interactive "p") (edt-check-prefix num) - (let* ((left nil) - (beg (edt-current-line)) - (height (window-height)) - (top-percent - (if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) - (bottom-percent - (if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (while (> num 0) - (start-of-paragraph-text) - (setq num (1- num))) - (and (< (point) top) (recenter (min beg top-margin)))) + (edt-with-position + (while (> num 0) + (start-of-paragraph-text) + (setq num (1- num))) + (and (< (point) top) (recenter (min beg top-margin)))) (if (featurep 'xemacs) (setq zmacs-region-stays t))) (defun edt-paragraph (num) @@ -2701,5 +2606,4 @@ (provide 'edt) -;; arch-tag: 18d1c54f-6900-4078-8bbc-7c2292f48941 ;;; edt.el ends here
--- a/lisp/emulation/tpu-edt.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emulation/tpu-edt.el Wed Nov 17 13:09:08 2010 +0900 @@ -2438,7 +2438,7 @@ ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins -;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "78abc50917c93d2b35596d307fc638c4") +;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "fe5b7795d6b6720a98b805ee47a08bdf") ;;; Generated autoloads from tpu-extras.el (autoload 'tpu-cursor-free-mode "tpu-extras" "\
--- a/lisp/emulation/tpu-extras.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emulation/tpu-extras.el Wed Nov 17 13:09:08 2010 +0900 @@ -276,36 +276,41 @@ ;;; Movement by paragraph +;; Cf edt-with-position. +(defmacro tpu-with-position (&rest body) + "Execute BODY with some position-related variables bound." + `(let* ((left nil) + (beg (tpu-current-line)) + (height (window-height)) + (top-percent + (if (zerop tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) + (bottom-percent + (if (zerop tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) + (top-margin (/ (* height top-percent) 100)) + (bottom-up-margin (1+ (/ (* height bottom-percent) 100))) + (bottom-margin (max beg (- height bottom-up-margin 1))) + (top (save-excursion (move-to-window-line top-margin) (point))) + (bottom (save-excursion (move-to-window-line bottom-margin) (point))) + (far (save-excursion + (goto-char bottom) + (point-at-bol (1- height))))) + ,@body)) + (defun tpu-paragraph (num) "Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." (interactive "p") - (let* ((left nil) - (beg (tpu-current-line)) - (height (window-height)) - (top-percent - (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) - (bottom-percent - (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (cond (tpu-advance - (tpu-next-paragraph num) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))) - (t - (tpu-previous-paragraph num) - (and (< (point) top) (recenter (min beg top-margin))))))) - + (tpu-with-position + (if tpu-advance + (progn + (tpu-next-paragraph num) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) + (tpu-previous-paragraph num) + (and (< (point) top) (recenter (min beg top-margin)))))) ;;; Movement by page @@ -313,32 +318,17 @@ "Move to the next page in the current direction. A repeat count means move that many pages." (interactive "p") - (let* ((left nil) - (beg (tpu-current-line)) - (height (window-height)) - (top-percent - (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) - (bottom-percent - (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (cond (tpu-advance - (forward-page num) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))) - (t - (backward-page num) - (and (< (point) top) (recenter (min beg top-margin))))))) - + (tpu-with-position + (if tpu-advance + (progn + (forward-page num) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) + (backward-page num) + (and (< (point) top) (recenter (min beg top-margin)))))) ;;; Scrolling @@ -367,31 +357,16 @@ (defun tpu-search-internal (pat &optional quiet) "Search for a string or regular expression." - (let* ((left nil) - (beg (tpu-current-line)) - (height (window-height)) - (top-percent - (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) - (bottom-percent - (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (tpu-search-internal-core pat quiet) - (if tpu-searching-forward - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin)))) - (and (< (point) top) (recenter (min beg top-margin)))))) - - + (tpu-with-position + (tpu-search-internal-core pat quiet) + (if tpu-searching-forward + (progn + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) + (and (< (point) top) (recenter (min beg top-margin)))))) ;; Advise the newline, newline-and-indent, and do-auto-fill functions. (defadvice newline (around tpu-respect-bottom-scroll-margin activate disable) @@ -463,5 +438,4 @@ ;; generated-autoload-file: "tpu-edt.el" ;; End: -;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a ;;; tpu-extras.el ends here
--- a/lisp/emulation/viper-cmd.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emulation/viper-cmd.el Wed Nov 17 13:09:08 2010 +0900 @@ -3498,11 +3498,8 @@ (if (and (eolp) (not (bolp))) (forward-char -1)) (if (not (looking-at "[][(){}]")) (setq anchor-point (point))) - (save-excursion - (beginning-of-line) - (setq beg-lim (point)) - (end-of-line) - (setq end-lim (point))) + (setq beg-lim (point-at-bol) + end-lim (point-at-eol)) (cond ((re-search-forward "[][(){}]" end-lim t) (backward-char) ) ((re-search-backward "[][(){}]" beg-lim t)) @@ -4625,9 +4622,7 @@ (delete-char -1) (setq p (point)) (setq indent nil))) - (save-excursion - (beginning-of-line) - (setq bol (point))) + (setq bol (point-at-bol)) (if (re-search-backward "[^ \t]" bol 1) (forward-char)) (delete-region (point) p) (if indent @@ -4711,9 +4706,7 @@ (goto-char pos) (beginning-of-line) (if (re-search-backward "[^ \t]" nil t) - (progn - (beginning-of-line) - (setq s (point)))) + (setq s (point-at-bol))) (goto-char pos) (forward-line 1) (if (re-search-forward "[^ \t]" nil t)
--- a/lisp/emulation/viper-init.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/emulation/viper-init.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; viper-init.el --- some common definitions for Viper -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Package: viper @@ -63,9 +63,10 @@ (defun viper-window-display-p () (and (viper-device-type) (not (memq (viper-device-type) '(tty stream pc))))) -(defcustom viper-ms-style-os-p (memq system-type - '(ms-dos windows-nt windows-95)) - "Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95." +(defcustom viper-ms-style-os-p + (memq system-type (if (featurep 'emacs) '(ms-dos windows-nt) + '(ms-dos windows-nt windows-95))) + "Non-nil if Emacs is running under an MS-style OS: MS-DOS, or MS-Windows." :type 'boolean :tag "Is it Microsoft-made OS?" :group 'viper-misc) @@ -996,5 +997,4 @@ ;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) ;; End: -;; arch-tag: 4efa2416-1fcb-4690-be10-1a2a0248d250 ;;; viper-init.el ends here
--- a/lisp/epa.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/epa.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,5 +1,7 @@ ;;; epa.el --- the EasyPG Assistant -;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: PGP, GnuPG @@ -471,11 +473,9 @@ 'epa-key)) (setq keys (cons key keys)))) (nreverse keys))) - (save-excursion - (beginning-of-line) - (let ((key (get-text-property (point) 'epa-key))) - (if key - (list key)))))) + (let ((key (get-text-property (point-at-bol) 'epa-key))) + (if key + (list key))))) (defun epa--select-keys (prompt keys) (unless (and epa-keys-buffer @@ -1251,5 +1251,4 @@ (provide 'epa) -;; arch-tag: 38d20ced-20d5-4137-b17a-f206335423d7 ;;; epa.el ends here
--- a/lisp/erc/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/erc/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,7 @@ +2010-11-11 Glenn Morris <rgm@gnu.org> + + * erc-lang.el (erc-cmd-LANG): Fix what may have been a typo. + 2010-11-05 Lars Magne Ingebrigtsen <larsi@gnus.org> * erc-backend.el (erc-coding-system-precedence): New variable.
--- a/lisp/erc/erc-lang.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/erc/erc-lang.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,6 +1,7 @@ ;;; erc-lang.el --- provide the LANG command to ERC -;; Copyright (C) 2002, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2004, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Alex Schroeder <alex@gnu.org> @@ -197,17 +198,14 @@ iso-638-languages))) (message "%s" (cdr (assoc code iso-638-languages)))) -(defvar line) ; dynamically bound in erc-process-input-line - (defun erc-cmd-LANG (language) "Display the language name for the language code given by LANGUAGE." (let ((lang (cdr (assoc language iso-638-languages)))) (erc-display-message nil 'notice 'active - (or lang (concat line ": No such domain")))) + (or lang (concat language ": No such domain")))) t) (provide 'erc-lang) -;; arch-tag: 8ffb1563-cc03-4517-b067-16309d4ff97b ;;; erc-lang.el ends here
--- a/lisp/eshell/em-glob.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/eshell/em-glob.el Wed Nov 17 13:09:08 2010 +0900 @@ -246,7 +246,7 @@ (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))" (let ((paths (eshell-split-path glob)) - matches message-shown ange-cache) + eshell-glob-matches message-shown ange-cache) (unwind-protect (if (and (cdr paths) (file-name-absolute-p (car paths))) @@ -255,15 +255,15 @@ (eshell-glob-entries (file-name-as-directory ".") paths)) (if message-shown (message nil))) - (or (and matches (sort matches #'string<)) + (or (and eshell-glob-matches (sort eshell-glob-matches #'string<)) (if eshell-error-if-no-glob (error "No matches found: %s" glob) glob)))) -(defvar matches) +(defvar eshell-glob-matches) (defvar message-shown) -;; FIXME does this really need to abuse matches, message-shown? +;; FIXME does this really need to abuse eshell-glob-matches, message-shown? (defun eshell-glob-entries (path globs &optional recurse-p) "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil." (let* ((entries (ignore-errors @@ -319,7 +319,7 @@ "\\`\\."))) (when (and recurse-p eshell-glob-show-progress) (message "Building file list...%d so far: %s" - (length matches) path) + (length eshell-glob-matches) path) (setq message-shown t)) (if (equal path "./") (setq path "")) (while entries @@ -332,7 +332,8 @@ (if (cdr globs) (if isdir (setq dirs (cons (concat path name) dirs))) - (setq matches (cons (concat path name) matches)))) + (setq eshell-glob-matches + (cons (concat path name) eshell-glob-matches)))) (if (and recurse-p isdir (or (> len 3) (not (or (and (= len 2) (equal name "./")) @@ -358,5 +359,4 @@ ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: d0548f54-fb7c-4978-a88e-f7c26f7f68ca ;;; em-glob.el ends here
--- a/lisp/eshell/em-ls.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/eshell/em-ls.el Wed Nov 17 13:09:08 2010 +0900 @@ -612,11 +612,11 @@ (let ((result (cond ((eq sort-method 'by-atime) - (eshell-ls-compare-entries l r 4 'eshell-time-less-p)) + (eshell-ls-compare-entries l r 4 'time-less-p)) ((eq sort-method 'by-mtime) - (eshell-ls-compare-entries l r 5 'eshell-time-less-p)) + (eshell-ls-compare-entries l r 5 'time-less-p)) ((eq sort-method 'by-ctime) - (eshell-ls-compare-entries l r 6 'eshell-time-less-p)) + (eshell-ls-compare-entries l r 6 'time-less-p)) ((eq sort-method 'by-size) (eshell-ls-compare-entries l r 7 '<)) ((eq sort-method 'by-extension) @@ -941,5 +941,4 @@ ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb ;;; em-ls.el ends here
--- a/lisp/eshell/em-pred.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/eshell/em-pred.el Wed Nov 17 13:09:08 2010 +0900 @@ -427,7 +427,7 @@ (forward-char)) (if (looking-at "[0-9]+") (progn - (setq when (- (eshell-time-to-seconds (current-time)) + (setq when (- (float-time) (* (string-to-number (match-string 0)) quantum))) (goto-char (match-end 0))) @@ -444,7 +444,7 @@ (attrs (file-attributes file))) (unless attrs (error "Cannot stat file `%s'" file)) - (setq when (eshell-time-to-seconds (nth attr-index attrs)))) + (setq when (float-time (nth attr-index attrs)))) (goto-char (1+ end))) `(lambda (file) (let ((attrs (file-attributes file))) @@ -453,7 +453,7 @@ '< (if (eq qual ?+) '> - '=)) ,when (eshell-time-to-seconds + '=)) ,when (float-time (nth ,attr-index attrs)))))))) (defun eshell-pred-file-type (type) @@ -605,5 +605,4 @@ ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: 8b5ce022-17f3-4c40-93c7-5faafaa63f31 ;;; em-pred.el ends here
--- a/lisp/eshell/em-unix.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/eshell/em-unix.el Wed Nov 17 13:09:08 2010 +0900 @@ -154,10 +154,10 @@ (defalias 'eshell/basename 'file-name-nondirectory) (defalias 'eshell/dirname 'file-name-directory) -(defvar interactive) -(defvar preview) -(defvar recursive) -(defvar verbose) +(defvar em-interactive) +(defvar em-preview) +(defvar em-recursive) +(defvar em-verbose) (defun eshell/man (&rest args) "Invoke man, flattening the arguments appropriately." @@ -204,21 +204,21 @@ (if (and (file-directory-p (car files)) (not (file-symlink-p (car files)))) (progn - (if verbose + (if em-verbose (eshell-printn (format "rm: removing directory `%s'" (car files)))) (unless - (or preview - (and interactive + (or em-preview + (and em-interactive (not (y-or-n-p (format "rm: remove directory `%s'? " (car files)))))) (eshell-funcalln 'delete-directory (car files) t t))) - (if verbose + (if em-verbose (eshell-printn (format "rm: removing file `%s'" (car files)))) - (unless (or preview - (and interactive + (unless (or em-preview + (and em-interactive (not (y-or-n-p (format "rm: remove `%s'? " (car files)))))) @@ -235,21 +235,21 @@ "rm" args '((?h "help" nil nil "show this usage screen") (?f "force" nil force-removal "force removal") - (?i "interactive" nil interactive "prompt before any removal") - (?n "preview" nil preview "don't change anything on disk") - (?r "recursive" nil recursive + (?i "interactive" nil em-interactive "prompt before any removal") + (?n "preview" nil em-preview "don't change anything on disk") + (?r "recursive" nil em-recursive "remove the contents of directories recursively") - (?R nil nil recursive "(same)") - (?v "verbose" nil verbose "explain what is being done") + (?R nil nil em-recursive "(same)") + (?v "verbose" nil em-verbose "explain what is being done") :preserve-args :external "rm" :show-usage :usage "[OPTION]... FILE... Remove (unlink) the FILE(s).") - (unless interactive - (setq interactive eshell-rm-interactive-query)) - (if (and force-removal interactive) - (setq interactive nil)) + (unless em-interactive + (setq em-interactive eshell-rm-interactive-query)) + (if (and force-removal em-interactive) + (setq em-interactive nil)) (while args (let ((entry (if (stringp (car args)) (directory-file-name (car args)) @@ -258,37 +258,37 @@ (car args))))) (cond ((bufferp entry) - (if verbose + (if em-verbose (eshell-printn (format "rm: removing buffer `%s'" entry))) - (unless (or preview - (and interactive + (unless (or em-preview + (and em-interactive (not (y-or-n-p (format "rm: delete buffer `%s'? " entry))))) (eshell-funcalln 'kill-buffer entry))) ((eshell-processp entry) - (if verbose + (if em-verbose (eshell-printn (format "rm: killing process `%s'" entry))) - (unless (or preview - (and interactive + (unless (or em-preview + (and em-interactive (not (y-or-n-p (format "rm: kill process `%s'? " entry))))) (eshell-funcalln 'kill-process entry))) ((symbolp entry) - (if verbose + (if em-verbose (eshell-printn (format "rm: uninterning symbol `%s'" entry))) (unless - (or preview - (and interactive + (or em-preview + (and em-interactive (not (y-or-n-p (format "rm: unintern symbol `%s'? " entry))))) (eshell-funcalln 'unintern entry))) ((stringp entry) (if (and (file-directory-p entry) (not (file-symlink-p entry))) - (if (or recursive + (if (or em-recursive eshell-rm-removes-directories) - (if (or preview - (not interactive) + (if (or em-preview + (not em-interactive) (y-or-n-p (format "rm: descend into directory `%s'? " entry))) @@ -333,8 +333,6 @@ (put 'eshell/rmdir 'eshell-no-numeric-conversions t) (defvar no-dereference) -(defvar preview) -(defvar verbose) (defvar eshell-warn-dot-directories t) @@ -342,9 +340,9 @@ "Shuffle around some filesystem entries, using FUNC to do the work." (let ((attr-target (eshell-file-attributes target)) (is-dir (or (file-directory-p target) - (and preview (not eshell-warn-dot-directories)))) + (and em-preview (not eshell-warn-dot-directories)))) attr) - (if (and (not preview) (not is-dir) + (if (and (not em-preview) (not is-dir) (> (length files) 1)) (error "%s: when %s multiple files, last argument must be a directory" command action)) @@ -381,7 +379,7 @@ (not (memq func '(make-symbolic-link add-name-to-file)))) (if (and (eq func 'copy-file) - (not recursive)) + (not em-recursive)) (eshell-error (format "%s: %s: omitting directory\n" command (car files))) (let (eshell-warn-dot-directories) @@ -399,11 +397,11 @@ (expand-file-name target))))))) (apply 'eshell-funcalln func source target args) (unless (file-directory-p target) - (if verbose + (if em-verbose (eshell-printn (format "%s: making directory %s" command target))) - (unless preview + (unless em-preview (eshell-funcalln 'make-directory target))) (apply 'eshell-shuffle-files command action @@ -414,16 +412,16 @@ (directory-files source)) target func t args) (when (eq func 'rename-file) - (if verbose + (if em-verbose (eshell-printn (format "%s: deleting directory %s" command source))) - (unless preview + (unless em-preview (eshell-funcalln 'delete-directory source)))))) - (if verbose + (if em-verbose (eshell-printn (format "%s: %s -> %s" command source target))) - (unless preview + (unless em-preview (if (and no-dereference (setq link (file-symlink-p source))) (progn @@ -448,7 +446,7 @@ (if (file-exists-p archive) (setq tar-args (concat "u" tar-args)) (setq tar-args (concat "c" tar-args))) - (if verbose + (if em-verbose (setq tar-args (concat "v" tar-args))) (if (equal command "mv") (setq tar-args (concat "--remove-files -" tar-args))) @@ -481,7 +479,7 @@ (eshell-shuffle-files ,command ,action args target ,func nil ,@(append - `((if (and (or interactive + `((if (and (or em-interactive ,query-var) (not force)) 1 (or force ,force-var))) @@ -495,11 +493,11 @@ "mv" args '((?f "force" nil force "remove existing destinations, never prompt") - (?i "interactive" nil interactive + (?i "interactive" nil em-interactive "request confirmation if target already exists") - (?n "preview" nil preview + (?n "preview" nil em-preview "don't change anything on disk") - (?v "verbose" nil verbose + (?v "verbose" nil em-verbose "explain what is being done") (nil "help" nil nil "show this usage screen") :preserve-args @@ -526,15 +524,15 @@ "preserve links") (?f "force" nil force "remove existing destinations, never prompt") - (?i "interactive" nil interactive + (?i "interactive" nil em-interactive "request confirmation if target already exists") - (?n "preview" nil preview + (?n "preview" nil em-preview "don't change anything on disk") (?p "preserve" nil preserve "preserve file attributes if possible") - (?R "recursive" nil recursive + (?R "recursive" nil em-recursive "copy directories recursively") - (?v "verbose" nil verbose + (?v "verbose" nil em-verbose "explain what is being done") (nil "help" nil nil "show this usage screen") :preserve-args @@ -544,7 +542,7 @@ or: cp [OPTION]... SOURCE... DIRECTORY Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") (if archive - (setq preserve t no-dereference t recursive t)) + (setq preserve t no-dereference t em-recursive t)) (eshell-mvcpln-template "cp" "copying" 'copy-file eshell-cp-interactive-query eshell-cp-overwrite-files preserve))) @@ -558,12 +556,12 @@ '((?h "help" nil nil "show this usage screen") (?s "symbolic" nil symbolic "make symbolic links instead of hard links") - (?i "interactive" nil interactive + (?i "interactive" nil em-interactive "request confirmation if target already exists") (?f "force" nil force "remove existing destinations, never prompt") - (?n "preview" nil preview + (?n "preview" nil em-preview "don't change anything on disk") - (?v "verbose" nil verbose "explain what is being done") + (?v "verbose" nil em-verbose "explain what is being done") :preserve-args :external "ln" :show-usage @@ -914,9 +912,7 @@ (defvar eshell-time-start nil) (defun eshell-show-elapsed-time () - (let ((elapsed (format "%.3f secs\n" - (- (eshell-time-to-seconds (current-time)) - eshell-time-start)))) + (let ((elapsed (format "%.3f secs\n" (- (float-time) eshell-time-start)))) (set-text-properties 0 (length elapsed) '(face bold) elapsed) (eshell-interactive-print elapsed)) (remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t)) @@ -942,7 +938,7 @@ :show-usage :usage "COMMAND... Show wall-clock time elapsed during execution of COMMAND.") - (setq eshell-time-start (eshell-time-to-seconds (current-time))) + (setq eshell-time-start (float-time)) (add-hook 'eshell-post-command-hook 'eshell-show-elapsed-time nil t) ;; after setting (throw 'eshell-replace-command @@ -1121,5 +1117,4 @@ ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: 2462edd2-a76a-4cf2-897d-92e9a82ac1c9 ;;; em-unix.el ends here
--- a/lisp/eshell/esh-opt.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/eshell/esh-opt.el Wed Nov 17 13:09:08 2010 +0900 @@ -64,10 +64,9 @@ macro-args (list 'eshell-stringify-list (list 'eshell-flatten-list macro-args))))) - (let ,(append (mapcar (function - (lambda (opt) - (or (and (listp opt) (nth 3 opt)) - 'eshell-option-stub))) + (let ,(append (mapcar (lambda (opt) + (or (and (listp opt) (nth 3 opt)) + 'eshell-option-stub)) (cadr options)) '(usage-msg last-value ext-command args)) (eshell-do-opt ,name ,options (quote ,body-forms))))) @@ -78,6 +77,7 @@ (defvar last-value) (defvar usage-msg) (defvar ext-command) +;; Documented part of the interface; see eshell-eval-using-options. (defvar args) (defun eshell-do-opt (name options body-forms) @@ -224,5 +224,4 @@ (setq index (1+ index))))))))) args) -;; arch-tag: 45c6c2d0-8091-46a1-a205-2f4bafd8230c ;;; esh-opt.el ends here
--- a/lisp/eshell/esh-test.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/eshell/esh-test.el Wed Nov 17 13:09:08 2010 +0900 @@ -150,7 +150,7 @@ (defun eshell-test (&optional arg) "Test Eshell to verify that it works as expected." (interactive "P") - (let* ((begin (eshell-time-to-seconds (current-time))) + (let* ((begin (float-time)) (test-buffer (get-buffer-create "*eshell test*"))) (set-buffer (let ((inhibit-redisplay t)) (save-window-excursion (eshell t)))) @@ -176,8 +176,7 @@ (with-current-buffer test-buffer (insert (format "\n\n--- %s --- (completed in %d seconds)\n" (current-time-string) - (- (eshell-time-to-seconds (current-time)) - begin))) + (- (float-time) begin))) (message "Eshell test suite completed: %s failure%s" (if (> eshell-test-failures 0) (number-to-string eshell-test-failures) @@ -223,14 +222,13 @@ (if (eq eshell-show-usage-metrics t) (- eshell-metric-after-command eshell-metric-before-command 7) - (- (eshell-time-to-seconds + (- (float-time eshell-metric-after-command) - (eshell-time-to-seconds + (float-time eshell-metric-before-command)))) "\n")))) nil t)) (provide 'esh-test) -;; arch-tag: 6e32275a-8285-4a4e-b7cf-819aa7c86b8e ;;; esh-test.el ends here
--- a/lisp/eshell/esh-util.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/eshell/esh-util.el Wed Nov 17 13:09:08 2010 +0900 @@ -341,20 +341,6 @@ "Flatten and stringify all of the ARGS into a single string." (mapconcat 'eshell-stringify (eshell-flatten-list args) " ")) -;; the next two are from GNUS, and really should be made part of Emacs -;; some day -(defsubst eshell-time-less-p (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - -(defsubst eshell-time-to-seconds (time) - "Convert TIME to a floating point number." - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (car (cdr (cdr time))) 0) 1000000.0))) - (defsubst eshell-directory-files (regexp &optional directory) "Return a list of files in the given DIRECTORY matching REGEXP." (directory-files (or directory default-directory) @@ -468,7 +454,7 @@ "Read the contents of /etc/passwd for user names." (if (or (not (symbol-value result-var)) (not (symbol-value timestamp-var)) - (eshell-time-less-p + (time-less-p (symbol-value timestamp-var) (nth 5 (file-attributes file)))) (progn @@ -522,7 +508,7 @@ "Read the contents of /etc/passwd for user names." (if (or (not (symbol-value result-var)) (not (symbol-value timestamp-var)) - (eshell-time-less-p + (time-less-p (symbol-value timestamp-var) (nth 5 (file-attributes file)))) (progn
--- a/lisp/filecache.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/filecache.el Wed Nov 17 13:09:08 2010 +0900 @@ -207,7 +207,7 @@ :group 'file-cache) (defcustom file-cache-completion-ignore-case - (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (if (memq system-type '(ms-dos windows-nt cygwin)) t completion-ignore-case) "If non-nil, file-cache completion should ignore case. @@ -216,7 +216,7 @@ :group 'file-cache) (defcustom file-cache-case-fold-search - (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (if (memq system-type '(ms-dos windows-nt cygwin)) t case-fold-search) "If non-nil, file-cache completion should ignore case. @@ -225,7 +225,7 @@ :group 'file-cache) (defcustom file-cache-ignore-case - (memq system-type (list 'ms-dos 'windows-nt 'cygwin)) + (memq system-type '(ms-dos windows-nt cygwin)) "Non-nil means ignore case when checking completions in the file cache. Defaults to nil on DOS and Windows, and t on other systems." :type 'boolean @@ -687,5 +687,4 @@ (provide 'filecache) -;; arch-tag: 433d3ca4-4af2-47ce-b2cf-1f727460f538 ;;; filecache.el ends here
--- a/lisp/files.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/files.el Wed Nov 17 13:09:08 2010 +0900 @@ -124,6 +124,7 @@ This variable is relevant only if `backup-by-copying' is nil." :type 'boolean :group 'backup) +(put 'backup-by-copying-when-mismatch 'permanent-local t) (defcustom backup-by-copying-when-privileged-mismatch 200 "Non-nil means create backups by copying to preserve a privileged owner.
--- a/lisp/frame.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/frame.el Wed Nov 17 13:09:08 2010 +0900 @@ -296,22 +296,19 @@ (null frame-initial-frame)) ;; This case happens when we don't have a window system, and ;; also for MS-DOS frames. - (let ((parms (frame-parameters frame-initial-frame))) + (let ((parms (frame-parameters))) ;; Don't change the frame names. (setq parms (delq (assq 'name parms) parms)) ;; Can't modify the minibuffer parameter, so don't try. (setq parms (delq (assq 'minibuffer parms) parms)) - (modify-frame-parameters nil - (if (null initial-window-system) - (append initial-frame-alist - window-system-frame-alist - default-frame-alist - parms - nil) - ;; initial-frame-alist and - ;; default-frame-alist were already - ;; applied in pc-win.el. - parms)) + (modify-frame-parameters + nil + (if initial-window-system + parms + ;; initial-frame-alist and default-frame-alist were already + ;; applied in pc-win.el. + (append initial-frame-alist window-system-frame-alist + default-frame-alist parms nil))) (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el (let ((newparms (frame-parameters)) (frame (selected-frame))) @@ -512,25 +509,28 @@ ;; it is undesirable to specify the parm again ;; once the user has seen the frame and been able to alter it ;; manually. - (while tail - (let (newval oldval) - (setq oldval (assq (car (car tail)) - frame-initial-frame-alist)) - (setq newval (cdr (assq (car (car tail)) allparms))) + (let (newval oldval) + (dolist (entry tail) + (setq oldval (assq (car entry) frame-initial-frame-alist)) + (setq newval (cdr (assq (car entry) allparms))) (or (and oldval (eq (cdr oldval) newval)) (setq newparms - (cons (cons (car (car tail)) newval) newparms)))) - (setq tail (cdr tail))) + (cons (cons (car entry) newval) newparms))))) (setq newparms (nreverse newparms)) - (modify-frame-parameters frame-initial-frame - newparms) - ;; If we changed the background color, - ;; we need to update the background-mode parameter - ;; and maybe some faces too. - (when (assq 'background-color newparms) - (unless (assq 'background-mode newparms) - (frame-set-background-mode frame-initial-frame)) - (face-set-after-frame-default frame-initial-frame))))) + + (let ((new-bg (assq 'background-color newparms))) + ;; If the `background-color' parameter is changed, apply + ;; it first, then make sure that the `background-mode' + ;; parameter and other faces are updated, before applying + ;; the other parameters. + (when new-bg + (modify-frame-parameters frame-initial-frame + (list new-bg)) + (unless (assq 'background-mode newparms) + (frame-set-background-mode frame-initial-frame)) + (face-set-after-frame-default frame-initial-frame) + (setq newparms (delq new-bg newparms))) + (modify-frame-parameters frame-initial-frame newparms))))) ;; Restore the original buffer. (set-buffer old-buffer)
--- a/lisp/gnus/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,142 @@ +2010-11-16 Daniel Dehennin <daniel.dehennin@baby-gnu.org> + + * mml2015.el (mml2015-epg-sign): Use From header. + +2010-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-images): Register a displayer. + + * gnus-util.el (gnus-find-text-property-region): Return markers. + + * shr.el (shr-tag-img): Put a displayer in the text property. + + * gnus-util.el (gnus-find-text-property-region): New utility function. + + * gnus-html.el (gnus-html-display-image): Make the alt optional. + (gnus-html-show-images): Remove. + + * gnus-art.el (gnus-article-show-images): New, more general function. + + * gnus-html.el: Use image-url instead of gnus-image-url to unify the + image url text properties. + + * shr.el: Ditto. + + * gnus-agent.el (gnus-agentize): Only do the auto-agentizing if + gnus-agent-auto-agentize-methods is set. Which it isn't. + +2010-11-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-move-article): Fix `while' loop to make it + work for two or more articles. + +2010-11-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (article-treat-non-ascii): Keep text properties not to + divide an image that's in an html article to two or more when washing + non-ASCII characters in alt text of it. + +2010-11-11 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-decode.el (mm-dissect-buffer): Pass sender's mail address to + smime-decrypt-region using function argument. + (mm-possibly-verify-or-decrypt, mm-dissect-multipart): Relay it. + + * mm-view.el (mm-view-pkcs7, mm-view-pkcs7-decrypt): Relay it. + + * smime.el (smime-decrypt-region): Catch it. + +2010-11-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * smime.el (smime-mode-map): Move initialization into declaration. + (gnus-run-mode-hooks): Don't autoload. + (smime-mode): Use define-derived-mode. + +2010-11-11 Glenn Morris <rgm@gnu.org> + + * smime.el (from): Restrict declaration to XEmacs. + + * nnir.el (gnus-group-topic-name): Autoload. + +2010-11-11 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-insert): Don't break long line if it is because of + kinsoku-bol characters in the line end. + +2010-11-11 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-request-move-article): Fix to provide original group + and subject. + (nnir-warp-to-article): Don't fail on articles whose headers haven't + been retrieved. + + * gnus-sum.el (gnus-summary-move-article): Use original group and + subject for virtual articles such as those in an nnir summary buffer. + +2010-11-11 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (article-treat-non-ascii): Make it work for XEmacs (at + least 21.5). + + * smime.el (from): Declare it again for XEmacs. + +2010-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-resend): Don't disable encoding unless it's + already encoded. + + * nnimap.el (nnimap-update-info): Fix problem with `g' chopping of + low-numbered articles. + +2010-11-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * rfc2047.el (rfc2047-syntax-table): Simplify. + + * gnus-art.el (article-treat-non-ascii): Use put-char-table instead of + set-char-table-range for XEmacs. + +2010-11-10 Glenn Morris <rgm@gnu.org> + + * smime.el (from): Remove unused declaration. + + * gnus-util.el (with-no-warnings): Remove compat stub, now unused. + (gnus-float-time): On Emacs, always an alias. + + * ecomplete.el (with-no-warnings): Remove compat stub, now unused. + (ecomplete-add-item): Use float-time on Emacs, else gnus-float-time. + +2010-11-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (org-entities): Declare it to silence the byte compiler. + +2010-11-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (browse-url-mailto): Autoload. + + * gnus-art.el (article-treat-non-ascii): New command and keystroke. + + * message.el (message-subject-trailing-was-ask-regexp): A ] in a [] + regexp doesn't need quoting. + +2010-11-09 Sven Joachim <svenjoac@gmx.de> + + * message.el (message-subject-trailing-was-ask-regexp) + (message-subject-trailing-was-regexp): Match was: in addition to was. + +2010-11-09 Glenn Morris <rgm@gnu.org> + + * nnbabyl.el (nnbabyl-request-move-article, nnbabyl-delete-mail) + (nnbabyl-check-mbox): Use point-at-bol. + +2010-11-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-browse-url): Call browse-url-mailto for mailto: links. + + * message.el (message-mailto): New function. + (message-mailto): Should accept other parameters. + (message-mailto): Remove since it duplicates browse-url-mailto + functionality. + 2010-11-07 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-start.el (gnus-get-unread-articles): Ignore totally non-existent @@ -17909,7 +18048,8 @@ See ChangeLog.2 for earlier changes. - Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs.
--- a/lisp/gnus/ecomplete.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/ecomplete.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,6 +1,7 @@ ;;; ecomplete.el --- electric completion of addresses and the like -;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: mail @@ -27,11 +28,6 @@ (eval-when-compile (require 'cl)) -(eval-when-compile - (unless (fboundp 'with-no-warnings) - (defmacro with-no-warnings (&rest body) - `(progn ,@body)))) - (defgroup ecomplete nil "Electric completion of email addresses and the like." :group 'mail) @@ -61,11 +57,10 @@ (defun ecomplete-add-item (type key text) (let ((elems (assq type ecomplete-database)) (now (string-to-number - (format "%.0f" (if (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) + (format "%.0f" (if (featurep 'emacs) (float-time) - (with-no-warnings - (time-to-seconds (current-time))))))) + (require 'gnus-util) + (gnus-float-time))))) entry) (unless elems (push (setq elems (list type)) ecomplete-database))
--- a/lisp/gnus/gnus-agent.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/gnus-agent.el Wed Nov 17 13:09:08 2010 +0900 @@ -695,7 +695,9 @@ ;; If the servers file doesn't exist, auto-agentize some servers and ;; save the servers file so this auto-agentizing isn't invoked ;; again. - (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers")) + (when (and (not (file-exists-p (nnheader-concat + gnus-agent-directory "lib/servers"))) + gnus-agent-auto-agentize-methods) (gnus-message 3 "First time agent user, agentizing remote groups...") (mapc (lambda (server-or-method)
--- a/lisp/gnus/gnus-art.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/gnus-art.el Wed Nov 17 13:09:08 2010 +0900 @@ -2114,6 +2114,35 @@ (interactive) (article-translate-strings gnus-article-dumbquotes-map)) +(defvar org-entities) + +(defun article-treat-non-ascii () + "Translate many Unicode characters into their ASCII equivalents." + (interactive) + (require 'org-entities) + (let ((table (make-char-table (if (featurep 'xemacs) 'generic)))) + (dolist (elem org-entities) + (when (and (listp elem) + (= (length (nth 6 elem)) 1)) + (if (featurep 'xemacs) + (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table) + (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem))))) + (save-excursion + (when (article-goto-body) + (let ((inhibit-read-only t) + replace props) + (while (not (eobp)) + (if (not (setq replace (if (featurep 'xemacs) + (get-char-table (following-char) table) + (aref table (following-char))))) + (forward-char 1) + (if (prog1 + (setq props (text-properties-at (point))) + (delete-char 1)) + (add-text-properties (point) (progn (insert replace) (point)) + props) + (insert replace))))))))) + (defun article-translate-characters (from to) "Translate all characters in the body of the article according to FROM and TO. FROM is a string of characters to translate from; to is a string of @@ -2242,6 +2271,17 @@ (dolist (elem gnus-article-image-alist) (gnus-delete-images (car elem))))) +(defun gnus-article-show-images () + "Show any images that are in the HTML-rendered article buffer. +This only works if the article in question is HTML." + (interactive) + (gnus-with-article-buffer + (dolist (region (gnus-find-text-property-region (point-min) (point-max) + 'image-displayer)) + (destructuring-bind (start end function) region + (funcall function (get-text-property start 'image-url) + start end))))) + (defun gnus-article-treat-fold-newsgroups () "Unfold folded message headers. Only the headers that fit into the current window width will be @@ -4248,6 +4288,7 @@ article-date-lapsed article-emphasize article-treat-dumbquotes + article-treat-non-ascii article-normalize-headers ;;(article-show-all . gnus-article-show-all-headers) )))
--- a/lisp/gnus/gnus-html.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/gnus-html.el Wed Nov 17 13:09:08 2010 +0900 @@ -189,19 +189,26 @@ (let* ((handle (mm-get-content-id (setq url (match-string 1 url)))) (image (when handle - (gnus-create-image (mm-with-part handle (buffer-string)) - nil t)))) + (gnus-create-image + (mm-with-part handle (buffer-string)) + nil t)))) (when image (let ((string (buffer-substring start end))) (delete-region start end) - (gnus-put-image (gnus-rescale-image image (gnus-html-maximum-image-size)) + (gnus-put-image (gnus-rescale-image + image (gnus-html-maximum-image-size)) (gnus-string-or string "*") 'cid) (gnus-add-image 'cid image)))) ;; Normal, external URL. - (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" - parameters) - (xml-substitute-special (match-string 2 parameters))))) - (gnus-put-text-property start end 'gnus-image-url url) + (let ((alt-text + (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" + parameters) + (xml-substitute-special (match-string 2 parameters))))) + (gnus-put-text-property start end 'image-url url) + (gnus-put-text-property + start end 'image-displayer + (lambda (url start end) + (gnus-html-display-image url start end))) (if (gnus-html-image-url-blocked-p url (if (buffer-live-p gnus-summary-buffer) @@ -237,7 +244,7 @@ (> width 4))) (gnus-html-display-image url start end alt-text)))))))))) -(defun gnus-html-display-image (url start end alt-text) +(defun gnus-html-display-image (url start end &optional alt-text) "Display image at URL on text from START to END. Use ALT-TEXT for the image string." (if (gnus-html-cache-expired url gnus-html-image-cache-ttl) @@ -247,7 +254,7 @@ (current-buffer) (list url alt-text)) ;; It's already cached, so just insert it. - (gnus-html-put-image (gnus-html-get-image-data url) url alt-text))) + (gnus-html-put-image (gnus-html-get-image-data url) url (or alt-text "*")))) (defun gnus-html-wash-tags () (let (tag parameters string start end images url) @@ -344,7 +351,7 @@ (defun gnus-html-browse-image () "Browse the image under point." (interactive) - (browse-url (get-text-property (point) 'gnus-image-url))) + (browse-url (get-text-property (point) 'image-url))) (defun gnus-html-browse-url () "Browse the image under point." @@ -415,9 +422,9 @@ "Put an image with DATA from URL and optional ALT-TEXT." (when (gnus-graphic-display-p) (let* ((start (text-property-any (point-min) (point-max) - 'gnus-image-url url)) + 'image-url url)) (end (when start - (next-single-property-change start 'gnus-image-url)))) + (next-single-property-change start 'image-url)))) ;; Image found? (when start (let* ((image @@ -459,7 +466,7 @@ 'gnus-alt-text alt-text) (when url (gnus-put-text-property start (point) - 'gnus-image-url url)) + 'image-url url)) (gnus-add-image 'external image) t) ;; Bad image, try to show something else @@ -482,16 +489,6 @@ url blocked-images)) ret)) -(defun gnus-html-show-images () - "Show any images that are in the HTML-rendered article buffer. -This only works if the article in question is HTML." - (interactive) - (gnus-with-article-buffer - (dolist (overlay (overlays-in (point-min) (point-max))) - (let ((o (overlay-get overlay 'gnus-image))) - (when o - (apply 'gnus-html-display-image o)))))) - ;;;###autoload (defun gnus-html-prefetch-images (summary) (when (buffer-live-p summary)
--- a/lisp/gnus/gnus-sum.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/gnus-sum.el Wed Nov 17 13:09:08 2010 +0900 @@ -1310,6 +1310,7 @@ (defvar gnus-article-decoded-p nil) (defvar gnus-article-charset nil) (defvar gnus-article-ignored-charsets nil) +(defvar gnus-article-original-subject nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-page-broken nil) @@ -1335,6 +1336,7 @@ (defvar gnus-current-copy-group nil) (defvar gnus-current-crosspost-group nil) (defvar gnus-newsgroup-display nil) +(defvar gnus-newsgroup-original-name nil) (defvar gnus-newsgroup-dependencies nil) (defvar gnus-newsgroup-adaptive nil) @@ -2096,6 +2098,7 @@ "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive "p" gnus-article-verify-x-pgp-sig "d" gnus-article-treat-dumbquotes + "U" gnus-article-treat-non-ascii "i" gnus-summary-idna-message) (gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) @@ -2133,7 +2136,7 @@ "d" gnus-article-display-face "s" gnus-treat-smiley "D" gnus-article-remove-images - "W" gnus-html-show-images + "W" gnus-article-show-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon "n" gnus-treat-newsgroups-picon @@ -2420,6 +2423,7 @@ gnus-article-remove-leading-whitespace t]) ["Overstrike" gnus-article-treat-overstrike t] ["Dumb quotes" gnus-article-treat-dumbquotes t] + ["Non-ASCII" gnus-article-treat-non-ascii t] ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] ["Fill long lines" gnus-article-fill-long-lines t] @@ -9701,196 +9705,210 @@ articles) (while articles (setq article (pop articles)) - (setq - art-group - (cond - ;; Move the article. - ((eq action 'move) - ;; Remove this article from future suppression. - (gnus-dup-unsuppress-article article) - (let* ((from-method (gnus-find-method-for-group - gnus-newsgroup-name)) - (to-method (or select-method - (gnus-find-method-for-group to-newsgroup))) - (move-is-internal (gnus-server-equal from-method to-method))) - (gnus-request-move-article - article ; Article to move - gnus-newsgroup-name ; From newsgroup - (nth 1 (gnus-find-method-for-group - gnus-newsgroup-name)) ; Server - (list 'gnus-request-accept-article - to-newsgroup (list 'quote select-method) - (not articles) t) ; Accept form - (not articles) ; Only save nov last time - (and move-is-internal - to-newsgroup ; Not respooling - (gnus-group-real-name to-newsgroup))))) ; Is this move internal? - ;; Copy the article. - ((eq action 'copy) - (with-current-buffer copy-buf - (when (gnus-request-article-this-buffer article gnus-newsgroup-name) - (save-restriction - (nnheader-narrow-to-headers) - (dolist (hdr gnus-copy-article-ignored-headers) - (message-remove-header hdr t))) - (gnus-request-accept-article - to-newsgroup select-method (not articles) t)))) - ;; Crosspost the article. - ((eq action 'crosspost) - (let ((xref (message-tokenize-header - (mail-header-xref (gnus-summary-article-header article)) - " "))) - (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) - ":" (number-to-string article))) - (unless xref - (setq xref (list (system-name)))) - (setq new-xref - (concat - (mapconcat 'identity - (delete "Xref:" (delete new-xref xref)) - " ") - " " new-xref)) + (let ((gnus-newsgroup-original-name gnus-newsgroup-name) + (gnus-article-original-subject + (mail-header-subject + (gnus-data-header (assoc article (gnus-data-list nil)))))) + (setq + art-group + (cond + ;; Move the article. + ((eq action 'move) + ;; Remove this article from future suppression. + (gnus-dup-unsuppress-article article) + (let* ((from-method (gnus-find-method-for-group + gnus-newsgroup-name)) + (to-method (or select-method + (gnus-find-method-for-group to-newsgroup))) + (move-is-internal (gnus-server-equal from-method to-method))) + (gnus-request-move-article + article ; Article to move + gnus-newsgroup-name ; From newsgroup + (nth 1 (gnus-find-method-for-group + gnus-newsgroup-name)) ; Server + (list 'gnus-request-accept-article + to-newsgroup (list 'quote select-method) + (not articles) t) ; Accept form + (not articles) ; Only save nov last time + (and move-is-internal + to-newsgroup ; Not respooling + ; Is this move internal? + (gnus-group-real-name to-newsgroup))))) + ;; Copy the article. + ((eq action 'copy) (with-current-buffer copy-buf - ;; First put the article in the destination group. - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (when (consp (setq art-group - (gnus-request-accept-article - to-newsgroup select-method (not articles) t))) - (setq new-xref (concat new-xref " " (car art-group) - ":" - (number-to-string (cdr art-group)))) - ;; Now we have the new Xrefs header, so we insert - ;; it and replace the new article. - (nnheader-replace-header "Xref" new-xref) - (gnus-request-replace-article - (cdr art-group) to-newsgroup (current-buffer) t) - art-group)))))) - (cond - ((not art-group) - (gnus-message 1 "Couldn't %s article %s: %s" - (cadr (assq action names)) article - (nnheader-get-report (car to-method)))) - ((eq art-group 'junk) - (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article) - ;; run the delete hook - (run-hook-with-args 'gnus-summary-article-delete-hook - action - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name nil - select-method))) - (t - (let* ((pto-group (gnus-group-prefixed-name - (car art-group) to-method)) - (info (gnus-get-info pto-group)) - (to-group (gnus-info-group info)) - to-marks) - ;; Update the group that has been moved to. - (when (and info - (memq action '(move copy))) - (unless (member to-group to-groups) - (push to-group to-groups)) - - (unless (memq article gnus-newsgroup-unreads) - (push 'read to-marks) - (gnus-info-set-read - info (gnus-add-to-range (gnus-info-read info) - (list (cdr art-group))))) - - ;; See whether the article is to be put in the cache. - (let* ((expirable (gnus-group-auto-expirable-p to-group)) - (marks (if expirable - gnus-article-mark-lists - (delete '(expirable . expire) - (copy-sequence gnus-article-mark-lists)))) - (to-article (cdr art-group))) - - ;; Enter the article into the cache in the new group, - ;; if that is required. - (when gnus-use-cache - (gnus-cache-possibly-enter-article - to-group to-article - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))) - - (when gnus-preserve-marks - ;; Copy any marks over to the new group. - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - ;; Increase the active status of this group. - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - (push (cdar marks) to-marks) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info))) - (setq marks (cdr marks))) - - (when (and expirable - gnus-mark-copied-or-moved-articles-as-expirable - (not (memq 'expire to-marks))) - ;; Mark this article as expirable. - (push 'expire to-marks) - (when (equal to-group gnus-newsgroup-name) - (push to-article gnus-newsgroup-expirable)) - ;; Copy the expirable mark to other group. - (gnus-add-marked-articles - to-group 'expire (list to-article) info)) - - (when to-marks - (gnus-request-set-mark - to-group (list (list (list to-article) 'add to-marks))))) - - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (gnus-get-info to-group)) - ")")))) - - ;; Update the Xref header in this article to point to - ;; the new crossposted article we have just created. - (when (eq action 'crosspost) - (with-current-buffer copy-buf - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (nnheader-replace-header "Xref" new-xref) - (gnus-request-replace-article - article gnus-newsgroup-name (current-buffer) t))) - - ;; run the move/copy/crosspost/respool hook - (run-hook-with-args 'gnus-summary-article-move-hook - action - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - to-newsgroup - select-method)) - - ;;;!!!Why is this necessary? - (set-buffer gnus-summary-buffer) - - (when (eq action 'move) - (save-excursion - (gnus-summary-goto-subject article) - (gnus-summary-mark-article article gnus-canceled-mark))))) - (push article articles-to-update-marks)) + (when (gnus-request-article-this-buffer article + gnus-newsgroup-name) + (save-restriction + (nnheader-narrow-to-headers) + (dolist (hdr gnus-copy-article-ignored-headers) + (message-remove-header hdr t))) + (gnus-request-accept-article + to-newsgroup select-method (not articles) t)))) + ;; Crosspost the article. + ((eq action 'crosspost) + (let ((xref (message-tokenize-header + (mail-header-xref (gnus-summary-article-header + article)) + " "))) + (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) + ":" (number-to-string article))) + (unless xref + (setq xref (list (system-name)))) + (setq new-xref + (concat + (mapconcat 'identity + (delete "Xref:" (delete new-xref xref)) + " ") + " " new-xref)) + (with-current-buffer copy-buf + ;; First put the article in the destination group. + (gnus-request-article-this-buffer article gnus-newsgroup-name) + (when (consp (setq art-group + (gnus-request-accept-article + to-newsgroup select-method (not articles) + t))) + (setq new-xref (concat new-xref " " (car art-group) + ":" + (number-to-string (cdr art-group)))) + ;; Now we have the new Xrefs header, so we insert + ;; it and replace the new article. + (nnheader-replace-header "Xref" new-xref) + (gnus-request-replace-article + (cdr art-group) to-newsgroup (current-buffer) t) + art-group)))))) + (cond + ((not art-group) + (gnus-message 1 "Couldn't %s article %s: %s" + (cadr (assq action names)) article + (nnheader-get-report (car to-method)))) + ((eq art-group 'junk) + (when (eq action 'move) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article) + ;; run the delete hook + (run-hook-with-args 'gnus-summary-article-delete-hook + action + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-original-name nil + select-method))) + (t + (let* ((pto-group (gnus-group-prefixed-name + (car art-group) to-method)) + (info (gnus-get-info pto-group)) + (to-group (gnus-info-group info)) + to-marks) + ;; Update the group that has been moved to. + (when (and info + (memq action '(move copy))) + (unless (member to-group to-groups) + (push to-group to-groups)) + + (unless (memq article gnus-newsgroup-unreads) + (push 'read to-marks) + (gnus-info-set-read + info (gnus-add-to-range (gnus-info-read info) + (list (cdr art-group))))) + + ;; See whether the article is to be put in the cache. + (let* ((expirable (gnus-group-auto-expirable-p to-group)) + (marks (if expirable + gnus-article-mark-lists + (delete '(expirable . expire) + (copy-sequence + gnus-article-mark-lists)))) + (to-article (cdr art-group))) + + ;; Enter the article into the cache in the new group, + ;; if that is required. + (when gnus-use-cache + (gnus-cache-possibly-enter-article + to-group to-article + (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-dormant) + (memq article gnus-newsgroup-unreads))) + + (when gnus-preserve-marks + ;; Copy any marks over to the new group. + (when (and (equal to-group gnus-newsgroup-name) + (not (memq article gnus-newsgroup-unreads))) + ;; Mark this article as read in this group. + (push (cons to-article gnus-read-mark) + gnus-newsgroup-reads) + ;; Increase the active status of this group. + (setcdr (gnus-active to-group) to-article) + (setcdr gnus-newsgroup-active to-article)) + + (while marks + (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (when (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))) + (push (cdar marks) to-marks) + ;; If the other group is the same as this group, + ;; then we have to add the mark to the list. + (when (equal to-group gnus-newsgroup-name) + (set (intern (format "gnus-newsgroup-%s" + (caar marks))) + (cons to-article + (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))))) + ;; Copy the marks to other group. + (gnus-add-marked-articles + to-group (cdar marks) (list to-article) info))) + (setq marks (cdr marks))) + + (when (and expirable + gnus-mark-copied-or-moved-articles-as-expirable + (not (memq 'expire to-marks))) + ;; Mark this article as expirable. + (push 'expire to-marks) + (when (equal to-group gnus-newsgroup-name) + (push to-article gnus-newsgroup-expirable)) + ;; Copy the expirable mark to other group. + (gnus-add-marked-articles + to-group 'expire (list to-article) info)) + + (when to-marks + (gnus-request-set-mark + to-group (list (list (list to-article) 'add to-marks))))) + + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string (gnus-get-info to-group)) + ")")))) + + ;; Update the Xref header in this article to point to + ;; the new crossposted article we have just created. + (when (eq action 'crosspost) + (with-current-buffer copy-buf + (gnus-request-article-this-buffer article gnus-newsgroup-name) + (nnheader-replace-header "Xref" new-xref) + (gnus-request-replace-article + article gnus-newsgroup-name (current-buffer) t))) + + ;; run the move/copy/crosspost/respool hook + (let ((header (gnus-data-header + (assoc article (gnus-data-list nil))))) + (mail-header-set-subject header gnus-article-original-subject) + (run-hook-with-args 'gnus-summary-article-move-hook + action + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-original-name + to-newsgroup + select-method))) + + ;;;!!!Why is this necessary? + (set-buffer gnus-summary-buffer) + + (when (eq action 'move) + (save-excursion + (gnus-summary-goto-subject article) + (gnus-summary-mark-article article gnus-canceled-mark))))) + (push article articles-to-update-marks))) (save-excursion (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
--- a/lisp/gnus/gnus-util.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/gnus-util.el Wed Nov 17 13:09:08 2010 +0900 @@ -39,11 +39,6 @@ (eval-when-compile (require 'cl)) -(eval-when-compile - (unless (fboundp 'with-no-warnings) - (defmacro with-no-warnings (&rest body) - `(progn ,@body)))) - (defcustom gnus-completing-read-function 'gnus-emacs-completing-read "Function use to do completing read." :version "24.1" @@ -282,6 +277,24 @@ (setq start (when end (next-single-property-change start prop)))))) +(defun gnus-find-text-property-region (start end prop) + "Return a list of text property regions that has property PROP." + (let (regions value) + (unless (get-text-property start prop) + (setq start (next-single-property-change start prop))) + (while start + (setq value (get-text-property start prop) + end (text-property-not-all start (point-max) prop value)) + (if (not end) + (setq start nil) + (when value + (push (list (set-marker (make-marker) start) + (set-marker (make-marker) end) + value) + regions)) + (setq start (next-single-property-change start prop)))) + (nreverse regions))) + (defun gnus-newsgroup-directory-form (newsgroup) "Make hierarchical directory name from NEWSGROUP name." (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup)) @@ -320,13 +333,14 @@ (> (nth 1 fdate) (nth 1 date)))))) (eval-and-compile - (if (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) + (if (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time)))) (defalias 'gnus-float-time 'float-time) (defun gnus-float-time (&optional time) "Convert time value TIME to a floating point number. TIME defaults to the current time." - (with-no-warnings (time-to-seconds (or time (current-time))))))) + (time-to-seconds (or time (current-time)))))) ;;; Keymap macros.
--- a/lisp/gnus/gnus.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/gnus.el Wed Nov 17 13:09:08 2010 +0900 @@ -2876,7 +2876,6 @@ gnus-start-date-timer gnus-stop-date-timer gnus-mime-view-all-parts) ("gnus-int" gnus-request-type) - ("gnus-html" gnus-html-show-images) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch gnus-check-reasonable-setup)
--- a/lisp/gnus/message.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/message.el Wed Nov 17 13:09:08 2010 +0900 @@ -322,7 +322,7 @@ :group 'message-various) (defcustom message-subject-trailing-was-ask-regexp - "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)" + "[ \t]*\\([[(]+[Ww][Aa][Ss]:?[ \t]*.*[])]+\\)" "*Regexp matching \"(was: <old subject>)\" in the subject line. The function `message-strip-subject-trailing-was' uses this regexp if @@ -7432,7 +7432,11 @@ (when (looking-at "From ") (replace-match "X-From-Line: ")) ;; Send it. - (let ((message-inhibit-body-encoding t) + (let ((message-inhibit-body-encoding + ;; Don't do any further encoding if it looks like the + ;; message has already been encoded. + (let ((case-fold-search t)) + (re-search-forward "^mime-version:" nil t))) (message-inhibit-ecomplete t) message-required-mail-headers message-generate-hashcash
--- a/lisp/gnus/mm-decode.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/mm-decode.el Wed Nov 17 13:09:08 2010 +0900 @@ -624,7 +624,7 @@ no-strict-mime (and cd (mail-header-parse-content-disposition cd)) description id) - ctl)))) + ctl from)))) (when id (when (string-match " *<\\(.*\\)> *" id) (setq id (match-string 1 id))) @@ -666,7 +666,7 @@ (save-restriction (narrow-to-region start end) (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts))))) - (mm-possibly-verify-or-decrypt (nreverse parts) ctl))) + (mm-possibly-verify-or-decrypt (nreverse parts) ctl from))) (defun mm-copy-to-buffer () "Copy the contents of the current buffer to a fresh buffer." @@ -1569,7 +1569,7 @@ (autoload 'mm-view-pkcs7 "mm-view") -(defun mm-possibly-verify-or-decrypt (parts ctl) +(defun mm-possibly-verify-or-decrypt (parts ctl &optional from) (let ((type (car ctl)) (subtype (cadr (split-string (car ctl) "/"))) (mm-security-handle ctl) ;; (car CTL) is the type. @@ -1584,7 +1584,7 @@ ((eq mm-decrypt-option 'known) t) (t (y-or-n-p (format "Decrypt (S/MIME) part? ")))) - (mm-view-pkcs7 parts)) + (mm-view-pkcs7 parts from)) (setq parts (mm-dissect-buffer t))))) ((equal subtype "signed") (unless (and (setq protocol
--- a/lisp/gnus/mm-view.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/mm-view.el Wed Nov 17 13:09:08 2010 +0900 @@ -653,9 +653,9 @@ (t (error "Could not identify PKCS#7 type"))))) -(defun mm-view-pkcs7 (handle) +(defun mm-view-pkcs7 (handle &optional from) (case (mm-view-pkcs7-get-type handle) - (enveloped (mm-view-pkcs7-decrypt handle)) + (enveloped (mm-view-pkcs7-decrypt handle from)) (signed (mm-view-pkcs7-verify handle)) (otherwise (error "Unknown or unimplemented PKCS#7 type")))) @@ -680,7 +680,7 @@ (replace-match "\n")) t) -(defun mm-view-pkcs7-decrypt (handle) +(defun mm-view-pkcs7-decrypt (handle &optional from) (insert-buffer-substring (mm-handle-buffer handle)) (goto-char (point-min)) (insert "MIME-Version: 1.0\n") @@ -692,7 +692,8 @@ (smime-get-key-by-email (gnus-completing-read "Decipher using key" - smime-keys nil nil nil (car-safe (car-safe smime-keys)))))) + smime-keys nil nil nil (car-safe (car-safe smime-keys))))) + from) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n"))
--- a/lisp/gnus/mml2015.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/mml2015.el Wed Nov 17 13:09:08 2010 +0900 @@ -941,6 +941,7 @@ (let* ((inhibit-redisplay t) (context (epg-make-context)) (boundary (mml-compute-boundary cont)) + (sender (message-options-get 'message-sender)) signer-key (signers (or (message-options-get 'mml2015-epg-signers) @@ -950,8 +951,8 @@ (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " - mml2015-signers t) - (if mml2015-signers + (cons sender mml2015-signers) t) + (if (or sender mml2015-signers) (delq nil (mapcar (lambda (signer) @@ -965,7 +966,7 @@ signer))) (error "No secret key for %s" signer)) signer-key) - mml2015-signers))))))) + (cons sender mml2015-signers)))))))) signature micalg) (epg-context-set-armor context t) (epg-context-set-textmode context t) @@ -1008,6 +1009,7 @@ (let ((inhibit-redisplay t) (context (epg-make-context)) (config (epg-configuration)) + (sender (message-options-get 'message-sender)) (recipients (message-options-get 'mml2015-epg-recipients)) cipher signers (boundary (mml-compute-boundary cont)) @@ -1025,9 +1027,9 @@ (read-string "Recipients: "))) "[ \f\t\n\r\v,]+")))) (when mml2015-encrypt-to-self - (unless mml2015-signers - (error "mml2015-signers not set")) - (setq recipients (nconc recipients mml2015-signers))) + (unless (or sender mml2015-signers) + (error "Message sender and mml2015-signers not set")) + (setq recipients (nconc recipients (cons sender mml2015-signers)))) (if (eq mm-encrypt-option 'guided) (setq recipients (epa-select-keys context "\ @@ -1060,8 +1062,8 @@ (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " - mml2015-signers t) - (if mml2015-signers + (cons mml2015-signers) t) + (if (or sender mml2015-signers) (delq nil (mapcar (lambda (signer) @@ -1075,7 +1077,7 @@ signer))) (error "No secret key for %s" signer)) signer-key) - mml2015-signers))))))) + (cons mml2015-signers)))))))) (epg-context-set-signers context signers)) (epg-context-set-armor context t) (epg-context-set-textmode context t)
--- a/lisp/gnus/nnbabyl.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/nnbabyl.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,8 @@ ;;; nnbabyl.el --- rmail mbox access for Gnus ;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -309,8 +310,7 @@ (while (re-search-forward "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (delete-region (point-at-bol) (progn (forward-line 1) (point)))) (setq result (eval accept-form)) (kill-buffer (current-buffer)) result) @@ -427,9 +427,7 @@ (defun nnbabyl-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. (unless force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (delete-region (point-at-bol) (progn (forward-line 1) (point)))) ;; Beginning of the article. (save-excursion (save-restriction @@ -639,8 +637,7 @@ (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) (if (intern-soft (setq id (match-string 1)) idents) (progn - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) + (delete-region (point-at-bol) (progn (forward-line 1) (point))) (nnheader-message 7 "Moving %s..." id) (nnbabyl-save-mail (nnmail-article-group 'nnbabyl-active-number)))
--- a/lisp/gnus/nnimap.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/nnimap.el Wed Nov 17 13:09:08 2010 +0900 @@ -1155,13 +1155,16 @@ (not (gnus-active group))) (gnus-set-active group (cond + (active + (cons (min (or low (car active)) + (car active)) + (max (or high (cdr active)) + (cdr active)))) ((and low high) (cons low high)) (uidnext ;; No articles in this group. (cons uidnext (1- uidnext))) - (active - active) (start-article (cons start-article (1- start-article))) (t
--- a/lisp/gnus/nnir.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/nnir.el Wed Nov 17 13:09:08 2010 +0900 @@ -548,8 +548,6 @@ ;; in nnir group (when novitem (mail-header-set-number novitem art) - (mail-header-set-from novitem - (mail-header-from novitem)) (mail-header-set-subject novitem (format "[%d: %s/%d] %s" @@ -595,7 +593,13 @@ (to-newsgroup (nth 1 accept-form)) (to-method (gnus-find-method-for-group to-newsgroup)) (from-method (gnus-find-method-for-group artfullgroup)) - (move-is-internal (gnus-server-equal from-method to-method))) + (move-is-internal (gnus-server-equal from-method to-method)) + (artsubject (mail-header-subject + (gnus-data-header + (assoc article (gnus-data-list nil)))))) + (setq gnus-newsgroup-original-name artfullgroup) + (string-match "^\\[[0-9]+:.+/[0-9]+\\] " artsubject) + (setq gnus-article-original-subject (substring artsubject (match-end 0))) (gnus-request-move-article artno artfullgroup @@ -604,11 +608,12 @@ last (and move-is-internal to-newsgroup ; Not respooling - (gnus-group-real-name to-newsgroup))) ; Is this move internal - )) + (gnus-group-real-name to-newsgroup))))) (deffoo nnir-warp-to-article () - (let* ((cur (gnus-summary-article-number)) + (let* ((cur (if (> (gnus-summary-article-number) 0) + (gnus-summary-article-number) + (error "This is not a real article."))) (gnus-newsgroup-name (nnir-artlist-artitem-group nnir-artlist cur)) (backend-number (nnir-artlist-artitem-number nnir-artlist cur))) (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer @@ -1366,6 +1371,8 @@ (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) +(autoload 'gnus-group-topic-name "gnus-topic") + (defun nnir-run-query (query nserver) "Invoke appropriate search engine function (see `nnir-engines'). If some groups were process-marked, run the query for each of the groups @@ -1475,7 +1482,7 @@ (let ((server (gnus-group-server var))) (if (assoc server value) (nconc (cdr (assoc server value)) (list var)) - (push (cons (gnus-group-server var) (list var)) value)))) + (push (cons server (list var)) value)))) value) nil))
--- a/lisp/gnus/rfc2047.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/rfc2047.el Wed Nov 17 13:09:08 2010 +0900 @@ -346,13 +346,9 @@ ;; it appears to be the cleanest way. ;; Play safe and don't assume the form of the word syntax entry -- ;; copy it from ?a. - (if (fboundp 'set-char-table-range) ; Emacs - (funcall (intern "set-char-table-range") - table t (aref (standard-syntax-table) ?a)) - (if (fboundp 'put-char-table) - (if (fboundp 'get-char-table) ; warning avoidance - (put-char-table t (get-char-table ?a (standard-syntax-table)) - table)))) + (if (featurep 'xemacs) + (put-char-table t (get-char-table ?a (standard-syntax-table)) table) + (set-char-table-range table t (aref (standard-syntax-table) ?a))) (modify-syntax-entry ?\\ "\\" table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\( "(" table)
--- a/lisp/gnus/shr.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/shr.el Wed Nov 17 13:09:08 2010 +0900 @@ -154,7 +154,7 @@ (defun shr-browse-image () "Browse the image under point." (interactive) - (let ((url (get-text-property (point) 'shr-image))) + (let ((url (get-text-property (point) 'image-url))) (if (not url) (message "No image under point") (message "Browsing %s..." url) @@ -163,7 +163,7 @@ (defun shr-insert-image () "Insert the image under point into the buffer." (interactive) - (let ((url (get-text-property (point) 'shr-image))) + (let ((url (get-text-property (point) 'image-url))) (if (not url) (message "No image under point") (message "Inserting %s..." url) @@ -235,20 +235,23 @@ (aref elem 0))))) (delete-char -1))) (insert elem) - (while (> (current-column) shr-width) - (unless (prog1 - (shr-find-fill-point) - (when (eq (preceding-char) ? ) - (delete-char -1)) - (insert "\n")) - (put-text-property (1- (point)) (point) 'shr-break t) - ;; No space is needed at the beginning of a line. - (when (eq (following-char) ? ) - (delete-char 1))) - (when (> shr-indentation 0) - (shr-indent)) - (end-of-line)) - (insert " ")) + (let (found) + (while (and (> (current-column) shr-width) + (progn + (setq found (shr-find-fill-point)) + (not (eolp)))) + (when (eq (preceding-char) ? ) + (delete-char -1)) + (insert "\n") + (unless found + (put-text-property (1- (point)) (point) 'shr-break t) + ;; No space is needed at the beginning of a line. + (when (eq (following-char) ? ) + (delete-char 1))) + (when (> shr-indentation 0) + (shr-indent)) + (end-of-line)) + (insert " "))) (unless (string-match "[ \t\n]\\'" text) (delete-char -1))))) @@ -344,7 +347,7 @@ ((not url) (message "No link under point")) ((string-match "^mailto:" url) - (gnus-url-mailto url)) + (browse-url-mailto url)) (t (browse-url url))))) @@ -418,6 +421,7 @@ ;; url-cache-extract autoloads url-cache. (declare-function url-cache-create-filename "url-cache" (url)) (autoload 'mm-disable-multibyte "mm-util") +(autoload 'browse-url-mailto "browse-url") (defun shr-get-image-data (url) "Get image data for URL. @@ -568,7 +572,12 @@ t)))) (put-text-property start (point) 'keymap shr-map) (put-text-property start (point) 'shr-alt alt) - (put-text-property start (point) 'shr-image url) + (put-text-property start (point) 'image-url url) + (put-text-property start (point) 'image-displayer + (lambda (url start end) + (url-retrieve url 'shr-image-fetched + (list (current-buffer) start end) + t))) (put-text-property start (point) 'help-echo alt) (setq shr-state 'image)))))
--- a/lisp/gnus/smime.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/gnus/smime.el Wed Nov 17 13:09:08 2010 +0900 @@ -426,10 +426,9 @@ (insert-buffer-substring smime-details-buffer) nil)) -(defvar from) - -(defun smime-decrypt-region (b e keyfile) +(defun smime-decrypt-region (b e keyfile &optional from) "Decrypt S/MIME message in region between B and E with key in KEYFILE. +Optional FROM specifies sender's mail address. On success, replaces region with decrypted data and return non-nil. Any details (stderr on success, stdout and stderr on error) are left in the buffer specified by `smime-details-buffer'." @@ -452,8 +451,7 @@ (delete-file tmpfile))) (progn (delete-region b e) - (when (boundp 'from) - ;; `from' is dynamically bound in mm-dissect. + (when from (insert "From: " from "\n")) (insert-buffer-substring buffer) (kill-buffer buffer) @@ -647,20 +645,18 @@ (defvar smime-buffer "*SMIME*") -(defvar smime-mode-map nil) -(put 'smime-mode 'mode-class 'special) +(defvar smime-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "q" 'smime-exit) + (define-key map "f" 'smime-certificate-info) + map)) -(unless smime-mode-map - (setq smime-mode-map (make-sparse-keymap)) - (suppress-keymap smime-mode-map) - - (define-key smime-mode-map "q" 'smime-exit) - (define-key smime-mode-map "f" 'smime-certificate-info)) - -(autoload 'gnus-run-mode-hooks "gnus-util") (autoload 'gnus-completing-read "gnus-util") -(defun smime-mode () +(put 'smime-mode 'mode-class 'special) +(define-derived-mode smime-mode fundamental-mode ;special-mode + "SMIME" "Major mode for browsing, viewing and fetching certificates. All normal editing commands are switched off. @@ -669,16 +665,10 @@ The following commands are available: \\{smime-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'smime-mode) - (setq mode-name "SMIME") (setq mode-line-process nil) - (use-local-map smime-mode-map) (buffer-disable-undo) (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-run-mode-hooks 'smime-mode-hook)) + (setq buffer-read-only t)) (defun smime-certificate-info (certfile) (interactive "fCertificate file: ")
--- a/lisp/hippie-exp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/hippie-exp.el Wed Nov 17 13:09:08 2010 +0900 @@ -716,8 +716,7 @@ (defun he-line-beg (strip-prompt) (save-excursion (if (re-search-backward (he-line-search-regexp "" strip-prompt) - (save-excursion (beginning-of-line) - (point)) t) + (line-beginning-position) t) (match-beginning 2) (point)))) @@ -1184,5 +1183,4 @@ (provide 'hippie-exp) -;; arch-tag: 5e6e00bf-b061-4a7a-9b46-de0ae105ab99 ;;; hippie-exp.el ends here
--- a/lisp/info.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/info.el Wed Nov 17 13:09:08 2010 +0900 @@ -888,17 +888,16 @@ (let ((case-fold-search case-fold) found) (save-excursion - (when (Info-node-at-bob-matching regexp) - (setq found (point))) - (while (and (not found) - (search-forward "\n\^_" nil t)) - (forward-line 1) - (let ((beg (point))) - (forward-line 1) - (when (re-search-backward regexp beg t) - (beginning-of-line) - (setq found (point))))) - found))) + (if (Info-node-at-bob-matching regexp) + (setq found (point)) + (while (and (not found) + (search-forward "\n\^_" nil t)) + (forward-line 1) + (let ((beg (point))) + (forward-line 1) + (if (re-search-backward regexp beg t) + (setq found (line-beginning-position))))))) + found)) (defun Info-find-node-in-buffer (regexp) "Find a node or anchor in the current buffer. @@ -2323,11 +2322,8 @@ completions default alt-default (start-point (point)) str i bol eol) (save-excursion ;; Store end and beginning of line. - (end-of-line) - (setq eol (point)) - (beginning-of-line) - (setq bol (point)) - + (setq eol (line-end-position) + bol (line-beginning-position)) (goto-char (point-min)) (while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t) (setq str (match-string-no-properties 1)) @@ -2843,12 +2839,9 @@ (virtual-end (and Info-scroll-prefer-subnodes (save-excursion - (beginning-of-line) - (setq current-point (point)) + (setq current-point (line-beginning-position)) (goto-char (point-min)) - (search-forward "\n* Menu:" - current-point - t))))) + (search-forward "\n* Menu:" current-point t))))) (if (or virtual-end (pos-visible-in-window-p (point-min) nil t)) (Info-last-preorder)
--- a/lisp/international/characters.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/international/characters.el Wed Nov 17 13:09:08 2010 +0900 @@ -1294,40 +1294,48 @@ (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG ;;; Control of displaying glyphless characters. -(defvar glyphless-char-control +(defvar glyphless-char-display-control '((format-control . thin-space) - (no-font . hexa-code)) - "List of directives to control displaying of glyphless characters. + (no-font . hex-code)) + "List of directives to control display of glyphless characters. + +Each element has the form (GROUP . METHOD), where GROUP is a +symbol specifying the character group, and METHOD is a symbol +specifying the method of displaying characters belonging to that +group. -Each element has the form (TARGET . METHOD), where TARGET is a -symbol specifying the target character group to control, and -METHOD is a symbol specifying the method of displaying them. - -TARGET must be one of these symbols: - `c0-control': U+0000..U+001F. - `c1-control': U+0080..U+009F. - `format-control': Characters of Unicode General Category `Cf'. - Ex: U+200C (ZWNJ), U+200E (LRM)), but don't include characters - that have graphic image such as U+00AD (SHY). - `no-font': characters for which no suitable font is found. +GROUP must be one of these symbols: + `c0-control': U+0000..U+001F. + `c1-control': U+0080..U+009F. + `format-control': Characters of Unicode General Category `Cf', + such as U+200C (ZWNJ), U+200E (LRM), but + excluding characters that have graphic images, + such as U+00AD (SHY). + `no-font': characters for which no suitable font is found. + For character terminals, characters that cannot + be encoded by `terminal-coding-system'. METHOD must be one of these symbols: `zero-width': don't display. - `thin-space': display a thin space (1-pixel width). - `empty-box': display an empty box. - `acronym': display an acronum string in a box. - `hexa-code': display a hexadecimal character code in a box. + `thin-space': display a thin (1-pixel width) space. On character + terminals, display as 1-character space. + `empty-box': display an empty box. + `acronym': display an acronym of the character in a box. The + acronym is taken from `char-acronym-table', which see. + `hex-code': display the hexadecimal character code in a box. Just setting this variable does not take effect. Call the function `update-glyphless-char-display' (which see) after setting this variable.") (defun update-glyphless-char-display () - "Make the setting of `glyphless-char-control' take effect. + "Make the setting of `glyphless-char-display-control' take effect. This function updates the char-table `glyphless-char-display'." - (dolist (elt glyphless-char-control) + (dolist (elt glyphless-char-display-control) (let ((target (car elt)) (method (cdr elt))) + (or (memq method '(zero-width thin-space empty-box acronym hex-code)) + (error "Invalid glyphless character display method: %s" method)) (cond ((eq target 'c0-control) (set-char-table-range glyphless-char-display '(#x00 . #x1F) method)) @@ -1346,7 +1354,7 @@ (while (<= from to) (when (/= from #xAD) (if (eq method 'acronym) - (setq this-method + (setq this-method (aref char-acronym-table from))) (set-char-table-range glyphless-char-display from this-method)) @@ -1355,7 +1363,7 @@ ((eq target 'no-font) (set-char-table-extra-slot glyphless-char-display 0 method)) (t - (error "Invalid target character group: %s" target)))))) + (error "Invalid glyphless character group: %s" target)))))) (update-glyphless-char-display)
--- a/lisp/international/mule-cmds.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/international/mule-cmds.el Wed Nov 17 13:09:08 2010 +0900 @@ -2033,10 +2033,11 @@ "Do various unibyte-mode setups for language environment LANGUAGE-NAME." (set-display-table-and-terminal-coding-system language-name)) -(defsubst princ-list (&rest args) +(defun princ-list (&rest args) "Print all arguments with `princ', then print \"\\n\"." - (while args (princ (car args)) (setq args (cdr args))) + (mapc #'princ args) (princ "\n")) +(make-obsolete 'princ-list "use mapc and princ instead" "23.3") (put 'describe-specified-language-support 'apropos-inhibit t)
--- a/lisp/locate.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/locate.el Wed Nov 17 13:09:08 2010 +0900 @@ -97,7 +97,7 @@ ;; (defadvice dired-make-relative (before set-no-error activate) ;; "For locate mode and Windows, don't return errors" ;; (if (and (eq major-mode 'locate-mode) -;; (memq system-type (list 'windows-nt 'ms-dos))) +;; (memq system-type '(windows-nt ms-dos))) ;; (ad-set-arg 2 t) ;; )) ;; @@ -270,7 +270,7 @@ (defun locate (search-string &optional filter arg) "Run the program `locate', putting results in `*Locate*' buffer. Pass it SEARCH-STRING as argument. Interactively, prompt for SEARCH-STRING. -With prefix arg, prompt for the exact shell command to run instead. +With prefix arg ARG, prompt for the exact shell command to run instead. This program searches for those file names in a database that match SEARCH-STRING and normally outputs all matching absolute file names, @@ -286,7 +286,8 @@ The main use of FILTER is to implement `locate-with-filter'. See the docstring of that function for its meaning. -ARG is the interactive prefix arg." +After preparing the results buffer, this runs `dired-mode-hook' and +then `locate-post-command-hook'." (interactive (list (locate-prompt-for-search-string) @@ -300,8 +301,7 @@ (locate-cmd-args (cdr locate-cmd-list)) (run-locate-command (or (and arg (not locate-prompt-for-command)) - (and (not arg) locate-prompt-for-command))) - ) + (and (not arg) locate-prompt-for-command)))) ;; Find the Locate buffer (save-window-excursion @@ -323,16 +323,13 @@ (and filter (locate-filter-output filter)) - (locate-do-setup search-string) - )) + (locate-do-setup search-string))) (and (not (string-equal (buffer-name) locate-buffer-name)) (pop-to-buffer locate-buffer-name)) (run-hooks 'dired-mode-hook) (dired-next-line 3) ;move to first matching file. - (run-hooks 'locate-post-command-hook) - ) - ) + (run-hooks 'locate-post-command-hook))) ;;;###autoload (defun locate-with-filter (search-string filter &optional arg) @@ -447,6 +444,7 @@ \\<locate-mode-map>\ In that buffer, you can use almost all the usual dired bindings. \\[locate-find-directory] visits the directory of the file on the current line. +This function runs `locate-mode-hook' before returning. Operating on listed files works, but does not always automatically update the buffer as in ordinary Dired. @@ -687,5 +685,4 @@ (provide 'locate) -;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898 ;;; locate.el ends here
--- a/lisp/ls-lisp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/ls-lisp.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp -;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1994, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> ;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk> @@ -70,21 +70,37 @@ :version "21.1" :group 'dired) +(defun ls-lisp-set-options () + "Reset the ls-lisp options that depend on `ls-lisp-emulation'." + (mapc 'custom-reevaluate-setting + '(ls-lisp-ignore-case ls-lisp-dirs-first ls-lisp-verbosity))) + (defcustom ls-lisp-emulation (cond ;; ((eq system-type 'windows-nt) 'MS-Windows) - ((memq system-type - '(hpux usg-unix-v irix berkeley-unix)) - 'UNIX)) ; very similar to GNU + ((memq system-type '(hpux usg-unix-v irix berkeley-unix)) + 'UNIX)) ; very similar to GNU ;; Anything else defaults to nil, meaning GNU. "Platform to emulate: GNU (default), MacOS, MS-Windows, UNIX. -Corresponding value is one of the atoms: nil, MacOS, MS-Windows, UNIX. -Sets default values for: `ls-lisp-ignore-case', `ls-lisp-dirs-first', -`ls-lisp-verbosity'. Need not match actual platform. Changing this -option will have no effect until you restart Emacs." +Corresponding value is one of: nil, `MacOS', `MS-Windows', `UNIX'. +Set this to your preferred value; it need not match the actual platform +you are using. + +This variable does not affect the behavior of ls-lisp directly. +Rather, it controls the default values for some variables that do: +`ls-lisp-ignore-case', `ls-lisp-dirs-first', and `ls-lisp-verbosity'. + +If you change this variable directly (without using customize) +after loading `ls-lisp', you should use `ls-lisp-set-options' to +update the dependent variables." :type '(choice (const :tag "GNU" nil) (const MacOS) (const MS-Windows) (const UNIX)) + :initialize 'custom-initialize-default + :set (lambda (symbol value) + (unless (equal value (eval symbol)) + (custom-set-default symbol value) + (ls-lisp-set-options))) :group 'ls-lisp) (defcustom ls-lisp-ignore-case @@ -92,6 +108,7 @@ (or (memq ls-lisp-emulation '(MS-Windows MacOS)) (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case)) "Non-nil causes ls-lisp alphabetic sorting to ignore case." + :set-after '(ls-lisp-emulation) :type 'boolean :group 'ls-lisp) @@ -99,6 +116,7 @@ "Non-nil causes ls-lisp to sort directories first in any ordering. \(Or last if it is reversed.) Follows Microsoft Windows Explorer." ;; Functionality suggested by Chris McMahan <cmcmahan@one.net> + :set-after '(ls-lisp-emulation) :type 'boolean :group 'ls-lisp) @@ -114,14 +132,15 @@ A value of nil (or an empty list) means display none of them. Concepts come from UNIX: `links' means count of names associated with -the file\; `uid' means user (owner) identifier\; `gid' means group +the file; `uid' means user (owner) identifier; `gid' means group identifier. -If emulation is MacOS then default is nil\; +If emulation is MacOS then default is nil; if emulation is MS-Windows then default is `(links)' if platform is -Windows NT/2K, nil otherwise\; -if emulation is UNIX then default is `(links uid)'\; +Windows NT/2K, nil otherwise; +if emulation is UNIX then default is `(links uid)'; if emulation is GNU then default is `(links uid gid)'." + :set-after '(ls-lisp-emulation) ;; Functionality suggested by Howard Melman <howard@silverstream.com> :type '(set (const :tag "Show Link Count" links) (const :tag "Show User" uid) @@ -157,7 +176,7 @@ Syntax: (EARLY-TIME-FORMAT OLD-TIME-FORMAT) The EARLY-TIME-FORMAT is used if file has been modified within the -current year. The OLD-TIME-FORMAT is used for older files. To use ISO +current year. The OLD-TIME-FORMAT is used for older files. To use ISO 8601 dates, you could set: \(setq ls-lisp-format-time-list @@ -168,11 +187,11 @@ :group 'ls-lisp) (defcustom ls-lisp-use-localized-time-format nil - "Non-nil causes ls-lisp to use `ls-lisp-format-time-list' even if -a valid locale is specified. + "Non-nil means to always use `ls-lisp-format-time-list' for time stamps. +This applies even if a valid locale is specified. WARNING: Using localized date/time format might cause Dired columns -to fail to lign up, e.g. if month names are not all of the same length." +to fail to line up, e.g. if month names are not all of the same length." :type 'boolean :group 'ls-lisp) @@ -220,7 +239,8 @@ supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' is non-nil; otherwise, it interprets wildcards as regular expressions to match file names. It does not support all `ls' switches -- those -that work are: A a c i r S s t u U X g G B C R n and F partly." +that work are: A a B C c F G g h i n R r S s t U u X. The l switch +is assumed to be always present and cannot be turned off." (if ls-lisp-use-insert-directory-program (funcall original-insert-directory file switches wildcard full-directory-p) @@ -301,7 +321,6 @@ (if (memq ?n switches) 'integer 'string))) - (now (current-time)) (sum 0) (max-uid-len 0) (max-gid-len 0) @@ -372,7 +391,7 @@ sum (float sum)))) (insert (ls-lisp-format short attr file-size - switches time-index now)))) + switches time-index)))) ;; Insert total size of all files: (save-excursion (goto-char (car total-line)) @@ -411,7 +430,7 @@ (ls-lisp-classify-file file fattr) file) fattr (nth 7 fattr) - switches time-index (current-time))) + switches time-index)) (message "%s: doesn't exist or is inaccessible" file) (ding) (sit-for 2))))) ; to show user the message! @@ -485,8 +504,8 @@ (nth 7 (cdr x))))) ((setq index (ls-lisp-time-index switches)) (lambda (x y) ; sorted on time - (ls-lisp-time-lessp (nth index (cdr y)) - (nth index (cdr x))))) + (time-less-p (nth index (cdr y)) + (nth index (cdr x))))) ((memq ?X switches) (lambda (x y) ; sorted on extension (ls-lisp-string-lessp @@ -584,18 +603,10 @@ (substring filename (1+ i) end)))) )) "\0" filename)) -;; From Roland McGrath. Can use this to sort on time. -(defun ls-lisp-time-lessp (time0 time1) - "Return t if time TIME0 is earlier than time TIME1." - (let ((hi0 (car time0)) (hi1 (car time1))) - (or (< hi0 hi1) - (and (= hi0 hi1) - (< (cadr time0) (cadr time1)))))) - -(defun ls-lisp-format (file-name file-attr file-size switches time-index now) +(defun ls-lisp-format (file-name file-attr file-size switches time-index) "Format one line of long ls output for file FILE-NAME. FILE-ATTR and FILE-SIZE give the file's attributes and size. -SWITCHES, TIME-INDEX and NOW give the full switch list and time data." +SWITCHES and TIME-INDEX give the full switch list and time data." (let ((file-type (nth 0 file-attr)) ;; t for directory, string (name linked to) ;; for symbolic link, or nil. @@ -653,7 +664,7 @@ gid)))) (ls-lisp-format-file-size file-size (memq ?h switches)) " " - (ls-lisp-format-time file-attr time-index now) + (ls-lisp-format-time file-attr time-index) " " (if (not (memq ?F switches)) ; ls-lisp-classify already did that (propertize file-name 'dired-filename t) @@ -671,20 +682,13 @@ ((memq ?t switches) 5) ; last modtime ((memq ?u switches) 4))) ; last access -(defun ls-lisp-time-to-seconds (time) - "Convert TIME to a floating point number." - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (nth 2 time) 0) 1000000.0))) - -(defun ls-lisp-format-time (file-attr time-index now) +(defun ls-lisp-format-time (file-attr time-index) "Format time for file with attributes FILE-ATTR according to TIME-INDEX. Use the same method as ls to decide whether to show time-of-day or year, -depending on distance between file date and NOW. +depending on distance between file date and the current time. All ls time options, namely c, t and u, are handled." (let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime - (diff (- (ls-lisp-time-to-seconds time) - (ls-lisp-time-to-seconds now))) + (diff (- (float-time time) (float-time))) ;; Consider a time to be recent if it is within the past six ;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 == ;; 31556952 seconds on the average, and half of that is 15778476. @@ -727,5 +731,4 @@ (provide 'ls-lisp) -;; arch-tag: e55f399b-05ec-425c-a6d5-f5e349c35ab4 ;;; ls-lisp.el ends here
--- a/lisp/mail/mailheader.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/mail/mailheader.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; mailheader.el --- mail header parsing, merging, formatting -;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Erik Naggum <erik@naggum.no> ;; Keywords: tools, mail, news @@ -49,9 +49,6 @@ (eval-when-compile (require 'cl)) -;; Make the byte-compiler shut up. -(defvar headers) - (defun mail-header-extract () "Extract headers from current buffer after point. Returns a header alist, where each element is a cons cell (name . value), @@ -105,6 +102,9 @@ (cons (cdr header) (funcall (cdr rule) (cdr header)))))))) headers) +;; Advertized part of the interface; see mail-header, mail-header-set. +(defvar headers) + (defsubst mail-header (header &optional header-alist) "Return the value associated with header HEADER in HEADER-ALIST. If the value is a string, it is the original value of the header. If the @@ -191,5 +191,4 @@ (provide 'mailheader) -;; arch-tag: 6e7aa221-80b5-4b3d-b46f-fd66ab567be0 ;;; mailheader.el ends here
--- a/lisp/mail/mspools.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/mail/mspools.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; mspools.el --- show mail spools waiting to be read -;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Stephen Eglen <stephen@gnu.org> ;; Maintainer: Stephen Eglen <stephen@gnu.org> @@ -280,10 +280,7 @@ )) (message "folder %s spool %s" folder-name spool-name) - (if (eq (count-lines (point-min) - (save-excursion - (end-of-line) - (point))) + (if (eq (count-lines (point-min) (point-at-eol)) mspools-files-len) (forward-line (- 1 mspools-files-len)) ;back to top of list ;; else just on to next line @@ -323,11 +320,7 @@ (defun mspools-get-spool-name () "Return the name of the spool on the current line." - (let ((line-num (1- (count-lines (point-min) - (save-excursion - (end-of-line) - (point)) - )))) + (let ((line-num (1- (count-lines (point-min) (point-at-eol))))) (car (nth line-num mspools-files)))) ;;; Spools mode functions @@ -411,5 +404,4 @@ (provide 'mspools) -;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6 ;;; mspools.el ends here
--- a/lisp/mail/sendmail.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/mail/sendmail.el Wed Nov 17 13:09:08 2010 +0900 @@ -1149,8 +1149,7 @@ ;; should override any specified in the message itself. (when where-content-type (goto-char where-content-type) - (beginning-of-line) - (delete-region (point) + (delete-region (point-at-bol) (progn (forward-line 1) (point))))))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines.
--- a/lisp/minibuffer.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/minibuffer.el Wed Nov 17 13:09:08 2010 +0900 @@ -42,7 +42,7 @@ ;; provide the start info but not the end info in ;; completion-base-position. ;; - quoting is problematic. E.g. the double-dollar quoting used in -;; substitie-in-file-name (and hence read-file-name-internal) bumps +;; substitute-in-file-name (and hence read-file-name-internal) bumps ;; into various bugs: ;; - choose-completion doesn't know how to quote the text it inserts. ;; E.g. it fails to double the dollars in file-name completion, or @@ -1133,6 +1133,7 @@ (interactive) (message "Making completion list...") (lexical-let* ((start (field-beginning)) + (end (field-end)) (string (field-string)) (completions (completion-all-completions string @@ -1164,10 +1165,12 @@ completions))) (with-current-buffer standard-output (set (make-local-variable 'completion-base-position) - ;; FIXME: We should provide the END part as well, but - ;; currently completion-all-completions does not give - ;; us the necessary information. - (list (+ start base-size) nil))) + (list (+ start base-size) + ;; FIXME: We should pay attention to completion + ;; boundaries here, but currently + ;; completion-all-completions does not give us the + ;; necessary information. + end))) (display-completion-list completions))) ;; If there are no completions, or if the current input is already the
--- a/lisp/mouse-drag.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/mouse-drag.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling -;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Heidemann <johnh@ISI.EDU> ;; Keywords: mouse @@ -163,7 +163,7 @@ mouse-drag-electric-col-scrolling (save-excursion ;; on a long line? (let - ((beg (progn (beginning-of-line) (point))) + ((beg (line-beginning-position)) (end (progn (end-of-line) (point)))) (if (> (- end beg) (window-width)) (setq truncate-lines t) @@ -326,5 +326,4 @@ (provide 'mouse-drag) -;; arch-tag: e47354ff-82f5-42c4-b3dc-88dd9c04b770 ;;; mouse-drag.el ends here
--- a/lisp/net/browse-url.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/browse-url.el Wed Nov 17 13:09:08 2010 +0900 @@ -216,11 +216,13 @@ ;;;###autoload (defcustom browse-url-browser-function - (cond - ((memq system-type '(windows-nt ms-dos cygwin)) - 'browse-url-default-windows-browser) - ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) - (t 'browse-url-default-browser)) + `(("\\`mailto:" . browse-url-mail) + ("." . + ,(cond + ((memq system-type '(windows-nt ms-dos cygwin)) + 'browse-url-default-windows-browser) + ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) + (t 'browse-url-default-browser)))) "Function to display the current buffer in a WWW browser. This is used by the `browse-url-at-point', `browse-url-at-mouse', and `browse-url-of-file' commands. @@ -260,7 +262,7 @@ (function :tag "Your own function") (alist :tag "Regexp/function association list" :key-type regexp :value-type function)) - :version "21.1" + :version "24.1" :group 'browse-url) (defcustom browse-url-netscape-program "netscape" @@ -1479,20 +1481,27 @@ (to (assoc "To" alist)) (subject (assoc "Subject" alist)) (body (assoc "Body" alist)) - (rest (delete to (delete subject (delete body alist)))) + (rest (delq to (delq subject (delq body alist)))) (to (cdr to)) (subject (cdr subject)) (body (cdr body)) (mail-citation-hook (unless body mail-citation-hook))) (if (browse-url-maybe-new-window new-window) (compose-mail-other-window to subject rest nil - (if body - (list 'insert body) - (list 'insert-buffer (current-buffer)))) + (list 'insert-buffer (current-buffer))) (compose-mail to subject rest nil nil - (if body - (list 'insert body) - (list 'insert-buffer (current-buffer)))))))) + (list 'insert-buffer (current-buffer)))) + (when body + (goto-char (point-min)) + (unless (or (search-forward (concat "\n" mail-header-separator "\n") + nil 'move) + (bolp)) + (insert "\n")) + (goto-char (prog1 + (point) + (insert (replace-regexp-in-string "\r\n" "\n" body)) + (unless (bolp) + (insert "\n")))))))) ;; --- Random browser ---
--- a/lisp/net/eudc.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/eudc.el Wed Nov 17 13:09:08 2010 +0900 @@ -830,10 +830,7 @@ (let* ((end (point)) (beg (save-excursion (if (re-search-backward "\\([:,]\\|^\\)[ \t]*" - (save-excursion - (beginning-of-line) - (point)) - 'move) + (point-at-bol) 'move) (goto-char (match-end 0))) (point))) (query-words (split-string (buffer-substring beg end) "[ \t]+")) @@ -1295,5 +1292,4 @@ (provide 'eudc) -;; arch-tag: e18872b6-db83-400b-869d-be54e9a4160c ;;; eudc.el ends here
--- a/lisp/net/ldap.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/ldap.el Wed Nov 17 13:09:08 2010 +0900 @@ -579,9 +579,7 @@ (while (progn (skip-chars-forward " \t\n") (not (eobp))) - (setq dn (buffer-substring (point) (save-excursion - (end-of-line) - (point)))) + (setq dn (buffer-substring (point) (point-at-eol))) (forward-line 1) (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\ \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\ @@ -617,5 +615,4 @@ (provide 'ldap) -;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0 ;;; ldap.el ends here
--- a/lisp/net/net-utils.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/net-utils.el Wed Nov 17 13:09:08 2010 +0900 @@ -55,8 +55,7 @@ :group 'comm :version "20.3") -(defcustom net-utils-remove-ctl-m - (member system-type (list 'windows-nt 'msdos)) +(defcustom net-utils-remove-ctl-m (memq system-type '(windows-nt msdos)) "If non-nil, remove control-Ms from output." :group 'net-utils :type 'boolean) @@ -82,7 +81,7 @@ ;; On GNU/Linux and Irix, the system's ping program seems to send packets ;; indefinitely unless told otherwise (defcustom ping-program-options - (and (memq system-type (list 'linux 'gnu/linux 'irix)) + (and (memq system-type '(gnu/linux irix)) (list "-c" "4")) "Options for the ping program. These options can be used to limit how many ICMP packets are emitted." @@ -889,5 +888,4 @@ (provide 'net-utils) -;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314 ;;; net-utils.el ends here
--- a/lisp/net/quickurl.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/quickurl.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; quickurl.el --- insert an URL based on text at point in buffer -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Dave Pearson <davep@davep.org> ;; Maintainer: Dave Pearson <davep@davep.org> @@ -506,9 +506,7 @@ `with-lookup' - Insert \"lookup <URL:url>\" `with-desc' - Insert \"description <URL:url>\" `lookup' - Insert the lookup for that URL" - (let ((url (nth (save-excursion - (beginning-of-line) - (count-lines (point-min) (point))) + (let ((url (nth (count-lines (point-min) (line-beginning-position)) quickurl-urls))) (if url (with-current-buffer quickurl-list-last-buffer @@ -542,5 +540,4 @@ (provide 'quickurl) -;; arch-tag: a8183ea5-80c2-4082-a7d1-b0fdf2da467e ;;; quickurl.el ends here
--- a/lisp/net/tramp-cmds.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/tramp-cmds.el Wed Nov 17 13:09:08 2010 +0900 @@ -298,8 +298,7 @@ (setq buffer-read-only nil) (goto-char (point-min)) (while (not (eobp)) - (if (re-search-forward - tramp-buf-regexp (tramp-compat-line-end-position) t) + (if (re-search-forward tramp-buf-regexp (point-at-eol) t) (forward-line 1) (forward-line 0) (let ((start (point))) @@ -372,5 +371,4 @@ ;; ordinary variable that gets its initial value from ;; tramp-default-user-alist and then is added to. (Pete Forman) -;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c ;;; tramp-cmds.el ends here
--- a/lisp/net/tramp-compat.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/tramp-compat.el Wed Nov 17 13:09:08 2010 +0900 @@ -199,29 +199,6 @@ (ignore-errors (tramp-compat-funcall 'font-lock-add-keywords mode keywords how))) -;; FIXME is this really necessary? Eg Emacs has both l-b-p and p-at-b -;; since at least 21.1. -(defsubst tramp-compat-line-beginning-position () - "Return point at beginning of line (compat function). -Calls `line-beginning-position' or `point-at-bol' if defined, else -own implementation." - (cond - ((fboundp 'line-beginning-position) - (tramp-compat-funcall 'line-beginning-position)) - ((fboundp 'point-at-bol) (tramp-compat-funcall 'point-at-bol)) - (t (save-excursion (beginning-of-line) (point))))) - -;; FIXME is this really necessary? Eg Emacs has both l-e-p and p-at-e -;; since at least 21.1. -(defsubst tramp-compat-line-end-position () - "Return point at end of line (compat function). -Calls `line-end-position' or `point-at-eol' if defined, else -own implementation." - (cond - ((fboundp 'line-end-position) (tramp-compat-funcall 'line-end-position)) - ((fboundp 'point-at-eol) (tramp-compat-funcall 'point-at-eol)) - (t (save-excursion (end-of-line) (point))))) - (defsubst tramp-compat-temporary-file-directory () "Return name of directory for temporary files (compat function). For Emacs, this is the variable `temporary-file-directory', for XEmacs
--- a/lisp/net/tramp-sh.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/tramp-sh.el Wed Nov 17 13:09:08 2010 +0900 @@ -1189,8 +1189,7 @@ ;; if symlink, find out file name pointed to (when symlinkp (search-forward "-> ") - (setq res-symlink-target - (buffer-substring (point) (tramp-compat-line-end-position)))) + (setq res-symlink-target (buffer-substring (point) (point-at-eol)))) ;; return data gathered (list ;; 0. t for directory, string (name linked to) for symbolic @@ -1438,7 +1437,7 @@ (tramp-shell-quote-argument localname)))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (when (re-search-forward regexp (tramp-compat-line-end-position) t) + (when (re-search-forward regexp (point-at-eol) t) (setq context (list (match-string 1) (match-string 2) (match-string 3) (match-string 4)))))) ;; Return the context. @@ -1746,8 +1745,7 @@ (tramp-error v 'file-error "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring - (point) (tramp-compat-line-end-position)))) + (buffer-substring (point) (point-at-eol)))) ;; For peace of mind, if buffer doesn't end in `fail' ;; then it should end in `ok'. If neither are in the ;; buffer something went seriously wrong on the remote @@ -1760,9 +1758,7 @@ (tramp-shell-quote-argument localname) (buffer-string)))) (while (zerop (forward-line -1)) - (push (buffer-substring - (point) (tramp-compat-line-end-position)) - result))) + (push (buffer-substring (point) (point-at-eol)) result))) ;; Because the remote op went through OK we know the ;; directory we `cd'-ed to exists @@ -2524,7 +2520,7 @@ (forward-line -1)) (when (looking-at "//DIRED//\\s-+") (let ((databeg (match-end 0)) - (end (tramp-compat-line-end-position))) + (end (point-at-eol))) ;; Now read the numeric positions of file names. (goto-char databeg) (while (< (point) end) @@ -2534,7 +2530,7 @@ ;; End is followed by \n or by " -> ". (put-text-property start end 'dired-filename t)))))) ;; Remove trailing lines. - (goto-char (tramp-compat-line-beginning-position)) + (goto-char (point-at-bol)) (while (looking-at "//") (forward-line 1) (delete-region (match-beginning 0) (point))) @@ -2593,8 +2589,7 @@ v (format "cd %s; pwd" (tramp-shell-quote-argument uname))) (with-current-buffer (tramp-get-buffer v) (goto-char (point-min)) - (buffer-substring - (point) (tramp-compat-line-end-position))))) + (buffer-substring (point) (point-at-eol))))) (setq localname (concat uname fname)))) ;; There might be a double slash, for example when "~/" ;; expands to "/". Remove this. @@ -3496,8 +3491,7 @@ (when (search-backward "tramp_executable " nil t) (skip-chars-forward "^ ") (skip-chars-forward " ") - (setq result (buffer-substring - (point) (tramp-compat-line-end-position))))) + (setq result (buffer-substring (point) (point-at-eol))))) result))) (defun tramp-set-remote-path (vec) @@ -3647,7 +3641,7 @@ ;; the single quotes makes it work under `rc', too. We also unset ;; the variable $ENV because that is read by some sh ;; implementations (eg, bash when called as sh) on startup; this - ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND + ;; way, we avoid the startup file clobbering $PS1. $PROMPT_COMMAND ;; is another way to set the prompt in /bin/bash, it must be ;; discarded as well. (tramp-open-shell @@ -3858,7 +3852,11 @@ with the encoded or decoded results, respectively.") (defconst tramp-remote-coding-commands - '((b64 "base64" "base64 -d") + '((b64 "base64" "base64 -d -i") + ;; "-i" is more robust with older base64 from GNU coreutils. + ;; However, I don't know whether all base64 versions do supports + ;; this option. + (b64 "base64" "base64 -d") (b64 "mimencode -b" "mimencode -u -b") (b64 "mmencode -b" "mmencode -u -b") (b64 "recode data..base64" "recode base64..data") @@ -4360,8 +4358,8 @@ (tramp-set-connection-property p "check-remote-echo" t) (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark))) (when (string-match "<<'EOF'" command) - ;; Unset $PS1 when using here documents, in order not to get - ;; several prompts. + ;; Unset $PS1 when using here documents, in order to avoid + ;; multiple prompts. (setq command (concat "(PS1= ; " command "\n)"))) ;; Send the command. (tramp-message vec 6 "%s" command) @@ -4387,8 +4385,7 @@ ;; A simple-minded busybox has sent " ^H" sequences. ;; Delete them. (goto-char (point-min)) - (when (re-search-forward - "^\\(.\b\\)+$" (tramp-compat-line-end-position) t) + (when (re-search-forward "^\\(.\b\\)+$" (point-at-eol) t) (forward-line 1) (delete-region (point-min) (point))) ;; Delete the prompt. @@ -4450,7 +4447,7 @@ (condition-case nil (prog1 (read (current-buffer)) ;; Error handling. - (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t) + (when (re-search-forward "\\S-" (point-at-eol) t) (error nil))) (error (tramp-error vec 'file-error @@ -5042,5 +5039,6 @@ ;; rsync. ;; * Try telnet+curl as new method. It might be useful for busybox, ;; without built-in uuencode/uudecode. +;; * Try ssh+netcat as out-of-band method. ;;; tramp-sh.el ends here
--- a/lisp/net/tramp-smb.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/tramp-smb.el Wed Nov 17 13:09:08 2010 +0900 @@ -1079,7 +1079,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; We are called from `tramp-smb-get-file-entries', which sets the ;; current buffer. - (let ((line (buffer-substring (point) (tramp-compat-line-end-position))) + (let ((line (buffer-substring (point) (point-at-eol))) localname mode size month day hour min sec year mtime) (if (not share) @@ -1177,8 +1177,7 @@ (member "pathnames" (split-string - (buffer-substring - (point) (tramp-compat-line-end-position)) nil t))))))))) + (buffer-substring (point) (point-at-eol)) nil t))))))))) (defun tramp-smb-get-stat-capability (vec) "Check, whether the SMB server supports the STAT command." @@ -1396,5 +1395,4 @@ ;; regular again. ;; * Make it multi-hop capable. -;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5 ;;; tramp-smb.el ends here
--- a/lisp/net/tramp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/net/tramp.el Wed Nov 17 13:09:08 2010 +0900 @@ -2352,7 +2352,7 @@ (concat "^\\(" tramp-host-regexp "\\)" "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (append (list (match-string 3) (match-string 1))))) (widen) @@ -2379,7 +2379,7 @@ User is always nil." (let ((result) (regexp (concat "^\\(" tramp-host-regexp "\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -2408,7 +2408,7 @@ User is always nil." (let ((result) (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -2469,7 +2469,7 @@ (let ((result) (regexp (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -2504,7 +2504,7 @@ Host is always \"localhost\"." (let ((result) (regexp (concat "^\\(" tramp-user-regexp "\\):"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list (match-string 1) "localhost"))) (widen) @@ -2534,7 +2534,7 @@ (concat "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)" "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list (match-string 3) (match-string 1)))) (widen) @@ -2560,7 +2560,7 @@ User is always nil." (let ((result) (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -2864,8 +2864,7 @@ (set-buffer-modified-p nil) ;; For root, preserve owner and group when editing files. (when (string-equal (file-remote-p filename 'user) "root") - (set (make-local-variable 'backup-by-copying-when-mismatch) t) - (put 'backup-by-copying-when-mismatch 'permanent-local t))) + (set (make-local-variable 'backup-by-copying-when-mismatch) t))) (when (and (stringp local-copy) (or remote-copy (null tramp-temp-buffer-file-name))) (delete-file local-copy)) @@ -3663,7 +3662,6 @@ ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp ;; expects only English messages? (Juri Linkov) ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) -;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'. ;; * I was wondering it it would be possible to use tramp even if I'm ;; actually using sshfs. But when I launch a command I would like ;; to get it executed on the remote machine where the files really @@ -3675,7 +3673,6 @@ ;; Functions for file-name-handler-alist: ;; diff-latest-backup-file -- in diff.el -;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a ;;; tramp.el ends here ;; Local Variables:
--- a/lisp/obsolete/lucid.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/obsolete/lucid.el Wed Nov 17 13:09:08 2010 +0900 @@ -234,5 +234,8 @@ (provide 'lucid) -;; arch-tag: 80f9ab46-0b36-4151-86ed-3edb6d449c9e +;; Local Variables: +;; byte-compile-warnings: (not cl-functions) +;; End: + ;;; lucid.el ends here
--- a/lisp/org/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,3343 @@ +2010-11-12 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Remove autoload from + defcustom. + + * ob-lisp.el (slime): Don't expect slime to be present. + +2010-11-11 Dan Davison <dandavison7@gmail.com> + + * ob.el: `copy-sequence' suffices to copy alist; no need for + `copy-tree'. + +2010-11-11 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-execute-src-block): If ":results file" is in + effect, then ensure that the value of :file is returned as the + result; don't rely on language files for this. + +2010-11-11 Dan Davison <dandavison7@gmail.com> + + * ob.el (org-babel-sha1-hash): Avoid corrupting `info' data + structure by side-effects of `sort'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point-with-indent): Do not check + indentation of a non-empty blank line. + + * org-list.el (org-sort-list): Sort a list with point anywhere + inside it. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): Safer evaluation and + hopefully better error messages. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): Adding calc. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-initiate-session): Don't resolve variable + references unless prefix arg is supplied. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el (org-babel-execute:calc): Ensure that calc stack + refers to the correct stack. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-calc.el: Adding the beginnings of support for calc code + blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-update-block-body): Declaring function + for updating code block bodies. + (org-babel-spec-to-string): + (org-babel-detangle): Detangle all tangled and commented code + blocks in the current file back to org. + (org-babel-tangle-jump-to-org): Jump from a tangled and commented + file back to the originating org-mode code block ob-tangle: + detangle changes in code files back to the original org files. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-comment-format-beg): Fix typo. + (org-babel-tangle-comment-format-end): Fix typo. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-exp.el (org-export-format-source-code-or-example): Use + minted for latex source code export if `org-export-latex-listings' + has the value 'minted + + * org-latex.el (org-export-latex-listings): Document special value + 'minted + + * org-latex.el (org-export-latex-minted): Delete variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Retrieve contents of + parentheses, excluding parentheses themselves. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-gnuplot.el (org-babel-variable-assignments:gnuplot): Fixed + bug in gnuplot data file assignment using user variables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-latex.el (org-babel-execute:latex): Adding new :headers + header argument for latex code blocks. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): New capture property + `:kill-buffer'. (org-capture-finalize): Kill target buffer if that + is desired. + (org-capture-target-buffer): Remember if we have to make the + buffer. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-dblock-write:clocktable): Fix bug when + computing clock tables. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-dblock-write:clocktable): Pass file minutes up + to caller even if no table is generated. + +2010-11-11 Åukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> + + * org-agenda.el (org-agenda-get-sexps): Handle lists as return + values from diary entries + + * org-bbdb.el (org-bbdb-anniversaries): Handle lists of + anniversaries + + * org.el (org-diary-sexp-entry): Handle lists as return values + from diary entries. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-empty-lines-before): + (org-capture-empty-lines-after): Make sure the n=0 does not insert + any newlines. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-clojure-babel-clojure-cmd): Fixed error + message when clojure binary is not found. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-format-table-html): New argument DOCBOOK. + (org-format-org-table-html): New argument DOCBOOK. When set, use + align instead of class to align table fields. + + * org-docbook.el (org-export-as-docbook): Specify the docbook + argument for the table converter. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-called-interactively-p): New macro. + + * org-freemind.el: No longer require 'rx. + (org-freemind): New customization group, use it for all the + variables. + (org-export-as-freemind): Add docstring. + (org-freemind-show): Improve filen naming. + (org-freemind-convert-links-helper): New function. + (org-freemind-bol-helper-base-indent): New variable. + (org-freemind-bol-helper): New function. + (org-freemind-node-css-style): New option. + (org-freemind-node-pattern): New variable. + (org-freemind-from-org-mode): Better docstring. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * ob-haskell.el (org-babel-variable-assignments:haskell): Don't + pass more than two arguments to mapc. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * ob.el (org-babel-ref-resolve): Declare to silence byte compiler. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-footnote.el (message-signature-separator): Defvar to silence + byte compiler. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-string): Fix reference to wrong symbol. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> + + * org.el (org-link-search): Return 'dedicated on successful match + when org-link-search-must-match-exact-headline is set to t. + +2010-11-11 Daniel Clemente <n142857@gmail.com> + + * org-html.el (org-html-make-link): Append fragment to file: links + if present. + +2010-11-11 Tassilo Horn <tassilo@member.fsf.org> + + * org-footnote.el (org-footnote-create-definition) + (org-footnote-goto-local-insertion-point): Add footnotes before + signature when in message-mode. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-display-inline-images): Improve regexp. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-cycle): Make sure resetting to startup visibility + works after another cycle command. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-string): New function org-export-string + can be used to convert a string of test in org-mode markup to a + specified format. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-display-inline-images): Allow non-ASCII characters + in image file names. Save match data. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-auto-repeat-maybe): Fix shifting multiple time + stamps. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-store-forced-table-alignment): + (org-export-remove-special-table-lines): Allow the "c" cookie for + table alignment. + + * org-html.el (org-export-table-header-tags): + (org-export-table-data-tags): Add another %s format for the + alignment. + (org-export-html-table-align-individual-fields): New option. + (org-format-org-table-html): Implement field-by-field alignment + and support centering. + (org-format-table-table-html): Make sure the new table tag formats + don't break this function. + + * org-table.el (org-table-cookie-line-p): + (org-table-align): Allow for the <c> cookie. + + * org.el (org-set-font-lock-defaults): Allow for the <c> cookie. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-exp.el (org-export-normalize-links): Skip normalization of + plain links that are part of another link. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-expand-body:R): Fix bug in let binding. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el: (org-indent-add-properties): Use + `with-silent-modificaitons'. + (org-indent-remove-properties): Use `with-silent-modificaitons'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-cookie-line-p): Fix indentation. + + * org-exp.el (org-store-forced-table-alignment): New function. + (org-export-preprocess-string): Call + `org-store-forced-table-alignment'. + + * org-html.el (org-format-org-table-html): Use stored alignment + information. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Respects prefix argument + (which forces re-calculation). + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Removed needless param + sorting from ob-execute-src-block, the params are sorted already + by ob-sha1-hash. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Ensure that info is sorted at the + header argument level. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-sha1-hash): Consider words in different order + as different input. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-sha1-hash): Fix check for zero length sequences. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-sh-var-to-sh): Ensure value has the + structure of an Org-mode table (list of lists). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Fix bug + (reference to unassigned variable `src-lang' and avoid calling + org-babel-get-src-block-info twice. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Updated to reflect the new + info list contents. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Supply non-nil argument to + `org-babel-get-src-block-info' to avoid resolving variable + references. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Fixed minor bug in and + improved efficiency of org-babel-map-src-blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Now explicitly + checks that a code block will actually be tangled before + collecting it's full information (a process which could involve + the execution of other code blocks). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-demarcate-block): Use light version of + `org-babel-get-src-block-info'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-sha1-hash): Now handles more complex types in + params. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Generally using the new + more informative params + (org-babel-process-params): Don't forget the :var portion of + variable assignments. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-table.el (sbe): Simplified to reflect to var resolution. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): Bringing the referent + arguments back to their params before evaluation. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve): Cleanup of variable usage and + indentation. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-table.el (sbe): Use `org-babel-process-params params' instead + of `org-babel-expand-variables'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-C.el (org-babel-C-execute): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-R.el (org-babel-execute:R): Remove call to + org-babel-process-params which should no longer be called from + within a language file + (org-babel-R-variable-assignments): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-asymptote.el (org-babel-execute:asymptote): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-clojure.el (org-babel-execute:clojure): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-dot.el (org-babel-execute:dot): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-emacs-lisp.el (org-babel-expand-body:emacs-lisp): Remove + call to org-babel-process-params which should no longer be called + from within a language file + (org-babel-execute:emacs-lisp): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-haskell.el (org-babel-execute:haskell): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-js.el (org-babel-execute:js): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-lisp.el (org-babel-execute:lisp): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-ocaml.el (org-babel-execute:ocaml): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-octave.el (org-babel-execute:octave): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-perl.el (org-babel-execute:perl): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-python.el (org-babel-execute:python): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-ruby.el (org-babel-execute:ruby): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-scheme.el (org-babel-execute:scheme): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-screen.el (org-babel-execute:screen): Remove call to + org-babel-process-params which should no longer be called from + within a language file + (org-babel-prep-session:screen): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-sh.el (org-babel-execute:sh): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-sql.el (org-babel-execute:sql): Remove call to + org-babel-process-params which should no longer be called from + within a language file + + * ob-haskell.el (org-babel-execute:haskell): Remove reference to + processed params + + * ob-clojure.el (org-babel-execute:clojure): Remove reference to + processed params + + * ob-R.el (org-babel-execute:R): Remove reference to processed + params. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sql.el (org-babel-execute:sql): Use generic expansion + function + (org-babel-expand-body:sql): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-execute:sh): Use generic expansion function + (org-babel-expand-body:sh): Delete function + (org-babel-prep-session:sh): Change name of called function + (org-babel-variable-assignments:sh): Change function name. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-screen.el (org-babel-execute:screen): Use generic expansion + function + (org-babel-expand-body:screen): Delete function + (org-babel-prep-session:screen): Remove references to processed + params. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sass.el (org-babel-execute:sass): Use generic expansion + function + (org-babel-expand-body:sass): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-ruby.el (org-babel-execute:ruby): Use generic expansion + function + (org-babel-prep-session:ruby): Use new variable assignment + function + (org-babel-variable-assignments:ruby): New function + (org-babel-expand-body:ruby): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-execute:python): Use generic expansion + function + (org-babel-prep-session:python): Change name of called function + (org-babel-variable-assignments:python): Change function name + (org-babel-expand-body:python): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-plantuml.el (org-babel-expand-body:plantuml): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-perl.el (org-babel-execute:perl): Use generic expansion + function + (org-babel-expand-body:perl): Delete function + (org-babel-variable-assignments:perl): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-org.el (org-babel-expand-body:org): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-execute:octave): Use generic expansion + function + (org-babel-variable-assignments:octave): Change name of function + (org-babel-variable-assignments:matlab): New defalias + (org-babel-prep-session:octave): Change name of function + (org-babel-expand-body:matlab): Delete function + (org-babel-expand-body:octave): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-ocaml.el (org-babel-execute:ocaml): Use generic expansion + function + (org-babel-variable-assignments:ocaml): New function + (org-babel-expand-body:ocaml): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-mscgen.el (org-babel-expand-body:mscgen): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-js.el (org-babel-execute:js): Use new variable assignment + function + (org-babel-expand-body:js): Delete function + (org-babel-prep-session:js): Use new variable assignment function + (org-babel-variable-assignments:js): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-haskell.el (org-babel-execute:haskell): Use generic expansion + function + (org-babel-expand-body:haskell): Delete function + (org-babel-prep-session:haskell): Use variable assignment function + (org-babel-variable-assignments:haskell): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-gnuplot.el (org-babel-expand-body:gnuplot): Use variable + assignment function + (org-babel-prep-session:gnuplot): Use variable assignment function + (org-babel-variable-assignments:gnuplot): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-ditaa.el (org-babel-expand-body:ditaa): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-css.el (org-babel-expand-body:css): Delete function + (automatically handled by generic version). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-asymptote.el (org-babel-execute:asymptote): Use generic + expansion function + (org-babel-expand-body:asymptote): Delete function + (org-babel-variable-assignments:asymptote): New function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-expand-body:R): Use new function + `org-babel-variable-assignments:R'; don't trim body. + (org-babel-execute:R): Respond to changes in + `org-babel-expand-body:R' + (org-babel-prep-session:R): Called function is now named + `org-babel-variable-assignments:R' + (org-babel-variable-assignments:R): Receives processed-params as + new optional argument. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-C.el (org-babel-C-expand): Don't trim body. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-scheme.el (org-babel-expand-body:scheme): Fix bug in + obtaining variable references. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Supply variable + assignment lines to generic expansion command. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-expand-src-block): Supply variable assignment + lines to generic expansion function + (org-babel-expand-body:generic): Prepend body with optional + variable assignment lines. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-results): Replaced old function call. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-execute): Now expanding variable + references before execution. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-execute-src-block): Only sort parameters if + it's required for caching. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-table.el (sbe): Reworking for better indentation and to + integrate the new variable resolution. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ref.el (org-babel-ref-resolve-reference): Now expanding + variables when resolving references. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-merge-params): Fixed order or precedence for + variables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org-babel-expand-body:c++): Remove obsoleted optional + third argument + (org-babel-expand-body:c++): Remove obsoleted optional third + argument + (org-babel-C-expand): Remove obsoleted optional third argument + + * ob-R.el: + (org-babel-expand-body:R): Remove obsoleted optional third + argument + (org-babel-execute:R): Remove obsoleted optional third argument + (org-babel-R-variable-assignments): Remove obsoleted optional + third argument + + * ob-asymptote.el: + (org-babel-expand-body:asymptote): Remove obsoleted optional + third argument + (org-babel-execute:asymptote): Remove obsoleted optional third + argument + + * ob-clojure.el: + (org-babel-expand-body:clojure): Remove obsoleted optional third + argument + (org-babel-execute:clojure): Remove obsoleted optional third + argument + + * ob-css.el: + (org-babel-expand-body:css): Remove obsoleted optional third + argument + + * ob-ditaa.el: + (org-babel-expand-body:ditaa): Remove obsoleted optional third + argument + + * ob-dot.el: + (org-babel-expand-body:dot): Remove obsoleted optional third + argument + (org-babel-execute:dot): Remove obsoleted optional third + argument + + * ob-emacs-lisp.el: + (org-babel-expand-body:emacs-lisp): Remove obsoleted optional + third argument + (org-babel-execute:emacs-lisp): Remove obsoleted optional third + argument + + * ob-gnuplot.el: + (org-babel-expand-body:gnuplot): Remove obsoleted optional third + argument + + * ob-haskell.el: + (org-babel-expand-body:haskell): Remove obsoleted optional third + argument + (org-babel-execute:haskell): Remove obsoleted optional third + argument + (org-babel-load-session:haskell): Remove obsoleted optional + third + (org-babel-prep-session:haskell): Remove obsoleted optional + third + + * ob-js.el: + (org-babel-expand-body:js): Remove obsoleted optional third + argument + (org-babel-execute:js): Remove obsoleted optional third argument + + * ob-latex.el: + (org-babel-expand-body:latex): Remove obsoleted optional third + argument + + * ob-lisp.el: + (org-babel-expand-body:lisp): Remove obsoleted optional third + argument + (org-babel-execute:lisp): Remove obsoleted optional third + argument + + * ob-mscgen.el: + (org-babel-expand-body:mscgen): Remove obsoleted optional third + argument + + * ob-ocaml.el: + (org-babel-expand-body:ocaml): Remove obsoleted optional third + argument + (org-babel-execute:ocaml): Remove obsoleted optional third + argument + + * ob-octave.el: + (org-babel-expand-body:matlab): Remove obsoleted optional third + argument + (org-babel-expand-body:octave): Remove obsoleted optional third + argument + (org-babel-execute:octave): Remove obsoleted optional third + argument + (org-babel-octave-variable-assignments): Remove obsoleted + optional third + + * ob-org.el: + (org-babel-expand-body:org): Remove obsoleted optional third + argument + + * ob-perl.el: + (org-babel-expand-body:perl): Remove obsoleted optional third + argument + (org-babel-execute:perl): Remove obsoleted optional third + argument + + * ob-plantuml.el: + (org-babel-expand-body:plantuml): Remove obsoleted optional + third argument + + * ob-python.el: + (org-babel-expand-body:python): Remove obsoleted optional third + argument + (org-babel-execute:python): Remove obsoleted optional third + argument + (org-babel-python-variable-assignments): Remove obsoleted + optional third + + * ob-ruby.el: + (org-babel-expand-body:ruby): Remove obsoleted optional third + argument + (org-babel-execute:ruby): Remove obsoleted optional third + argument + + * ob-sass.el: + (org-babel-expand-body:sass): Remove obsoleted optional third + argument + + * ob-scheme.el: + (org-babel-expand-body:scheme): Remove obsoleted optional third + argument + (org-babel-execute:scheme): Remove obsoleted optional third + argument + + * ob-screen.el: + (org-babel-expand-body:screen): Remove obsoleted optional third + argument + + * ob-sh.el: + (org-babel-expand-body:sh): Remove obsoleted optional third + argument + (org-babel-execute:sh): Remove obsoleted optional third argument + (org-babel-sh-variable-assignments): Remove obsoleted optional + third + + * ob-sql.el: + (org-babel-expand-body:sql): Remove obsoleted optional third + argument + + * ob-sqlite.el: + (org-babel-expand-body:sqlite): Remove obsoleted optional third + argument + (org-babel-execute:sqlite): Remove obsoleted optional third + argument + + * ob.el: + (org-babel-expand-body:generic): Remove obsoleted optional third + argument. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-clojure.el (org-babel-prep-session:clojure): Purging all + calls to removed org-babel-ref-variables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-ingest): Now returns the count of + ingested code blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-in-export-file): Wrapper for collecting + information from within the original export file. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-get-src-block-info): Small but crucial fix) + (this should return nil if not match found. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-emacs-lisp.el (org-babel-expand-body:emacs-lisp): Whitespace + (org-babel-execute:emacs-lisp): Whitespace. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-sh-variable-assignments): Provide missing + docstring + + * ob-python.el (org-babel-python-variable-assignments): Provide + missing docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-expand-body:octave): Refactor: break + variable assignment part out into a separate function + (org-babel-octave-variable-assignments): New function constructing + list of variable assignment statements + (org-babel-prep-session:octave): Use new function + `org-babel-octave-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-expand-body:sh): Refactor: break variable + assignment part out into a separate function + (org-babel-sh-variable-assignments): New function constructing + list of variable assignment statements + (org-babel-prep-session:sh): Use new function + `org-babel-sh-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-expand-body:python): Refactor: break + variable assignment part out into a separate function + (org-babel-python-variable-assignments): New function constructing + list of variable assignment statements + (org-babel-prep-session:python): Use new function + `org-babel-python-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-expand-body:R): Refactor: break variable + assignment part out into a separate function + (org-babel-R-variable-assignments): New function constructing list + of variable assignment statements + (org-babel-prep-session:R): Use new function + `org-babel-R-variable-assignments' instead of previous + (incorrect) variable assignment code. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-initiate-session): Better variable names. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-number-sequence): Declared + + * ob-R.el (org-number-sequence): Declared. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-map-src-blocks): Store correct value of + `end-block'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-mark-block): New function to mark the body of a + src block in the style of `mark-defun'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-number-sequence): New function. + + * ob-R.el (org-babel-expand-body:R): Use `org-number-sequence'. + + * ob.el (org-babel-where-is-src-block-result): Use + `org-number-sequence'. + (org-babel-current-buffer-properties): Fix variable definition. + + * ob-ref.el (org-babel-ref-index-list): Use `org-number-sequence'. + + * ob-latex.el (org-babel-latex-tex-to-pdf): Use the 2-argument + version of `shell-command'. + + * org-latex.el (org-export-as-pdf): Use the 2-argument version of + `shell-command'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-list-search-unenclosed-generic): Replace call + to booleanp. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-agenda-jump-prefer-future): New option. + + * org-agenda.el (org-agenda-goto-date): Use + `org-agenda-jump-prefer-future'. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-latex.el (org-export-latex-links) : Replaced hard coded + hyperref format with custom variable + `org-export-latex-hyperref-format'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-heading): Fix docstring. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) + + * org-capture.el (org-capture-place-entry): If the first line is + already a headline, just stay there. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-sh-evaluate): No longer assumes that results + are non-nil. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ascii.el (org-ascii-replace-entities): Match an optional {} + after an entity. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (orgtbl-to-html): Apply `org-html-expand' to the + table fields. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-heading): When on the headline of an inline + task, insert another inline tasks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Only create + links for blocks that will actually tangle. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sh.el (org-babel-expand-body:sh): Don't insert extra newlines + in expanded shell bodies. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-expand-body:sh): Avoid inserting extra + newline characters. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-expand-body:sh): Align code. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-params-from-properties): Max line with at <=80 + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-listings-langs): Clojure is now + recognized as a lisp. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-params-from-properties): Use `org-babel-read' + to interpret property as header argument value. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-parse-header-arguments): Simplify reading of + header arg value. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-org-to-ascii): + (org-publish-org-to-latin1): + (org-publish-org-to-utf8): New functions. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-heading): Skip inline tasks when trying to + insert a new heading after the end of the subtree. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-inlinetask.el (org-inlinetask-min-level): Set customization + type to integer or nil. + + * org.el (org-insert-heading): When after an inline task, do not + use level but go back to headline level before the inline task. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-inlinetask.el (org-inlinetask-in-task-p): New function. + + * org.el (org-indent-line-function): Fix indentation of inline + tasks. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-activate-links): Fix customize type. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-latex-to-pdf-process): Add rubber as another + default option. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-latex.el (org-export-latex-minted): Document pygments + dependency. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-create-index-file): Encrypt the index + file if encryption has been turned on. + (org-mobile-copy-agenda-files): Avoid double encryption of + `mobileorg.org'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-exp.el (org-export-latex-minted-with-line-numbers): Ensure + that variable is declared. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-src-preserve-indentation): Fixed compiler + warning. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-exp.el (org-export-format-source-code-or-example): Latex + formatting of source code blocks using the minted package + (org-export-plist-vars): Add :latex-minted property + (org-export-latex-minted): Ensure variable is defined + (org-export-latex-minted-langs): Ensure variable is defined. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-src.el (org-edit-src-code): Use `org-region-active-p'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-spec-to-string): Whitespace changes. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-tangle.el (org-babel-spec-to-string): Don't trim whitespace + when `org-src-preserve-indentation' is non-nil. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-lob.el (org-babel-lob-ingest): Provide message stating number + of blocks added to Library of Babel. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-lob.el (org-babel-lob-ingest): Check for nil source block + name. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-place-default-actions-for-lists): Fix + typo in regexp. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): Avoid some boundary error + when inserting a checkbox in an empty last item of a list. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): Query + article number from file is nil by default. + +2010-11-11 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk> + + * org-beamer.el (org-beamer-amend-header): Fix typo in docstring. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-place-entry): Move to `beg' before + searching for `%?'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-format-latex): Fix mathjax treatment of single + letters in between dollars. + +2010-11-11 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com> + + * org-latex.el (org-latex-to-pdf-process): Add a third pdflatex + run. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-blank-before-new-entry): Improve docstring. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-force-id-on-agenda-items): Fix + docstring. + (org-mobile-write-agenda-for-mobile): Use outline path if we do + not have an ID and are not allowed to make one. + (org-mobile-get-outline-path-link): New function. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-copy-agenda-files): Encrypt the empty + file. + (org-mobile-write-agenda-for-mobile): Use the right name, even if + the file get encrypted. + (org-mobile-move-capture): Only delete tempfile if it does exist. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-number-p): Fixed documentation string. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Accepting + "tangle" as a positive argument for the :noweb header argument + during tangling. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Fixed export when headings + have links, with tests. + +2010-11-11 Sebastian Rose, Hannover, Germany <sebastian_rose@gmx.de> + + * org-test-which-func: New function. Find name of defun around + point. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-latex-to-pdf-process): Use texi2dvi if + available. + (org-export-latex-get-error): New function. + (org-export-as-pdf): Give an indication of the errors that + happened during processing. + +2010-11-11 Åukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> + + * org-exp.el (org-export-language-setup): Fix Polish entries. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-tags): Allow comma as a separator when + specifying tags at the completion interface. + (org-tags-completion-function): Allow comma as a separator when + specifying tags at the completion interface. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Don't jump back to + export-file if exporting from a buffer which is not visiting a + file. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Only append "::" to a file + name in link construction if there is a heading to follow it. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-html-inline-image-extensions): Add "svg" + as an allowed extension. + +2010-11-11 Sébastien Vauban <wxhgmqzgwmuf@spammotel.com> + + * org-agenda.el (org-agenda-add-time-grid-maybe): Pad clock times + with zeros. Start applying face earlier. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (or): Don't create org-babel-temporary-directory in batch + as it won't be removed by emacs-kill-hook + (org-babel-remove-temporary-directory): Only try to remove this + directory if it exists. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-temporary-directory): Fixing byte-compilation + warning in ob.el. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle): Now sharing the file name in + the tangling message. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-load-languages): Fixes compiler warning. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Fixes bug with svg + output. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-ascii.el (org-export-as-ascii): Use the correct match group. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (boundp): Uncommenting defvar form for + org-babel-temporary-directory + (org-babel-temp-file): Now using the org-babel-temporary-directory + for holding new babel temporary files + (org-babel-remove-temporary-directory): Removes the babel temp dir + when Emacs shutsdown + (kill-emacs-hook): Now removing the babel temp dir on Emacs + shutdown. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): Initialize history + variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Don't move point when generating + edit buffer. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Deal with point being in + #+end_src line. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-current-column): Add interactive to turn + this into a command. + +2010-11-11 Bernt Hansen <bernt@norang.ca> + + * org.el (org-insert-heading): Run org-insert-heading-hook when + creating the first heading in a file. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-startup-with-inline-images): New option. + (org-startup-options): Add new keywords inlineimages and + noinlineimages. + (org-mode): Inline images when this has been configured. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Remove optional + HEADER-VARS-ONLY argument; further simplification. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-confirm-evaluate): Fixed bug causing extra + prompt in ob-confirm-evaluate in some cases. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Visible region and completion + during language selection. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Remove comment. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Simplify function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-get-src-block-info): Form info list correctly + when parenthesised arguments are missing. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-exp.el (org-export-babel-evaluate): Docstring typo + (org-babel-exp-code): Docstring typo. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-encryption-password): Improve + docstring. + (org-mobile-encryption-password-session): New variable. + (org-mobile-encryption-password): New function. + (org-mobile-check-setup): + (org-mobile-encrypt-file): + (org-mobile-decrypt-file): Use the new function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture-place-template): Widen to remove + possible restrictions in target buffer. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> + + * org.el (org-speed-command-hook): Added org-speed-command-hook + (org-babel-speed-command-hook): Hook for Babel's speed commands. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-buffer): Re-implement using + `org-babel-map-src-blocks'. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture-templates): Update doc string with + new message date related escapes. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link-message): Define properties %:date) + (%:date-timestamp, and %:date-timestamp-inactive. + + * org-mew.el (org-mew-store-link): Dto. + + * org-mhe.el (org-mhe-store-link): Dto. + + * org-rmail.el (org-rmail-store-link): Dto. + + * org-vm.el (org-vm-store-link): Dto. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-message-field): Always get literal content of + header fields. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-store-link): Define properties + %:date-timestamp and %:date-timestamp-inactive. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-store-link): Handle empty date header + field. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-speed-command-hook): New. Hook for installing + additional speed commands. Use this for enabling speed commands on + src blocks. + (org-speed-command-default-hook): The default hook for + org-speed-command-hook. Factored out from org-self-insert-command + and mimics existing behaviour. + (org-self-insert-command): Modified to use org-speed-command-hook. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-search-view): Recover spaces in search words + if they were escaped with \ or inside a regexp. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-additional-option-like-keywords): Add PROPERTIES to + the list of completable meta line words. + (org-complete): Complete property names after #+PROPERTY. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-evaluate-session): Make temp file + names consistent. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-clojure.el (org-babel-clojure-evaluate-external-process): + Delete extra format argument. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-org.el (org-babel-org-export): Typo in docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-sh.el (org-babel-sh-evaluate): Remove unused temporary file + variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-scheme.el (org-babel-execute:scheme): Alter temp file name. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-process-file-name): New function + (org-babel-maybe-remote-file): Delete function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-C.el (org-babel-C-execute): Remove unused variable. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-make-link-string): Prevent superfluous colon. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-make-org-heading-search-string): Leave headline + intact. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-make-link-string): Don't escape characters in link + type. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-capture.el (org-capture-templates): Update docstring to + advertize %:org-date. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-dot.el (org-babel-execute:dot): Automatically specifies + "-T<ext>" based on file name extension. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-org-export): Raise error on nested export + call. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Support for svg + output files. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Better initialization of + stars. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-tab-acts-natively): Add customize interface. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-strip-leading-and-trailing-blank-lines): New + variable allowing prevention of automatic stripping of leading and + trailing blank lines when exiting edit buffer. + (org-edit-src-exit): Respect value of + `org-src-strip-leading-and-trailing-blank-lines' + (org-src-native-tab-command-maybe): Bind + `org-src-strip-leading-and-trailing-blank-lines' to nil during + this function. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): If mark was inside code block + then code edit buffer inherits mark with active region. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Fix compiler warnings. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Better handling of empty + space around demarcated area. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-goto-date): Turn off prefer future for + this command. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-open-nntp): New function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-open-nntp): New function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-open): Open message by numeric reference if + article part is not a message id. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-filter-apply): Move cursor to a + visible line. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-demarcate-block): Interactive demarcation of + code blocks + + * ob-keys.el (org-babel-key-bindings): Key bindings for block + demarcation. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org.el (org-link-types): Add the "message" link type. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-types): Add 'message:' link type to default + link types. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-gnus.el (org-gnus-store-link): Add the :date property to + gnus links, allowing the use of %:date in capture templates. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Follow order of bullets + indicated in doc-string. + + * org-list.el (org-list-bottom-point-with-indent): List is ended + when a line is less indented that the last item, not the less + indented item. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-src-blocks): Now switching back to the + original file before resolving code block parameters to ensure + headline and buffer wide parameters are taken into consideration + when only a narrowed portion of the file is exported. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-forward-same-level): Fix docstring. + +2010-11-11 Sebastian Rose <sebastian_rose@gmx.de> + + * org-publish.el (org-publish-attachment): Put the attachment into + the right directory. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-goto-first-child): New command. + +2010-11-11 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-prepare-agenda): If the agenda is called from + within the agenda via an elisp link, such as + [[elisp:(org-agenda-list)]], org-prepare-agenda erases the buffer + of the file containing the link, since that buffer is current + during org-prepare agenda (due to a with-current-buffer in + org-agenda-open-link). An additional test now ensures that the + agenda buffer is in fact current when the buffer is erased and + local variables for the agenda are set. + +2010-11-11 David Maus <dmaus@ictsoc.de> (tiny change) + + * org-exp.el (org-infile-export-plist): Define property macro. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-mhe.el (org-mhe-get-header): Remove possible folding white + space in message header field. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed): Fix typo in customization group :tag + property. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-tag-markup): New option. + (org-export-latex-keywords-maybe): Use + `org-export-latex-tag-markup'. + +2010-11-11 Rémi Vanicat <vanicat@debian.org> + + * org-icalendar.el (org-icalendar-use-UTC-date-time): New option. + (org-ical-ts-to-string): Use UTC time when requested. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org-html.el (org-html-cvt-org-as-html): Do not convert protocol + from 'file' to 'http'. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-store-log-note): Fix wrong usage + of`org-adapt-indentation'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-skip-over-state-notes): Do not compute bottom point + at each item. + + * org-mouse.el (org-mouse-for-each-item): Use `org-apply-on-list' + instead of moving to each item. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture-templates): Small fix in doc string. + +2010-11-11 aaa bbb <dominik@powerbook-g4-12-van-aaa-bbb.local> + + * org-archive.el (org-get-local-archive-location): Use + `org-carchive-location' as default. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org): No longer requires org + + * ob-ledger.el (org): No longer requires org. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-priority): Save match data before call to + `read-char-exclusive'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-to-generic): Descriptions labels can be + any suit of symbols, and will end at double colons. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Indent past [@num] and + [@start:num], consistently with what is already done with + checkboxes. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-store-log-note): Indent new notes to the right + column. Also take `org-list-two-spaces-after-bullet-regexp' into + consideration when creating the note. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (nnimap-group-overview-filename): Declare function + to silence byte compiler. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): New + customization variable. + (org-gnus-nnimap-cached-article-number): New function. + (org-gnus-follow-link): Try to fetch cached article number of + message-id. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-org-default-header): Used to insert a dummy + first line into code blocks before export so that the first line + is not interpreted as a title + (org-babel-org-export): Use new dummy code block prefix. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): No longer throws error when + inserting an empty result. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el: autoload org-babel-tangle-lang-exts from ob-tangle. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): Use + `org-babel-where-is-src-block-head' to test for source block at + point. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-keys.el (org-babel-key-bindings): Adding key-binding for + `org-babel-goto-src-block-head' + + * ob.el (org-babel-goto-src-block-head): Jump to the head of the + current code block. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-next-src-block): Now raising more informative + error when no further code blocks can be found + (org-babel-previous-src-block): Now raising more informative error + when no previous code blocks can be found. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el + (org-export-preprocess-after-include-files-hook): Now using this + hook instead of `org-export-preprocess-hook'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-evaluate): Refactor as call to + either `org-babel-python-evaluate-external-process' or + `org-babel-python-evaluate-session'. + (org-babel-python-evaluate-external-process): New function to + handle evaluation in external process. + (org-babel-python-evaluate-session): New function to handle + evaluation in emacs inferior process. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-execute:org): Evaluates body to latex ascii + or html respecting :results header arg + (org-babel-org-export): Exports a string of text to an output + format. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Remove existing results when + nil results are returned. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-ascii.el (org-export-as-ascii): Bind and set link path for + link type specific markup function. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-clock.el (notifications-notify): Properly declare function + to silence byte compiler. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Check invisibility of point at a + meaningful location. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): Updating checkboxes + can modifiy bottom point of a list, so make it a marker before + calling `org-update-checkbox-count-maybe'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org.el (org-src-fontify-natively): Set to nil by default. + Supply cutomize interface. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-ascii.el (org-export-as-ascii): Fix bug in ASCII export: use + `org-bracket-link-analytic-regexp++' to match the link type. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Rename `lang' to + `language'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-comment-format-beg): Format + string specifying the link-comment preceding a code block + (org-babel-tangle-comment-format-end): Format string specifying + the link-comment following a code block + (org-babel-tangle-collect-blocks): Storing more information in the + spec of a tangling code block + (org-babel-spec-to-string): Now makes use of customizable + link-comment formats. + +2010-11-11 Achim Gratz <Stromeko@stromeko.net> (tiny change) + + * org.el (org-delete-backward-char): Check for nil overwrite-mode + before inserting spaces. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-icalendar.el (org-print-icalendar-entries): Exclude tags + from summary of non-TODO ical entries. + (org-print-icalendar-entries): Use `org-complex-heading-regexp' to + exclude tags from summary of TODO ical entries. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Now exposes much information + about the code block in the form of let-bound local variables. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-list.el (org-outline-regexp, org-ts-regexp) + (org-ts-regexp-both, org-in-regexps-block-p) + (org-level-increment, org-at-heading-p) + (outline-previous-heading, org-icompleting-read) + (org-time-string-to-seconds): Declare to fix compiler warning. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): Ignore items in drawers when + used from an heading. Send an error when no item is in region. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): Use unwind-protect to + ensure that edit buffer is exited. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-pad-newline): Can be used to + control the amount of extra newlines inserted into tangled code + (org-babel-tangle-collect-blocks): Now conditionally collects + information to be used for "org" style comments + (org-babel-spec-to-string): Now inserts "org" style comments, and + obeys the newline configuration variable when inserting whitespace. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-pre-tangle-hook): Defines new tangle + hook + (org-babel-tangle): Calls new tangle hook. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture): Compute the length of the correct + string when removing properties. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Now expanding file + names before shell quoting. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-tab-indents-natively): New variable + controlling whether language-native TAB action should be performed + (org-src-native-tab-command-maybe): New function to perform + language-native TAB action. + (org-tab-first-hook): Add `org-src-native-tab-command-maybe'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Explicitly check + `org-plantuml-jar-path' before use. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-src-font-lock-fontify-block): Re-use hidden + language major mode buffers during fontification. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org.el (org-fontify-meta-lines-and-blocks): Alter main regexp to + match code blocks with switches and header args. Call + `org-src-font-lock-fontify-block' for automatic fontification of + code in code blocks, controlled by variable + `org-src-fontify-natively'. + (org-src-fontify-natively): New variable. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ruby.el (org-babel-expand-body:ruby): Removed requirement of + inf-ruby. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org-html.el (org-html-make-link): (Expand-file-name ) removes + one "/" from "///path-to-file", so add one. Anything other than + 'file' type should be exported along with the type. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org.el (org-insert-subheading) : Fix compiler warning + (org-insert-todo-subheading) : Fix compiler warning. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture): Remove read-only text properties + from capture text. + (org-capture-set-target-location): Throw an error if file+headline + target does not point into a file which is in Org mode. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-map-src-blocks): Prefer `when' to `if'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Improve docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-src-block): Document prefix argument in + docstring. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-ditaa.el (org-babel-execute:ditaa): Now expanding + org-ditaa-jar-path with expand-file-name. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-subtree): Pass prefix arg through to + `org-babel-execute-src-block'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-ascii.el (org-export-ascii-preprocess): Allow [@start:x] and + [@x] syntax for list numbering. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Indentation of source block + is left to `org-edit-src-exit' and shouldn't be modified by + `org-indent-line-function'. Indentation of others blocks should be + the same as the #+begin line. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-map-src-blocks): If FILE is nil evaluate BODY + forms on source blocks in current buffer; restore point in current + buffer. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct): Accept list boundaries as an + argument in order to avoid computing `org-list-top-point' and + `org-list-bottom-point' twice when indenting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-ending-method): Default value is now + `both', to ensure maximum compatibility before previous + implementation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-in-item-p-with-indent): Test if first line + is the item beginning. + + * org-list.el (org-list-top-point-with-indent): Test if first line + is a valid list beginning. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-ending-method): New customizable variable + to tell Org Mode how lists end. See docstring. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Shifting step of top-level + item depends on `org-level-increment'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-indent-line-function): Indent first non blank line + after a list according to current heading level. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): Removed check for + indentation on lines that do not start with a list bullet. + + * org-html.el (org-export-as-html): Same thing. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point): Take into consideration + that bound of search can be before true ending of the list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-apply-struct): No longer shift + item's body twice: one after replacing bullet and one after + changing indentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-indent): Added code to replace + bullets if needed when indenting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): A single item + already counting blank lines in his body should be separated with + the next one by a blank line. Moreover, if user already provided + blank lines, follow his wishes. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): When moving top item of a + *-list to column 0, only the first item had its bullet changed to + -. It now changes all items of the top-level list, as expected. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-toggle-checkbox): Go to beginning of line + before processing. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-struct-apply-struct): Check if ancestor + exists. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-renumber-ordered-list): Check for [@start:x] is + done at each item. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el : Removed unused variable + `org-suppress-item-indentation'. + + * org-list.el (org-renumber-ordered-list): Skip item if bullet + number is already good. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-automatic-rules): Doc-string reflects this + change. + + * org-list.el (org-indent-item-tree): Prevent whole list from + being moved when user is not moving subtree. Thus) + (`org-cycle-item-indentation' will not allow to move the list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Removed region code. It was + prone to errors and undocumented. + + * org-list.el (org-item-indent-positions): Better heuristics to + determine what bullet the item will have when demoted. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bullet-string): First check if + `org-list-two-spaces-after-bullet-regexp' isn't nil. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bullet-string): Do not modify match-data. + + * org.el (org-toggle-item): Now working again when changing list + items into plain text. Moreover take into consideration + `org-list-two-spaces-after-bullet-regexp'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Removed unnecessary bullets + fix, and improved heuristics to determine bullet when indenting. + + * org-list.el (org-item-indent-positions): Function now returns + sane results when there are two lists separated with blank lines + only. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): Use override="num" in + any listitem matching [@start:num] + + * org-html.el (org-export-as-html): Use value="num" in any li + matching + [@start:num] + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-set-font-lock-defaults): Correct fontification for + checkboxes found after [@start:?]. + + * org-list.el (org-list-at-regexp-after-bullet-p): Skip any + [@start:?] when looking at a regex after a bullet. + + * org-list.el (org-toggle-checkbox): Correct insertion of + checkboxes when there is already a [@start:?] in the item. + + * org-list.el (org-checkbox-blocked-p): Properly check if there's + an unchecked item before. + + * org-list.el (org-list-parse-list): Function handles items having + both a counter and a checkbox. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Org-tab-ind-state + stores both indentation and bullet when cycle started. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: `org-at-description-p' renamed to + `org-at-item-description-p', `org-first-list-item-p' renamed to + `org-list-first-item-p', `org-end-of-item-text-before-children' + renamed to `org-end-of-item-or-at-child'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-ctrl-c-ctrl-c): Call `org-fix-bullet-type' instead + of `org-maybe-renumber-ordered-list' and `org-fix-bullet-type' + before toggling a checkbox. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bullet-string): New function returning + bullet concatenated with an appropriate number of white spaces. + + * org-list.el (org-list-insert-item-generic): Insert the right + bullet, with help of `org-list-bullet-string'. + + * org-list.el (org-indent-item-tree): Use + `org-list-bullet-string'. + + * org-list.el (org-fix-bullet-type): Use `org-list-bullet-string'. + + * org-list.el (org-toggle-checkbox): Send an error when + `org-toggle-checkbox' is trying to insert a checkbox at a + description item. + + * org-list.el (org-item-re): Modified regexp so it can catch + correct number of white space before item body. + + * org-list.el (org-list-at-regexp-after-bullet-p): Take into + consideration new `org-item-re'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): The second item in a + list will be separated from its predecessor with the number of + blank lines separating the first item from its parent, if any, or + no blank line. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Fix and reorder every list + and sublist, from parent of list that has moved if indenting, or + from list at point if outdenting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Try to keep relative + position on line. It can't if point is in white spaces before + bullet because mixed tabs and spaces make some columns + unattainable. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Cycle when the whole + item only contains bullet and maybe a checkbox. Previously, TAB + would cycle when the first line of the item was blank. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Allow a point just + after a description item or a checkboxed item to start cycling. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Check + `org-plain-list-ordered-item-terminator' before allowing 1. or 1) + as valid bullets when cycling. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Do return t if and + only if cycling is possible and succeded. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): When outdenting a subtree, + the last item shouldn't have a children. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-item-indentation): Cycling should play + nicely with indent rule in `org-list-automatic-rules'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): If indent rule is activated, + it should be impossible to outdent an item having children without + moving its subtree. Improved reordering of lists modified by + cycling indentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-maybe-renumber-ordered-list): Removed call for + `org-fix-bullet-type' to prevent infinite loop, and some checks + already done in `org-renumber-ordered-list'. + + * org-list.el (org-fix-bullet-type): Remove a check and call + directly `org-maybe-renumber-ordered-list'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): It shouldn't be possible to + indent the first item of a sublist (though outdent is possible) as + it would break list's structure. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-insert-item-generic): When local search + doesn't help, search the list globally for blank lines. Moreover, + don't bother with new lists, and add 1 blank line. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-capture.el (org-capture-place-item): Use + `org-search-forward-unenclosed' and + `org-search-backward-unenclosed' and new variable + `org-item-beginning-re'. + + * org-list.el (org-item-beginning-re): Regexp matching beginning + of an item. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Put back support for + 'previous argument. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-in-item-p): Handle case when point is at an + heading. + + * org-list.el (org-list-make-subtree): Add protection when used + outside of list + + * org-list.el (org-insert-item): Removed useless hack now + `org-in-item-p' is fixed. + + * org-timer.el (org-timer-item): Removed useless hack now + `org-in-item-p' is fixed. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-cycle-list-bullet): Prevent description items + from being numbered. String argument is also recognized now, as + long as it is a valid bullet. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-indent-item-tree): Moving indentation of top + list item will make the whole list move. + + * org-list.el (org-apply-on-list): Function is less sensitive to + changes of indentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-at-item-checkbox-p): Add whitespaces at the end + of the regexp. + + * org-list.el (org-checkbox-blocked-p): Use new checkbox regexp. + + * org-list.el (org-cycle-item-indentation): Allow cycling + description items and checkbox items. + + * org-list.el (org-toggle-checkbox): Use new checkbox regexp. + + * org-list.el (org-reset-checkbox-state-subtree): Use new checkbox + regexp. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item-internal): Guessing of blank lines + number is made by looking at neighbours items, if any. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-sort-list): Add the possibility to sort timer + lists with the ?t or ?T options. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-unenclosed-internal): New function to + handle both `org-search-forward-unenclosed' and + `org-search-backward-unenclosed'. + + * org-list.el (org-search-backward-unenclosed): Can send errors + now. Removed useless usage of COUNT. + + * org-list.el (org-search-forward-unenclosed): Can send errors + now. Removed useless usage of COUNT. + + * org-list.el (org-update-checkbox-count): Use + `org-search-forward-unenclosed' and + `org-search-backward-unenclosed' instead of `re-search-forward' + and `re-search-backward'. + + * org-list.el (org-sort-list): Use `org-search-forward-unenclosed' + and `org-search-backward-unenclosed' instead of + `re-search-forward' and `re-search-backward'. + + * org-list.el (org-list-make-subtree): Use + `org-search-forward-unenclosed' and + `org-search-backward-unenclosed' instead of `re-search-forward' + and `re-search-backward'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item-internal): Fixes the problem when + point was before the first char of the item's body. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-timer.el (org-timer-item): Refactoring. Compute timer string + before inserting it in the buffer + + * org-timer.el (org-timer): Added an optional argument to return + timer string instead of inserting it. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item-internal): New function to handle + positionning and contents of an item being inserted at a specific + pos. It is not possible anymore to split a term in a description + list or a checkbox when inserting a new item. + + * org-list.el (org-insert-item): Refactored by using the new + `org-insert-item-internal' function. + + * org-timer.el (org-timer-item): Refactored by using the new + `org-insert-item-internal' function. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point): Be sure to check real + ORG-OUTLINE-REGEXP and not outline-regexp, that might be modified. + + * org.el (org-cycle-internal-local): Cycle up to end of subtree or + end of item if we are in a list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Move before any special block in + a list prior to add a new item. + + * org-timer.el (org-timer-item): When in a timer list, insert a + new timer item like `org-insert-item'. If in another list, send an + error. Otherwise, start a new timer list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: Minor refactoring. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-timer.el (org-timer-item): Insert description list item at + the right column. + + * org-list.el (org-insert-item): Insert the right number of blank + lines before a relative timer. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Remove restriction on latex + blocks. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-backward-unenclosed): Do not stop in + protected places. + + * org-list.el (org-search-forward-unenclosed): Do not stop in + protected places. + + * org-latex.el (org-export-latex-lists): Use the fact that + org-search-forward do not stop anymore at protected places. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-backward-unenclosed): Do not prevent + list items from being inside LaTeX blocks. + + * org-list.el (org-search-forward-unenclosed): Do not prevent list + items from being inside LaTeX blocks. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-in-item-p): Do not widen before checking if we + are in item. + + * org-list.el (org-list-send-list): We cannot count on + `org-list-top-point' and `org-list-bottom-point' before buffer is + narrowed. Find bounds of list otherwise. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-end-regexp): By default, list ending is + exactly 2 blank lines. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): When we find an empty + line, we do not need to check for + `org-empty-line-terminates-plain-lists' because we would have + found end-list marker before. + + * org-html.el (org-export-as-html): Same. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-insert-item): Simplify count of blank lines to + insert. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-end-regexp): New customizable variable to + define what string should end lists. + + * org-list.el (org-list-end-re): Function is now aware of + `org-list-end-regexp'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-as-html): Code cleanup. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-docbook.el (org-export-as-docbook): Properly close any open + list when seeing ORG-LIST-END. Removed any reference to now + unneeded DIDCLOSE variable. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-ending): Fix number of blank + lines inserted after a list. + + * org-list.el (org-list-parse-list): Fix case when + `org-list-end-re' would have an indentation greater than current + list. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el (org-export-mark-list-ending): Differentiate between + export backends, and replace `org-list-end-re' by a blank line + upon exporting. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-as-html): Delete didclose and everything + related to it, as it is no longer needed. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-html-preprocess): Remove unneeded + insertion of list end marker, as it is now handled by + `org-export-mark-list-ending'. + + * org-html.el (org-export-as-html): Cleaner termination of lists. + + * org-exp.el (org-export-mark-list-ending): New function to insert + specific markers at the end of lists when exporting to a backend + not using `org-list-parse-list'. This function is called early in + `org-export-preprocess-string', while it is still able to + recognize lists. + + * org-latex.el (org-export-latex-lists): Better search for + lists. It now only finds items not enclosed and not protected. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el: Replaced `re-search-forward' by + `org-search-forward-unenclosed' where it made sense. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-apply-to-list): Now a return value is handed at + each new call of the function applied. + + * org-list.el (org-fix-bullet-type): Use the new + `org-apply-to-list' format. + + * org-list.el (org-renumber-ordered-list): Use the new + `org-apply-to-list' format. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-in-regexps-block-p): Minor fix: limit wasn't + correctly used. + + * org-list.el (org-search-forward-unenclosed): Better regexp used. + + * org-list.el (org-search-backward-unenclosed): Better regexp + used. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-sort-list): End-rec function was ill-defined. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-forward-unenclosed): Fix behavior when + last occurence was enclosed. + + * org-list.el (org-search-backward-unenclosed): Fix behavior when + last occurence was enclosed. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-in-regexps-block-p): Fix documentation. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-search-backward-unenclosed): Fix block regexp. + + * org-list.el (org-search-forward-unenclosed): Fix block regexp. + + * org-list.el (org-list-parse-list): Minor fix. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-parse-list): Delete `org-list-end-re' when + called with t argument. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el (org-export-html-preprocess): Replace + `org-list-end-re' by a blank line during pre-process. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-bottom-point): No need for square brackets + for `skip-chars-backward'. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el: Do not delete space between end of list and + beginning of the following. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el: preprocess buffer string and add ORG-LIST-END where + needed. Lists should not end before seeing this. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-html.el: Notice end of lists. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-parse-list): Better handling of + restrictions when function is called on a list with sublists. + + * org-list.el (org-list-send-list): Find the true ending of the + list being sent. + + * org-list.el (org-list-radio-list-templates): Templates are more + specific to lists. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-js.el (org-babel-js-eoe): Indicate end of input + (org-babel-execute:js): Support for session evaluation + (org-babel-prep-session:js): Fleshed out definition + (org-babel-js-initiate-session): Can initiate a session using + mozrepl. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org.el (org-set-regexps-and-options): Protect escape char in + `org-complex-heading-regexp-format'. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-scheme.el (org-babel-scheme-eoe): For marking the end of + session-based evaluation + (org-babel-execute:scheme): Now supports session-based evaluation + (org-babel-prep-session:scheme): Now works and defines variables + (org-babel-scheme-initiate-session): Now works using run-scheme + from cmuscheme. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-export-latex-default-packages-alist): Remove the + t1enc package - this is already covered by fontenc. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (with-parsed-tramp-file-name): Declared + (org-babel-tramp-localname): Ensure variable name exists locally. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-temp-file): Don't use babel temporary directory + in remote case; use make-temp-file with remote file name so that + temp file is guaranteed not to exist previously on remote machine. + (org-babel-tramp-localname): New function to return local name + portion of possibly remote file specification. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-write-object-command): New unified R + command for writing results to file + (org-babel-R-wrapper-method): Remove variable + (org-babel-R-wrapper-lastvar): Remove variable + (org-babel-R-evaluate-external-process): Use new R command + (org-babel-R-evaluate-session): Use new R command. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-comint.el + (org-babel-comint-eval-invisibly-and-wait-for-file): New function + to evaluate code invisibly and block until output file exists. + + * ob-R.el (org-babel-R-evaluate-session): Use `ess-eval-buffer' to + evaluate R code in session for :results value. Write result to + file invisibly using new function + `org-babel-comint-eval-invisibly-and-wait-for-file'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): Align tags after + insertion. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-concatenate-multiline-emphasis): Ignore + matches that start in a headline. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-plantuml.el (org-babel-execute:plantuml): Wrapping in-file + and out-file in shell-quote-argument. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-docview.el (org-docview-store-link): Use expanded macro to + get current page. + (doc-view-goto-page, image-mode-window-get): Declare functions for + byte compiler. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-scheme.el: very preliminary support for evaluating scheme + code blocks + + * org.el (org-babel-load-languages): Adding scheme. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (require): Remove circular (require 'org). + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (ess-make-buffer-current): Declared + (ess-ask-for-ess-directory): Declared + (ess-local-process-name): Declared + + * ob-latex.el (org-babel-latex-tex-to-pdf): Capturing free + variable + + * ob.el (org-edit-src-code): Fixing arguments + (org-edit-src-exit): Declared + (org-outline-overlay-data): Declared + (org-set-outline-overlay-data): Declared. + +2010-11-11 Glenn Morris <rgm@gnu.org> + + * ob.el: Require org when compiling. + (org-save-outline-visibility): Remove macro declaration. + + * ob-emacs-lisp.el: Require ob-comint when compiling, for macros. + Remove unnecessary/macro declarations. + + * org-docview.el: Require doc-view when compiling. + (doc-view-goto-page): Autoload rather than declaring. + (doc-view-current-page): Remove macro declaration. + + * ob.el (tramp-compat-make-temp-file, org-edit-src-code) + (org-entry-get, org-table-import): Fix declarations. + (org-match-string-no-properties): Remove declaration. + + * ob-sh.el (org-babel-comint-in-buffer) + (org-babel-comint-wait-for-output, org-babel-comint-buffer-livep) + (org-babel-comint-with-output): Remove unnecessary declarations. + + * ob-R.el (orgtbl-to-tsv): Fix declaration. + + * org-list.el (org-entry-get): Fix declaration. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-remove-temporary-directory): Removed explicit + second argument. + +2010-11-11 Magnus Henoch <magnus.henoch@gmail.com> (tiny change) + + * org-clock.el (org-clocktable-steps): Allow ts and te to be day + numbers. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-macs.el (org-save-outline-visibility): Moved from org.el. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-org.el (org-babel-default-header-args:org): Additional + ":results silent" default header argument for org code blocks. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-exp.el (org-babel-exp-do-export): Remove hacky ":noeval", + which is now an alias to ":eval no" + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-remove-temporary-directory): The version of + `delete-directory' found in files.el can not be assumed to be + present on all versions, so this copies the recursive behavior of + that command in such a way that all calls to delete-directory will + also work with the built-in internal C implementation of that + function. This is not overly difficult as all elements of the + directory can be assumed to be files. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org-babel-C-execute): Corrected arguments to + org-babel-temp-file. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-temporary-directory): Variable to hold the + value of the Babel temporary directory. + +2010-11-11 Aditya Siram <aditya.siram@gmail.com> + + * ob.el (org-babel-load-in-session): Expanding noweb references + when appropriate. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-make-link-regexps): Modified regexp of + org-plain-link-re. + +2010-11-11 Noorul Islam <noorul@noorul.com> (tiny change) + + * org-habit.el (org-habit-parse-todo): Find sr-days only if + scheduled-repeat is non nil. Use 4th element of the list returned + by (org-heading-components) as habit-entry. Modify the error + message to be more meaningful. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-latex.el (org-babel-execute:latex): Adding new ":fit" and + ":border" header arguments which both use the "preview" latex + package to fit the resulting pdf image to the figure. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link): Don't try to store link if point + is at end of buffer. + +2010-11-11 Harri Kiiskinen <harkiisk@gmail.com> + + * org-publish.el (org-publish-project-alist): Document the new + body-only property. + (org-publish-org-to): Use the body-only property. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-store-link): Return link when invoked + non-interactively from an agenda buffer. + +2010-11-11 Jambunathan K <kjambunathan@gmail.com> (tiny change) + + * org.el (org-store-link): Storing of links to headlines in + indirect buffers was broken. Fix it. + +2010-11-11 Aidan Kehoe <kehoea@parhasard.net> + + * ob-tangle.el (org-babel-tangle): Change the MODE argument to + #'set-file-modes to use integer, not character syntax, avoiding + compile problems with recent XEmacs. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-add-entry-text): Make sure we move + forward even if there is no text to be added. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-make-tags-matcher): Read "\\-" as "-" in the + tags/property matcher. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-infile-export-plist): Bind case-fold-search to + t. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-with-point-at-orig-entry): New macro. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-set-initial-vars): Bind + `case-fold-search' to t around the search for special LaTeX setup. + + * org-beamer.el (org-beamer-after-initial-vars): Bind + `case-fold-search' to t around the search for special BEAMER + setup. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Delete postscript file after + creating conversion to pdf. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Move require statements to + proper place in evaluated lisp expression. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Rename temporary buffer to + remove dependency of `flet' macro. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-lob.el (org-babel-lob-get-info): Edit docstring. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-exp.el (org-babel-exp-lob-one-liners): Get parameter values + from all standard sources when executing #+lob/#+call lines. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-evaluate): Break the two branches into two + separate functions + (org-babel-R-evaluate-external-process): New function to handle + external process evaluation + (org-babel-R-evaluate-session): New function to handle session + evaluation. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-initiate-session): New function derived from + previous `org-babel-switch-to-session' + (org-babel-switch-to-session): Refactored to use new + `org-babel-initiate-session'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-switch-to-session): Supply missing "P" argument + to (interactive). + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-format-entry): Decode entry according to + its character encoding. + +2010-11-11 David Maus <dmaus@ictsoc.de> (tiny change) + + * org-feed.el (xml-substitute-special): Declare function for byte + compiler. + (org-feed-unescape): Removed. + (org-feed-parse-rss-entry, org-feed-parse-atom-entry): Use + `xml-substitute-special' to unescape XML entities. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-switch-to-session): Throw error if block if + :session not in effect for the block. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-create-with-table.el): Align table + before converting. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): Suppress message and check + that org-src buffer is current before attempting exit. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (ob-comint): Require 'ob-comint + (org-src-babel-info): Define variable. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-do-in-edit-buffer): New macro to evaluate lisp + in the language major mode edit buffer. + (org-babel-do-key-sequence-in-edit-buffer): New function to call + an arbitrary key sequence in the language major mode edit buffer + + * org-src.el (org-src-switch-to-buffer): Add new allowed value + 'switch-invisibly for `org-src-window-setup'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (ob-keys): Require ob-keys, because `org-babel-map' + is used. + (org-src-do-at-code-block): New macro to evaluate lisp with point + at the start of the Org code block containing the code in this + edit buffer. + (org-src-do-key-sequence-at-code-block): New function to execute + command bound to key at the Org code block containing the code in + this edit buffer. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-associate-session): New function to + associate R code edit buffers with ESS comint session. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): If at src block, store babel + info as buffer local variable. + (org-src-associate-babel-session): New function to associate code + edit buffer with comint session. Does nothing unless a + language-specific function named + `org-babel-LANG-associate-session' exists. + (org-src-babel-configure-edit-buffer): New function to be called + in `org-src-mode-hook'. + (org-src-mode-hook): Add `org-src-babel-configure-edit-buffer' to + hook. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-switch-to-session-with-code): New function to + generate split frame displaying edit buffer and session. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-tags): Consider org-indent-mode when computing + the tags column. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-looking-at-p): Only use looking-at-p when + defined. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-finalize-agenda-entries): Delete excluded + lines directly after call to sorting filter function. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-complex-heading-regexp-format): Document the + variable. + (org-get-refile-targets): Use `org-complex-heading-regexp-format' + to make the regular expression for matching the headline. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-refile-check-position): New function. + (org-goto): + (org-refile-get-location): Call `org-refile-check-position'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-initiate-session-by-key): Use eq + instead of equal to compare symbols. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-before-sorting-filter-function): New + hook function. + (org-finalize-agenda-entries): Apply + `org-agenda-before-sorting-filter-function'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-first-lines): Do not protect meta + lines that have nothing to do with babel. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-place-template): Handle the + checkitem case. + (org-capture-place-item): Provide boundaries for the search to + make sure we do not get a match in a different tree. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preprocess-apply-macros): Fix the macro + argument parser. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-latex.el (org-latex-to-pdf-process): Add output-directory + option for the command pdflatex. + (org-export-as-pdf): Respect directory in path of + EXPORT_FILE_NAME. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-with-LaTeX-fragments): New default t, + which now means to use MathJax processing for HTML. Also allow + new value `dvipng' to force the old image processing. + (org-infile-export-plist): Parse for MATHJAX setup line. + + * org-html.el (org-export-html-mathjax-options): New option. + (org-export-html-mathjax-config): New function. + (org-export-html-mathjax-template): New option. + (org-export-html-preprocess): Call the LaTeX snippet processor + with an additional argument to declare special ways of processing. + (org-export-as-html): Bind the dynamical variable + `org-export-have-math'. Insert the MathJax script template when + it is needed by the document. + + * org.el (org-preview-latex-fragment): Call `org-format-latex' + with the additional processing argument. + (org-export-have-math): New variable, for dynamic scoping. + (org-format-latex): Implement specific ways of processing. New + function argument for processing type. + (org-org-menu): Remove the entry to configure LaTeX snippet + processing. + +2010-11-11 Bastien Guerry <bzg@altern.org> + + * org-agenda.el (org-agenda-clock-goto): Use `\C-c\C-x\C-j' for + `org-clock-goto' and `J' for `org-agenda-clock-goto'. If the + heading currently clocked in is not listed in the agenda, display + this entry in another buffer. If there is no running clock, + display a help message. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-tables): Return "" instead of nil + when no label is attached. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-menu-show-match): New option. + (org-agenda-menu-two-column): New option. + (org-agenda-get-restriction-and-command): Implement dispatch menu + without showing the matcher, and with two-column display. + +2010-11-11 Bernt Hansen <bernt@norang.ca> + + * org-indent.el (org-indent-mode): Fix grammar for message when + mode is refused. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-insert-result): Ensures `beg' is set, even if + no previous result exists. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * ob.el Declare org-babel-lob-execute-maybe() to avoid compiler + warning. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org.el: org-set-visibility-according-to-property () Use backward + search instead of forward, so that top hierarchy gets priority. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-timeline): Allow indirect buffer. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preprocess-after-radio-targets-hook): + (org-export-define-heading-targets-headline-hook): New hooks. + + * org.el (org-modules): Add entry for org-wikinodes.el. + (org-font-lock-set-keywords-hook): New hook. + (org-open-at-point-functions): New hook. + (org-find-exact-headling-in-buffer): + (org-find-exact-heading-in-directory): New functions. + (org-mode-flyspell-verify): Better cursor position for checking if + flyspell should ignore a word. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el (org-indent-remove-properties): + (org-indent-add-properties): Make sure changing these properties + does not trigger modification hooks. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-search-must-match-exact-headline): New option. + (org-link-search-inhibit-query): New variable. + (org-link-search): Search for exact headline match in Org files. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-execute-src-block-maybe): Remove check for + `org-babel-no-eval-on-ctrl-c-ctrl-c'; this is done in the new + function `org-babel-execute-safely-maybe'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-load-in-session): Set directory in case :dir + arg is in effect. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-tangle-collect-blocks): Don't throw + errors when we're not under of a headline. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-octave-wrapper-method): Use dlmwrite to + write delimited text instead of save -ascii + (org-babel-octave-import-elisp-from-file): Specify that data + written to file is tab-delimited. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-R.el (org-babel-R-evaluate): Specify that tabular data is + tab-delimited. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob.el (org-babel-import-elisp-from-file): Allow separator to be + specified. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-python.el (org-babel-python-table-or-string): Fix recognition + of lists and tuples. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-octave-evaluate-external-process): Allow + remote files. + +2010-11-11 Juan Pechiar <pechiar@computer.org> + + * ob-octave.el (org-babel-octave-evaluate-external-process): Use + `org-babel-octave-import-elisp-from-file' instead of + `org-babel-eval-read-file'. + (org-babel-octave-var-to-octave): Separate matrix rows with ';', + and use '%s' as format specifier instead of '%S'. + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el only (require 'matlab) when necessary + (org-babel-octave-initiate-session) (require) octave-inf or matlab + as appropriate + (org-babel-execute:matlab): Remove (require) + (org-babel-prep-session:matlab): Remove (require) + (org-babel-matlab-initiate-session): Remove (require). + +2010-11-11 Dan Davison <davison@stats.ox.ac.uk> + + * ob-octave.el (org-babel-octave-evaluate): Fix formal argument + list. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-python.el (org-babel-python-table-or-string): Can now handle + VERY long result lines. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-tables): Add label if any + + * org-latex.el (org-export-latex-convert-table.el-table): Fix + little mistake when inserting label. + +2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com> + + * org.el (org-cycle-internal-local): Removed an unnecessary call + to `org-back-to-heading' that was preventing point to stay at its + column when cycling visibility. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-capture.el (org-capture-finalize): Make messages consistent. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-gnus.el: Suppress compiler warning by declaring outside + function nnimap-retrieve-headers-from-file. + +2010-11-11 Noorul Islam <noorul@noorul.com> + + * org-colview.el Use org-beamer-select-environment instead of + org-beamer-set-environment-tag. + +2010-11-11 Matt Lundin <mdl@imapmail.org> + + * org.el (org-insert-time-stamp): Fix org-insert-time-stamp so + that the value of org-last-inserted-timestamp includes time range. + +2010-11-11 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link-message): Provide link property for + message-id without angle brackets. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (org-babel-R-evaluate): Improved prompt-stripping regexp. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-find-file-noselect-refresh): Finds a + file ensuing that the latest changes on disk are represented. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-sqlite.el (org-babel-sqlite-expand-vars): Now inserts string + arguments w/o quotes. + +2010-11-11 Bernt Hansen <bernt@norang.ca> + + * org-capture.el (org-capture-finalize): Fix clock in of + interrupted task during capture finalize. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-R.el (org-babel-R-evaluate): Clean up extra prompts in + session output. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el (org-babel-C-ensure-main-wrap): More generous regular + expression for matching main function. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-one-liner-regexp): Fixed error in lob + regexp -- it wasn't matching lob lines w/o indices. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-latex-listings-w-names): Fix compiler + warning in org-exp.el. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-file): Better error message if + base-directory or publishing-directory are not defined. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-colview.el (org-columns-display-here): Use overlays to + overrule line prefix properties during column view. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-filter-preset): Document the + limitation for the filter preset - it can only be used for an + entire agenda view, not in an individual block in a block agenda. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-table.el (sbe): Now able to accept range references from + tables. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob.el (org-babel-pick-name): If colnames or rownames contain a + list of names, then use those directly. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Escape + underscores in code block names on latex listings export. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-tangle.el (org-babel-with-temp-filebuffer): Use + find-file-noselect to avoid excess buffer movement. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-html-should-inline-p): Only inline images if + they should be. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-id.el (org-id-store-link): Autoload. + + * org.el ("org-id"): Autoload `org-id-store-link'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-html-should-inline-p): Only inline images if + they should be. + +2010-11-11 Eric S Fraga <e.fraga@ucl.ac.uk> + + * org-icalendar.el (org-icalendar-alarm-time): New option. + + * org-icalendar.el (org-print-icalendar-entries): Timed events are + exported with alarm events, a.k.a. reminders. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-target-buffer): Throw an error if we + have no target file. + (org-capture-select-template): Use a default template if the user + has not specified any. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-modules): Add entry for org-velocity. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * ob-lob.el (org-babel-lob-execute): Changing indentation to + improve line length. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-handle-table-metalines): Choose a better + position for checking protectedness. + +2010-11-11 Eric Schulte <schulte.eric@gmail.com> + + * org-table.el (org-table-convert-region): Don't continue csv + importation which the point catches the end, this fixes an + infinite loop which was caused by the (point) never catching up + with the "end" marker. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-string-nw-p): New function. + + * org-capture.el (org-capture-import-remember-templates): + Interpret an empty string as request to use + `org-default-notes-file'. + (org-capture-target-buffer): If the FILE is not a (non-empty) + string, use `org-default-notes-file'. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Fix customize type. + +2010-11-11 Carsten Dominik <carsten.dominik@gmail.com> + + * org-colview-xemacs.el (org-columns-compile-map): + (org-columns-number-to-string): + (org-columns-string-to-number): Handle estimate ranges. + (org-estimate-mean-and-var): New function. + (org-estimate-combine): New function. + (org-estimate-print): New function. + (org-string-to-estimate): New function. + 2010-09-25 Juanma Barranquero <lekktu@gmail.com> * org.el (org-refile-targets):
--- a/lisp/org/ob-C.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-C.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -33,7 +33,6 @@ ;;; Code: (require 'ob) (require 'ob-eval) -(require 'org) (require 'cc-mode) (declare-function org-entry-get "org" @@ -65,31 +64,30 @@ called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) -(defun org-babel-expand-body:c++ (body params &optional processed-params) +(defun org-babel-expand-body:c++ (body params) "Expand a block of C++ code with org-babel according to it's header arguments (calls `org-babel-C-expand')." - (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params processed-params))) + (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) (defun org-babel-execute:C (body params) "Execute a block of C code with org-babel. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) -(defun org-babel-expand-body:c (body params &optional processed-params) +(defun org-babel-expand-body:c (body params) "Expand a block of C code with org-babel according to it's header arguments (calls `org-babel-C-expand')." - (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params processed-params))) + (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params))) (defun org-babel-C-execute (body params) "This function should only be called by `org-babel-execute:C' or `org-babel-execute:c++'." - (let* ((processed-params (org-babel-process-params params)) - (tmp-src-file (make-temp-file "org-babel-C-src" nil - (cond - ((equal org-babel-c-variant 'c) ".c") - ((equal org-babel-c-variant 'cpp) ".cpp")))) - (tmp-bin-file (make-temp-file "org-babel-C-bin")) - (tmp-out-file (make-temp-file "org-babel-C-out")) + (let* ((tmp-src-file (org-babel-temp-file + "C-src-" + (cond + ((equal org-babel-c-variant 'c) ".c") + ((equal org-babel-c-variant 'cpp) ".cpp")))) + (tmp-bin-file (org-babel-temp-file "C-bin-")) (cmdline (cdr (assoc :cmdline params))) (flags (cdr (assoc :flags params))) (full-body (org-babel-C-expand body params)) @@ -101,37 +99,35 @@ (cond ((equal org-babel-c-variant 'c) org-babel-C-compiler) ((equal org-babel-c-variant 'cpp) org-babel-c++-compiler)) - tmp-bin-file + (org-babel-process-file-name tmp-bin-file) (mapconcat 'identity (if (listp flags) flags (list flags)) " ") - tmp-src-file) "")))) + (org-babel-process-file-name tmp-src-file)) "")))) ((lambda (results) (org-babel-reassemble-table - (if (member "vector" (nth 2 processed-params)) - (let ((tmp-file (make-temp-file "ob-c"))) + (if (member "vector" (cdr (assoc :result-params params))) + (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file)) (org-babel-read results)) (org-babel-pick-name - (nth 4 processed-params) (cdr (assoc :colnames params))) + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name - (nth 5 processed-params) (cdr (assoc :rownames params))))) + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) (org-babel-trim (org-babel-eval (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) -(defun org-babel-C-expand (body params &optional processed-params) +(defun org-babel-C-expand (body params) "Expand a block of C or C++ code with org-babel according to it's header arguments." - (let ((vars (nth 1 (or processed-params - (org-babel-process-params params)))) + (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) (main-p (not (string= (cdr (assoc :main params)) "no"))) (includes (or (cdr (assoc :includes params)) (org-babel-read (org-entry-get nil "includes" t)))) (defines (org-babel-read (or (cdr (assoc :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) - (org-babel-trim (mapconcat 'identity (list ;; includes @@ -147,11 +143,11 @@ ;; body (if main-p (org-babel-C-ensure-main-wrap body) - body) "\n") "\n")))) + body) "\n") "\n"))) (defun org-babel-C-ensure-main-wrap (body) "Wrap body in a \"main\" function call if none exists." - (if (string-match "^[ \t]*[intvod]+[ \t]*main[ \t]*(.*)" body) + (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body) body (format "int main() {\n%s\n}\n" body)))
--- a/lisp/org/ob-R.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-R.el Wed Nov 17 13:09:08 2010 +0900 @@ -2,10 +2,11 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte, Dan Davison +;; Author: Eric Schulte +;; Dan Davison ;; Keywords: literate programming, reproducible research, R, statistics ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -36,6 +37,9 @@ (declare-function orgtbl-to-tsv "org-table" (table params)) (declare-function R "ext:essd-r" (&optional start-args)) (declare-function inferior-ess-send-input "ext:ess-inf" ()) +(declare-function ess-make-buffer-current "ext:ess-inf" ()) +(declare-function ess-eval-buffer "ext:ess-inf" (vis)) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) (defconst org-babel-header-arg-names:R '(width height bg units pointsize antialias quality compression @@ -48,21 +52,11 @@ (defvar org-babel-R-command "R --slave --no-save" "Name of command to use for executing R code.") -(defun org-babel-expand-body:R (body params &optional processed-params) +(defun org-babel-expand-body:R (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((processed-params (or processed-params - (org-babel-process-params params))) - (vars (mapcar - (lambda (i) - (cons (car (nth i (nth 1 processed-params))) - (org-babel-reassemble-table - (cdr (nth i (nth 1 processed-params))) - (cdr (nth i (nth 4 processed-params))) - (cdr (nth i (nth 5 processed-params)))))) - (number-sequence 0 (1- (length (nth 1 processed-params)))))) - (out-file (cdr (assoc :file params)))) - (mapconcat ;; define any variables - #'org-babel-trim + (let ((out-file (cdr (assoc :file params)))) + (mapconcat + #'identity ((lambda (inside) (if out-file (append @@ -70,49 +64,36 @@ inside (list "dev.off()")) inside)) - (append - (mapcar - (lambda (pair) - (org-babel-R-assign-elisp - (car pair) (cdr pair) - (equal "yes" (cdr (assoc :colnames params))) - (equal "yes" (cdr (assoc :rownames params))))) - vars) - (list body))) "\n"))) + (append (org-babel-variable-assignments:R params) + (list body))) "\n"))) (defun org-babel-execute:R (body params) "Execute a block of R code. This function is called by `org-babel-execute-src-block'." (save-excursion - (let* ((processed-params (org-babel-process-params params)) - (result-type (nth 3 processed-params)) + (let* ((result-type (cdr (assoc :result-type params))) (session (org-babel-R-initiate-session - (first processed-params) params)) + (cdr (assoc :session params)) params)) (colnames-p (cdr (assoc :colnames params))) (rownames-p (cdr (assoc :rownames params))) (out-file (cdr (assoc :file params))) - (full-body (org-babel-expand-body:R body params processed-params)) + (full-body (org-babel-expand-body:R body params)) (result (org-babel-R-evaluate session full-body result-type (or (equal "yes" colnames-p) - (org-babel-pick-name (nth 4 processed-params) colnames-p)) + (org-babel-pick-name + (cdr (assoc :colname-names params)) colnames-p)) (or (equal "yes" rownames-p) - (org-babel-pick-name (nth 5 processed-params) rownames-p))))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) rownames-p))))) (message "result is %S" result) (or out-file result)))) (defun org-babel-prep-session:R (session params) "Prepare SESSION according to the header arguments specified in PARAMS." (let* ((session (org-babel-R-initiate-session session params)) - (vars (org-babel-ref-variables params)) - (var-lines - (mapcar - (lambda (pair) (org-babel-R-assign-elisp - (car pair) (cdr pair) - (equal (cdr (assoc :colnames params)) "yes") - (equal (cdr (assoc :rownames params)) "yes"))) - vars))) + (var-lines (org-babel-variable-assignments:R params))) (org-babel-comint-in-buffer session (mapc (lambda (var) (end-of-line 1) (insert var) (comint-send-input nil t) @@ -130,6 +111,24 @@ ;; helper functions +(defun org-babel-variable-assignments:R (params) + "Return list of R statements assigning the block's variables" + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapcar + (lambda (pair) + (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal "yes" (cdr (assoc :colnames params))) + (equal "yes" (cdr (assoc :rownames params))))) + (mapcar + (lambda (i) + (cons (car (nth i vars)) + (org-babel-reassemble-table + (cdr (nth i vars)) + (cdr (nth i (cdr (assoc :colname-names params)))) + (cdr (nth i (cdr (assoc :rowname-names params))))))) + (org-number-sequence 0 (1- (length vars))))))) + (defun org-babel-R-quote-tsv-field (s) "Quote field S for export to R." (if (stringp s) @@ -139,23 +138,25 @@ (defun org-babel-R-assign-elisp (name value colnames-p rownames-p) "Construct R code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let ((transition-file (make-temp-file "org-babel-R-import"))) + (let ((transition-file (org-babel-temp-file "R-import-"))) ;; ensure VALUE has an orgtbl structure (depth of at least 2) (unless (listp (car value)) (setq value (list value))) - (with-temp-file (org-babel-maybe-remote-file transition-file) + (with-temp-file transition-file (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))) (insert "\n")) (format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)" - name transition-file + name (org-babel-process-file-name transition-file 'noquote) (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE") (if rownames-p "1" "NULL"))) (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) +(defvar ess-ask-for-ess-directory nil) (defun org-babel-R-initiate-session (session params) "If there is not a current R process then create one." (unless (string= session "none") (let ((session (or session "*R*")) - (ess-ask-for-ess-directory (not (cdr (assoc :dir params))))) + (ess-ask-for-ess-directory + (and ess-ask-for-ess-directory (not (cdr (assoc :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion @@ -168,6 +169,15 @@ (buffer-name)))) (current-buffer)))))) +(defvar ess-local-process-name nil) +(defun org-babel-R-associate-session (session) + "Associate R code buffer with an R session. +Make SESSION be the inferior ESS process associated with the +current code buffer." + (setq ess-local-process-name + (process-name (get-buffer-process session))) + (ess-make-buffer-current)) + (defun org-babel-R-construct-graphics-device-call (out-file params) "Construct the call to the graphics device." (let ((devices @@ -205,65 +215,78 @@ (defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") (defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") -(defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n} -write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") -(defvar org-babel-R-wrapper-lastvar "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") +(defvar org-babel-R-write-object-command "{function(object, transfer.file) {invisible(if(inherits(try(write.table(object, file=transfer.file, sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE), silent=TRUE),\"try-error\")) {if(!file.exists(transfer.file)) file.create(transfer.file)})}}(object=%s, transfer.file=\"%s\")") (defun org-babel-R-evaluate (session body result-type column-names-p row-names-p) - "Pass BODY to the R process in SESSION. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY, as elisp." - (if (not session) - ;; external process evaluation - (case result-type - (output (org-babel-eval org-babel-R-command body)) - (value - (let ((tmp-file (make-temp-file "org-babel-R-results-"))) - (org-babel-eval org-babel-R-command - (format org-babel-R-wrapper-method - body tmp-file - (if row-names-p "TRUE" "FALSE") - (if column-names-p - (if row-names-p "NA" "TRUE") - "FALSE"))) - (org-babel-R-process-value-result - (org-babel-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file)) column-names-p)))) - ;; comint session evaluation - (case result-type - (value - (let ((tmp-file (make-temp-file "org-babel-R")) - broke) - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat - #'org-babel-chomp - (list - body - (format org-babel-R-wrapper-lastvar - tmp-file - (if row-names-p "TRUE" "FALSE") - (if column-names-p - (if row-names-p "NA" "TRUE") - "FALSE")) - org-babel-R-eoe-indicator) "\n")) - (inferior-ess-send-input)) - (org-babel-R-process-value-result - (org-babel-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file)) column-names-p))) - (output - (mapconcat - #'org-babel-chomp - (butlast - (delq nil - (mapcar - #'identity - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat #'org-babel-chomp - (list body org-babel-R-eoe-indicator) - "\n")) - (inferior-ess-send-input)))) 2) "\n"))))) + "Evaluate R code in BODY." + (if session + (org-babel-R-evaluate-session + session body result-type column-names-p row-names-p) + (org-babel-R-evaluate-external-process + body result-type column-names-p row-names-p))) + +(defun org-babel-R-evaluate-external-process + (body result-type column-names-p row-names-p) + "Evaluate BODY in external R process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (let ((tmp-file (org-babel-temp-file "R-"))) + (org-babel-eval org-babel-R-command + (format org-babel-R-write-object-command + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE") + (format "{function ()\n{\n%s\n}}()" body) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p))) + (output (org-babel-eval org-babel-R-command body)))) + +(defun org-babel-R-evaluate-session + (session body result-type column-names-p row-names-p) + "Evaluate BODY in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (with-temp-buffer + (insert (org-babel-chomp body)) + (let ((ess-local-process-name + (process-name (get-buffer-process session)))) + (ess-eval-buffer nil))) + (let ((tmp-file (org-babel-temp-file "R-"))) + (org-babel-comint-eval-invisibly-and-wait-for-file + session tmp-file + (format org-babel-R-write-object-command + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE") + ".Last.value" (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + (lambda (line) ;; cleanup extra prompts left in output + (if (string-match + "^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) + (substring line (match-end 1)) + line)) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-R-eoe-indicator) + "\n")) + (inferior-ess-send-input)))) 2) "\n")))) (defun org-babel-R-process-value-result (result column-names-p) "R-specific processing of return value.
--- a/lisp/org/ob-asymptote.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-asymptote.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -55,32 +55,30 @@ '((:results . "file") (:exports . "results")) "Default arguments when evaluating an Asymptote source block.") -(defun org-babel-expand-body:asymptote (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (nth 1 (or processed-params - (org-babel-process-params params))))) - (concat (mapconcat 'org-babel-asymptote-var-to-asymptote vars "\n") - "\n" body "\n"))) - (defun org-babel-execute:asymptote (body params) "Execute a block of Asymptote code. This function is called by `org-babel-execute-src-block'." - (let* ((processed-params (org-babel-process-params params)) - (result-params (split-string (or (cdr (assoc :results params)) ""))) + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (out-file (cdr (assoc :file params))) (format (or (and out-file (string-match ".+\\.\\(.+\\)" out-file) (match-string 1 out-file)) "pdf")) (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-asymptote")) - (cmd (concat "asy " - (if out-file - (concat "-globalwrite -f " format " -o " out-file) - "-V") - " " cmdline " " in-file))) + (in-file (org-babel-temp-file "asymptote-")) + (cmd + (concat "asy " + (if out-file + (concat + "-globalwrite -f " format + " -o " (org-babel-process-file-name out-file)) + "-V") + " " cmdline + " " (org-babel-process-file-name in-file)))) (with-temp-file in-file - (insert (org-babel-expand-body:asymptote body params processed-params))) + (insert (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:asymptote params)))) (message cmd) (shell-command cmd) out-file)) @@ -89,6 +87,11 @@ Asymptote does not support sessions" (error "Asymptote does not support sessions")) +(defun org-babel-variable-assignments:asymptote (params) + "Return list of asymptote statements assigning the block's variables" + (mapcar #'org-babel-asymptote-var-to-asymptote + (mapcar #'cdr (org-babel-get-header params :var)))) + (defun org-babel-asymptote-var-to-asymptote (pair) "Convert an elisp value into an Asymptote variable. The elisp value PAIR is converted into Asymptote code specifying
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/org/ob-calc.el Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,67 @@ +;;; ob-calc.el --- org-babel functions for calc code evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating calc code + +;;; Code: +(require 'ob) +(require 'calc) +(require 'calc-trail) +(eval-when-compile (require 'ob-comint)) + +(defvar org-babel-default-header-args:calc nil + "Default arguments for evaluating an calc source block.") + +(defun org-babel-expand-body:calc (body params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:calc (body params) + "Execute a block of calc code with Babel." + (mapcar + (lambda (line) + (when (> (length line) 0) + (if (string= "'" (substring line 0 1)) + (funcall (lookup-key calc-mode-map (substring line 1)) nil) + (calc-push-list + (list ((lambda (res) + (cond + ((numberp res) res) + ((listp res) (error "calc error \"%s\" on input \"%s\"" + (cadr res) line)) + (t res)) + (if (numberp res) res (math-read-number res))) + (calc-eval line))))))) + (mapcar #'org-babel-trim + (split-string (org-babel-expand-body:calc body params) "[\n\r]"))) + (save-excursion + (set-buffer (get-buffer "*Calculator*")) + (calc-eval (calc-top 1)))) + +(provide 'ob-calc) + +;; arch-tag: 5c57a3b7-5818-4c6c-acda-7a94831a6449 + +;;; ob-calc.el ends here
--- a/lisp/org/ob-clojure.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-clojure.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Joel Boehland ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -45,7 +45,6 @@ (declare-function slime-eval-async "ext:slime" (sexp &optional cont package)) (declare-function slime-eval "ext:slime" (sexp &optional package)) (declare-function swank-clojure-concat-paths "ext:slime" (paths)) -(declare-function org-babel-ref-variables "ext:slime" (params)) (declare-function slime "ext:slime" (&optional command coding-system)) (declare-function slime-output-buffer "ext:slime" (&optional noprompt)) (declare-function slime-filter-buffers "ext:slime" (predicate)) @@ -92,28 +91,28 @@ (defvar swank-clojure-extra-classpaths) (defun org-babel-clojure-babel-clojure-cmd () "Create the command to start clojure according to current settings." - (if (and (not swank-clojure-binary) (not swank-clojure-classpath)) + (or (when swank-clojure-binary + (if (listp swank-clojure-binary) + swank-clojure-binary + (list swank-clojure-binary))) + (when swank-clojure-classpath + (delq + nil + (append + (list swank-clojure-java-path) + swank-clojure-extra-vm-args + (list + (when swank-clojure-library-paths + (concat "-Djava.library.path=" + (swank-clojure-concat-paths swank-clojure-library-paths))) + "-classpath" + (swank-clojure-concat-paths + (append + swank-clojure-classpath + swank-clojure-extra-classpaths)) + "clojure.main")))) (error "%s" (concat "You must specifiy either a `swank-clojure-binary' " - "or a `swank-clojure-jar-path'")) - (if swank-clojure-binary - (if (listp swank-clojure-binary) - swank-clojure-binary - (list swank-clojure-binary)) - (delq - nil - (append - (list swank-clojure-java-path) - swank-clojure-extra-vm-args - (list - (when swank-clojure-library-paths - (concat "-Djava.library.path=" - (swank-clojure-concat-paths swank-clojure-library-paths))) - "-classpath" - (swank-clojure-concat-paths - (append - swank-clojure-classpath - swank-clojure-extra-classpaths)) - "clojure.main")))))) + "or a `swank-clojure-classpath'")))) (defun org-babel-clojure-table-or-string (results) "Convert RESULTS to an elisp value. @@ -155,7 +154,7 @@ "Prepare SESSION according to the header arguments specified in PARAMS." (require 'slime) (require 'swank-clojure) (let* ((session-buf (org-babel-clojure-initiate-session session)) - (vars (org-babel-ref-variables params)) + (vars (mapcar #'cdr (org-babel-get-header params :var))) (var-lines (mapcar ;; define any top level session variables (lambda (pair) (format "(def %s %s)\n" (car pair) @@ -261,9 +260,13 @@ " ")))) (case result-type (output (org-babel-eval cmd body)) - (value (let* ((tmp-file (make-temp-file "org-babel-clojure-results-"))) - (org-babel-eval cmd (format org-babel-clojure-wrapper-method - body tmp-file tmp-file)) + (value (let* ((tmp-file (org-babel-temp-file "clojure-"))) + (org-babel-eval + cmd + (format + org-babel-clojure-wrapper-method + body + (org-babel-process-file-name tmp-file 'noquote))) (org-babel-clojure-table-or-string (org-babel-eval-read-file tmp-file))))))) @@ -290,24 +293,23 @@ (org-babel-clojure-evaluate-session buffer body result-type) (org-babel-clojure-evaluate-external-process buffer body result-type))) -(defun org-babel-expand-body:clojure (body params &optional processed-params) +(defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." (org-babel-clojure-build-full-form - body (nth 1 (or processed-params (org-babel-process-params params))))) + body (mapcar #'cdr (org-babel-get-header params :var)))) (defun org-babel-execute:clojure (body params) "Execute a block of Clojure code." (require 'slime) (require 'swank-clojure) - (let* ((processed-params (org-babel-process-params params)) - (body (org-babel-expand-body:clojure body params processed-params)) + (let* ((body (org-babel-expand-body:clojure body params)) (session (org-babel-clojure-initiate-session - (first processed-params)))) + (cdr (assoc :session params))))) (org-babel-reassemble-table - (org-babel-clojure-evaluate session body (nth 3 processed-params)) + (org-babel-clojure-evaluate session body (cdr (assoc :result-type params))) (org-babel-pick-name - (nth 4 processed-params) (cdr (assoc :colnames params))) + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name - (nth 5 processed-params) (cdr (assoc :rownames params)))))) + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) (provide 'ob-clojure)
--- a/lisp/org/ob-comint.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-comint.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -34,6 +34,8 @@ (require 'ob) (require 'comint) (eval-when-compile (require 'cl)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) +(declare-function tramp-flush-directory-property "tramp" (vec directory)) (defun org-babel-comint-buffer-livep (buffer) "Check if BUFFER is a comint buffer with a live process." @@ -43,7 +45,7 @@ (defmacro org-babel-comint-in-buffer (buffer &rest body) "Check BUFFER and execute BODY. BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is -executed inside the protection of `save-window-excursion' and +executed inside the protection of `save-excursion' and `save-match-data'." (declare (indent 1)) `(save-excursion @@ -136,6 +138,24 @@ "comint-highlight-prompt")))) (accept-process-output (get-buffer-process buffer))))) +(defun org-babel-comint-eval-invisibly-and-wait-for-file + (buffer file string &optional period) + "Evaluate STRING in BUFFER invisibly. +Don't return until FILE exists. Code in STRING must ensure that +FILE exists at end of evaluation." + (unless (org-babel-comint-buffer-livep buffer) + (error "buffer %s doesn't exist or has no process" buffer)) + (if (file-exists-p file) (delete-file file)) + (process-send-string + (get-buffer-process buffer) + (if (string-match "\n$" string) string (concat string "\n"))) + ;; From Tramp 2.1.19 the following cache flush is not necessary + (if (file-remote-p default-directory) + (let (v) + (with-parsed-tramp-file-name default-directory nil + (tramp-flush-directory-property v "")))) + (while (not (file-exists-p file)) (sit-for (or period 0.25)))) + (provide 'ob-comint) ;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889
--- a/lisp/org/ob-css.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-css.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -32,9 +32,6 @@ (defvar org-babel-default-header-args:css '()) -(defun org-babel-expand-body:css (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." body) - (defun org-babel-execute:css (body params) "Execute a block of CSS code. This function is called by `org-babel-execute-src-block'."
--- a/lisp/org/ob-ditaa.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-ditaa.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -43,22 +43,24 @@ '((:results . "file") (:exports . "results")) "Default arguments for evaluating a ditaa source block.") -(defun org-babel-expand-body:ditaa (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." body) - (defvar org-ditaa-jar-path) (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) - (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-ditaa"))) + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "ditaa-")) + (cmd (concat "java -jar " + (shell-quote-argument + (expand-file-name org-ditaa-jar-path)) + " " cmdline + " " (org-babel-process-file-name in-file) + " " (org-babel-process-file-name out-file)))) (unless (file-exists-p org-ditaa-jar-path) (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (with-temp-file in-file (insert body)) - (message (concat "java -jar " org-ditaa-jar-path " " cmdline " " in-file " " out-file)) - (shell-command (concat "java -jar " (shell-quote-argument org-ditaa-jar-path) " " cmdline " " in-file " " out-file)) + (message cmd) (shell-command cmd) out-file)) (defun org-babel-prep-session:ditaa (session params)
--- a/lisp/org/ob-dot.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-dot.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -46,10 +46,9 @@ '((:results . "file") (:exports . "results")) "Default arguments to use when evaluating a dot source block.") -(defun org-babel-expand-body:dot (body params &optional processed-params) +(defun org-babel-expand-body:dot (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (nth 1 (or processed-params - (org-babel-process-params params))))) + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -65,15 +64,19 @@ (defun org-babel-execute:dot (body params) "Execute a block of Dot code with org-babel. This function is called by `org-babel-execute-src-block'." - (let ((processed-params (org-babel-process-params params)) - (result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) - (cmdline (cdr (assoc :cmdline params))) - (cmd (or (cdr (assoc :cmd params)) "dot")) - (in-file (make-temp-file "org-babel-dot"))) + (let* ((result-params (cdr (assoc :result-params params))) + (out-file (cdr (assoc :file params))) + (cmdline (or (cdr (assoc :cmdline params)) + (format "-T%s" (file-name-extension out-file)))) + (cmd (or (cdr (assoc :cmd params)) "dot")) + (in-file (org-babel-temp-file "dot-"))) (with-temp-file in-file - (insert (org-babel-expand-body:dot body params processed-params))) - (org-babel-eval (concat cmd " " in-file " " cmdline " -o " out-file) "") + (insert (org-babel-expand-body:dot body params))) + (org-babel-eval + (concat cmd + " " (org-babel-process-file-name in-file) + " " cmdline + " -o " (org-babel-process-file-name out-file)) "") out-file)) (defun org-babel-prep-session:dot (session params)
--- a/lisp/org/ob-emacs-lisp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-emacs-lisp.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,11 +1,11 @@ ;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -36,16 +36,16 @@ (declare-function orgtbl-to-generic "org-table" (table params)) -(defun org-babel-expand-body:emacs-lisp (body params &optional processed-params) +(defun org-babel-expand-body:emacs-lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((processed-params (or processed-params (org-babel-process-params params))) - (vars (nth 1 processed-params)) - (result-params (nth 2 processed-params)) + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) (print-level nil) (print-length nil) (body (if (> (length vars) 0) (concat "(let (" (mapconcat - (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + (lambda (var) + (format "%S" (print `(,(car var) ',(cdr var))))) vars "\n ") ")\n" body ")") body))) @@ -56,13 +56,13 @@ (defun org-babel-execute:emacs-lisp (body params) "Execute a block of emacs-lisp code with Babel." (save-window-excursion - (let ((processed-params (org-babel-process-params params))) - (org-babel-reassemble-table - (eval (read (format "(progn %s)" - (org-babel-expand-body:emacs-lisp - body params processed-params)))) - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + (org-babel-reassemble-table + (eval (read (format "(progn %s)" + (org-babel-expand-body:emacs-lisp body params)))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))) (provide 'ob-emacs-lisp)
--- a/lisp/org/ob-eval.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-eval.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,11 +1,11 @@ -;;; ob-run.el --- org-babel functions for external code evaluation +;;; ob-eval.el --- org-babel functions for external code evaluation ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -42,7 +42,7 @@ (defun org-babel-eval (cmd body) "Run CMD on BODY. -If CMD succeeds then return it's results, otherwise display +If CMD succeeds then return its results, otherwise display STDERR with `org-babel-eval-error-notify'." (let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code) (with-current-buffer err-buff (erase-buffer)) @@ -60,8 +60,7 @@ (defun org-babel-eval-read-file (file) "Return the contents of FILE as a string." - (with-temp-buffer (insert-file-contents - (org-babel-maybe-remote-file file)) + (with-temp-buffer (insert-file-contents file) (buffer-string))) (defun org-babel-shell-command-on-region (start end command @@ -252,4 +251,4 @@ ;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d -;;; ob-comint.el ends here +;;; ob-eval.el ends here
--- a/lisp/org/ob-exp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-exp.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte, Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -49,7 +49,7 @@ (defcustom org-export-babel-evaluate t "Switch controlling code evaluation during export. -When set to nil no code will be exported as part of the export +When set to nil no code will be evaluated as part of the export process." :group 'org-babel :type 'boolean) @@ -77,6 +77,30 @@ `org-babel-function-def-export-name' for the definition of a source block function.") +(defmacro org-babel-exp-in-export-file (&rest body) + `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" lang))) + (heading (nth 4 (ignore-errors (org-heading-components)))) + (link (when org-current-export-file + (org-make-link-string + (if heading + (concat org-current-export-file "::" heading) + org-current-export-file)))) + (export-buffer (current-buffer)) results) + (when link + ;; resolve parameters in the original file so that + ;; headline and file-wide parameters are included, attempt + ;; to go to the same heading in the original file + (set-buffer (get-file-buffer org-current-export-file)) + (save-restriction + (condition-case nil + (org-open-link-from-string link) + (error (when heading + (goto-char (point-min)) + (re-search-forward (regexp-quote heading) nil t)))) + (setq results ,@body)) + (set-buffer export-buffer) + results))) + (defun org-babel-exp-src-blocks (body &rest headers) "Process source block for export. Depending on the 'export' headers argument in replace the source @@ -95,18 +119,27 @@ (message "org-babel-exp processing...") (save-excursion (goto-char (match-beginning 0)) - (let* ((info (org-babel-get-src-block-info)) - (params (nth 2 info))) + (let* ((info (org-babel-get-src-block-info 'light)) + (lang (nth 0 info)) + (raw-params (nth 2 info))) ;; bail if we couldn't get any info from the block (when info + (org-babel-exp-in-export-file + (setf (nth 2 info) + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + raw-params))) ;; expand noweb references in the original file (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) + (if (and (cdr (assoc :noweb (nth 2 info))) + (string= "yes" (cdr (assoc :noweb (nth 2 info))))) (org-babel-expand-noweb-references info (get-file-buffer org-current-export-file)) - (nth 1 info)))) - (org-babel-exp-do-export info 'block)))) + (nth 1 info))) + (org-babel-exp-do-export info 'block))))) (defun org-babel-exp-inline-src-blocks (start end) "Process inline source blocks between START and END for export. @@ -178,6 +211,8 @@ (list "emacs-lisp" "results" (org-babel-merge-params org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties) (org-babel-parse-header-arguments (org-babel-clean-text-properties (concat ":var results=" @@ -193,8 +228,7 @@ The function respects the value of the :exports header argument." (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info))))) (when (and session - (not (equal "none" session)) - (not (assoc :noeval (nth 2 info)))) + (not (equal "none" session))) (org-babel-exp-results info type 'silent)))) (clean () (org-babel-remove-result info))) (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) @@ -208,16 +242,14 @@ (defvar backend) (defun org-babel-exp-code (info type) "Prepare and return code in the current code block for export. -Code is prepared in a manner suitable for exportat by +Code is prepared in a manner suitable for export by org-mode. This function is called by `org-babel-exp-do-export'. The code block is not evaluated." (let ((lang (nth 0 info)) (body (nth 1 info)) (switches (nth 3 info)) (name (nth 4 info)) - (args (mapcar - #'cdr - (org-remove-if-not (lambda (el) (eq :var (car el))) (nth 2 info))))) + (args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var)))) (case type ('inline (format "=%s=" body)) ('block @@ -249,62 +281,45 @@ This function is called by `org-babel-exp-do-export'. The code block will be evaluated. Optional argument SILENT can be used to inhibit insertion of results into the buffer." - (if org-export-babel-evaluate - (let ((lang (nth 0 info)) - (body (nth 1 info)) - (params - ;; lets ensure that we lookup references in the original file - (mapcar - (lambda (pair) - (if (and org-current-export-file - (eq (car pair) :var) - (string-match org-babel-ref-split-regexp (cdr pair)) - (equal :ob-must-be-reference - (org-babel-ref-literal - (match-string 2 (cdr pair))))) - `(:var . ,(concat (match-string 1 (cdr pair)) - "=" org-current-export-file - ":" (match-string 2 (cdr pair)))) - pair)) - (nth 2 info)))) - ;; skip code blocks which we can't evaluate - (if (fboundp (intern (concat "org-babel-execute:" lang))) - (case type - ('inline - (let ((raw (org-babel-execute-src-block - nil info '((:results . "silent")))) - (result-params (split-string - (cdr (assoc :results params))))) - (unless silent - (cond ;; respect the value of the :results header argument - ((member "file" result-params) - (org-babel-result-to-file raw)) - ((or (member "raw" result-params) - (member "org" result-params)) - (format "%s" raw)) - ((member "code" result-params) - (format "src_%s{%s}" lang raw)) - (t - (if (stringp raw) - (if (= 0 (length raw)) "=(no results)=" - (format "%s" raw)) - (format "%S" raw))))))) - ('block - (org-babel-execute-src-block - nil info (org-babel-merge-params - params - `((:results . ,(if silent "silent" "replace"))))) - "") - ('lob + (or + (when org-export-babel-evaluate + (let ((lang (nth 0 info)) + (body (nth 1 info))) + (setf (nth 2 info) (org-babel-exp-in-export-file + (org-babel-process-params (nth 2 info)))) + ;; skip code blocks which we can't evaluate + (when (fboundp (intern (concat "org-babel-execute:" lang))) + (if (equal type 'inline) + (let ((raw (org-babel-execute-src-block + nil info '((:results . "silent")))) + (result-params (split-string + (cdr (assoc :results (nth 2 info)))))) + (unless silent + (cond ;; respect the value of the :results header argument + ((member "file" result-params) + (org-babel-result-to-file raw)) + ((or (member "raw" result-params) + (member "org" result-params)) + (format "%s" raw)) + ((member "code" result-params) + (format "src_%s{%s}" lang raw)) + (t + (if (stringp raw) + (if (= 0 (length raw)) "=(no results)=" + (format "%s" raw)) + (format "%S" raw)))))) + (prog1 nil + (setf (nth 2 info) + (org-babel-merge-params + (nth 2 info) + `((:results . ,(if silent "silent" "replace"))))) + (cond + ((equal type 'block) (org-babel-execute-src-block nil info)) + ((equal type 'lob) (save-excursion (re-search-backward org-babel-lob-one-liner-regexp nil t) - (org-babel-execute-src-block - nil info (org-babel-merge-params - params - `((:results . ,(if silent "silent" "replace"))))) - ""))) - "")) - "")) + (org-babel-execute-src-block nil info))))))))) + "")) (provide 'ob-exp)
--- a/lisp/org/ob-gnuplot.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-gnuplot.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -68,11 +68,11 @@ (car pair) ;; variable name (if (listp (cdr pair)) ;; variable value (org-babel-gnuplot-table-to-data - (cdr pair) (make-temp-file "org-babel-gnuplot") params) + (cdr pair) (org-babel-temp-file "gnuplot-") params) (cdr pair)))) - (org-babel-ref-variables params))) + (mapcar #'cdr (org-babel-get-header params :var)))) -(defun org-babel-expand-body:gnuplot (body params &optional processed-params) +(defun org-babel-expand-body:gnuplot (body params) "Expand BODY according to PARAMS, return the expanded body." (save-window-excursion (let* ((vars (org-babel-gnuplot-process-vars params)) @@ -118,9 +118,9 @@ ;; insert variables into code body: this should happen last ;; placing the variables at the *top* of the code in case their ;; values are used later - (add-to-body (mapconcat - (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) - vars "\n")) + (add-to-body (mapconcat #'identity + (org-babel-variable-assignments:gnuplot params) + "\n")) ;; replace any variable names preceded by '$' with the actual ;; value of the variable (mapc (lambda (pair) @@ -141,12 +141,15 @@ (save-window-excursion ;; evaluate the code body with gnuplot (if (string= session "none") - (let ((script-file (make-temp-file "org-babel-gnuplot-script"))) + (let ((script-file (org-babel-temp-file "gnuplot-script-"))) (with-temp-file script-file (insert (concat body "\n"))) (message "gnuplot \"%s\"" script-file) (setq output - (shell-command-to-string (format "gnuplot \"%s\"" script-file))) + (shell-command-to-string + (format + "gnuplot \"%s\"" + (org-babel-process-file-name script-file)))) (message output)) (with-temp-buffer (insert (concat body "\n")) @@ -159,10 +162,7 @@ (defun org-babel-prep-session:gnuplot (session params) "Prepare SESSION according to the header arguments in PARAMS." (let* ((session (org-babel-gnuplot-initiate-session session)) - (vars (org-babel-ref-variables params)) - (var-lines (mapcar - (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) - vars))) + (var-lines (org-babel-variable-assignments:gnuplot params))) (message "%S" session) (org-babel-comint-in-buffer session (mapc (lambda (var-line) @@ -180,6 +180,12 @@ (insert (org-babel-chomp body))) buffer))) +(defun org-babel-variable-assignments:gnuplot (params) + "Return list of gnuplot statements assigning the block's variables" + (mapcar + (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) + (org-babel-gnuplot-process-vars params))) + (defvar gnuplot-buffer) (defun org-babel-gnuplot-initiate-session (&optional session params) "Initiate a gnuplot session.
--- a/lisp/org/ob-haskell.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-haskell.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -59,23 +59,14 @@ (defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") -(defun org-babel-expand-body:haskell (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) - (concat - (mapconcat - (lambda (pair) (format "let %s = %s" - (car pair) - (org-babel-haskell-var-to-haskell (cdr pair)))) - vars "\n") "\n" body "\n"))) - (defun org-babel-execute:haskell (body params) "Execute a block of Haskell code." - (let* ((processed-params (org-babel-process-params params)) - (session (nth 0 processed-params)) - (vars (nth 1 processed-params)) - (result-type (nth 3 processed-params)) - (full-body (org-babel-expand-body:haskell body params processed-params)) + (let* ((session (cdr (assoc :session params))) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:haskell params))) (session (org-babel-haskell-initiate-session session params)) (raw (org-babel-comint-with-output (session org-babel-haskell-eoe t full-body) @@ -93,8 +84,10 @@ (mapconcat #'identity (reverse (cdr results)) "\n")) ((equal result-type 'value) (org-babel-haskell-table-or-string (car results)))) - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colname-names params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rowname-names params)))))) (defun org-babel-haskell-read-string (string) "Strip \\\"s from around a haskell string." @@ -110,34 +103,35 @@ (or (get-buffer "*haskell*") (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) -(defun org-babel-load-session:haskell - (session body params &optional processed-params) +(defun org-babel-load-session:haskell (session body params) "Load BODY into SESSION." (save-window-excursion - (let* ((buffer (org-babel-prep-session:haskell - session params processed-params)) - (load-file (concat (make-temp-file "org-babel-haskell-load") ".hs"))) + (let* ((buffer (org-babel-prep-session:haskell session params)) + (load-file (concat (org-babel-temp-file "haskell-load-") ".hs"))) (with-temp-buffer (insert body) (write-file load-file) (haskell-mode) (inferior-haskell-load-file)) buffer))) -(defun org-babel-prep-session:haskell - (session params &optional processed-params) +(defun org-babel-prep-session:haskell (session params) "Prepare SESSION according to the header arguments in PARAMS." (save-window-excursion - (let ((pp (or processed-params (org-babel-process-params params))) - (buffer (org-babel-haskell-initiate-session session))) + (let ((buffer (org-babel-haskell-initiate-session session))) (org-babel-comint-in-buffer buffer - (mapc - (lambda (pair) - (insert (format "let %s = %s" - (car pair) - (org-babel-haskell-var-to-haskell (cdr pair)))) - (comint-send-input nil t)) - (nth 1 pp))) + (mapc (lambda (line) + (insert line) + (comint-send-input nil t)) + (org-babel-variable-assignments:haskell params))) (current-buffer)))) +(defun org-babel-variable-assignments:haskell (params) + "Return list of haskell statements assigning the block's variables" + (mapcar (lambda (pair) + (format "let %s = %s" + (car pair) + (org-babel-haskell-var-to-haskell (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + (defun org-babel-haskell-table-or-string (results) "Convert RESULTS to an Emacs-lisp table or string. If RESULTS look like a table, then convert them into an @@ -177,12 +171,14 @@ (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]" "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) (base-name (file-name-sans-extension (buffer-file-name))) - (tmp-file (make-temp-file "ob-haskell")) + (tmp-file (org-babel-temp-file "haskell-")) (tmp-org-file (concat tmp-file ".org")) (tmp-tex-file (concat tmp-file ".tex")) (lhs-file (concat base-name ".lhs")) (tex-file (concat base-name ".tex")) - (command (concat org-babel-haskell-lhs2tex-command " " lhs-file " > " tex-file)) + (command (concat org-babel-haskell-lhs2tex-command + " " (org-babel-process-file-name lhs-file) + " > " (org-babel-process-file-name tex-file))) (preserve-indentp org-src-preserve-indentation) indentation) ;; escape haskell source-code blocks
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/org/ob-js.el Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,163 @@ +;;; ob-js.el --- org-babel functions for Javascript + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, js +;; Homepage: http://orgmode.org +;; Version: 7.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; - a non-browser javascript engine such as node.js http://nodejs.org/ +;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; +;; - for session based evaluation mozrepl and moz.el are required see +;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; configuration instructions + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-mozilla "ext:moz" (arg)) + +(defvar org-babel-default-header-args:js '() + "Default header arguments for js code blocks.") + +(defvar org-babel-js-eoe "org-babel-js-eoe" + "String to indicate that evaluation has completed.") + +(defcustom org-babel-js-cmd "node" + "Name of command used to evaluate js blocks." + :group 'org-babel + :type 'string) + +(defvar org-babel-js-function-wrapper + "require('sys').print(require('sys').inspect(function(){%s}()));" + "Javascript code to print value of body.") + +(defun org-babel-execute:js (body params) + "Execute a block of Javascript code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:js params)))) + (org-babel-js-read + (if (not (string= (cdr (assoc :session params)) "none")) + ;; session evaluation + (let ((session (org-babel-prep-session:js + (cdr (assoc :session params)) params))) + (nth 1 + (org-babel-comint-with-output + (session (format "%S" org-babel-js-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body (format "%S" org-babel-js-eoe)))))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "js-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format org-babel-js-function-wrapper full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-js-cmd + (org-babel-process-file-name script-file)) "")))))) + +(defun org-babel-js-read (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-js-var-to-js (var) + "Convert VAR into a js variable. +Convert an elisp value into a string of js source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]") + (format "%S" var))) + +(defun org-babel-prep-session:js (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-js-initiate-session session)) + (var-lines (org-babel-variable-assignments:js params))) + (when session + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines))) + session)) + +(defun org-babel-variable-assignments:js (params) + "Return list of Javascript statements assigning the block's variables" + (mapcar + (lambda (pair) (format "var %s=%s;" + (car pair) (org-babel-js-var-to-js (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-js-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (unless (string= session "none") + (cond + ((string= "mozrepl" org-babel-js-cmd) + (require 'moz) + (let ((session-buffer (save-window-excursion + (run-mozilla nil) + (rename-buffer session) + (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-js-initiate-session session)))) + ((string= "node" org-babel-js-cmd ) + (error "session evaluation with node.js is not supported")) + (t + (error "sessions are only supported with mozrepl add \":cmd mozrepl\""))))) + +(provide 'ob-js) + +;; arch-tag: 84401fb3-b8d9-4bb6-9a90-cbe2d103d494 + +;;; ob-js.el ends here
--- a/lisp/org/ob-keys.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-keys.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -52,12 +52,14 @@ ("\C-p" . org-babel-previous-src-block) ("n" . org-babel-next-src-block) ("\C-n" . org-babel-next-src-block) - ("e" . org-babel-execute-src-block) - ("\C-e" . org-babel-execute-src-block) + ("e" . org-babel-execute-maybe) + ("\C-e" . org-babel-execute-maybe) ("o" . org-babel-open-src-block-result) ("\C-o" . org-babel-open-src-block-result) ("\C-v" . org-babel-expand-src-block) ("v" . org-babel-expand-src-block) + ("u" . org-babel-goto-src-block-head) + ("\C-u" . org-babel-goto-src-block-head) ("g" . org-babel-goto-named-src-block) ("r" . org-babel-goto-named-result) ("\C-r" . org-babel-goto-named-result) @@ -65,17 +67,24 @@ ("b" . org-babel-execute-buffer) ("\C-s" . org-babel-execute-subtree) ("s" . org-babel-execute-subtree) + ("\C-d" . org-babel-demarcate-block) + ("d" . org-babel-demarcate-block) ("\C-t" . org-babel-tangle) ("t" . org-babel-tangle) ("\C-f" . org-babel-tangle-file) ("f" . org-babel-tangle-file) - ("\C-l" . org-babel-lob-ingest) - ("l" . org-babel-lob-ingest) + ("\C-l" . org-babel-load-in-session) + ("l" . org-babel-load-in-session) + ("\C-i" . org-babel-lob-ingest) + ("i" . org-babel-lob-ingest) ("\C-z" . org-babel-switch-to-session) - ("z" . org-babel-switch-to-session) + ("z" . org-babel-switch-to-session-with-code) ("\C-a" . org-babel-sha1-hash) ("a" . org-babel-sha1-hash) - ("h" . org-babel-describe-bindings)) + ("h" . org-babel-describe-bindings) + ("\C-x" . org-babel-do-key-sequence-in-edit-buffer) + ("x" . org-babel-do-key-sequence-in-edit-buffer) + ("\C-\M-h" . org-babel-mark-block)) "Alist of key bindings and interactive Babel functions. This list associates interactive Babel functions with keys. Each element of this list will add an entry to the
--- a/lisp/org/ob-latex.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-latex.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -37,14 +37,23 @@ (declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra)) (declare-function org-export-latex-fix-inputenc "org-latex" ()) +(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) -(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) +(defvar org-format-latex-header) +(defvar org-format-latex-header-extra) +(defvar org-export-latex-packages-alist) +(defvar org-export-latex-default-packages-alist) +(defvar org-export-pdf-logfiles) +(defvar org-latex-to-pdf-process) +(defvar org-export-pdf-remove-logfiles) +(defvar org-format-latex-options) +(defvar org-export-latex-packages-alist) (defvar org-babel-default-header-args:latex '((:results . "latex") (:exports . "results")) "Default arguments to use when evaluating a LaTeX source block.") -(defun org-babel-expand-body:latex (body params &optional processed-params) +(defun org-babel-expand-body:latex (body params) "Expand BODY according to PARAMS, return the expanded body." (mapc (lambda (pair) ;; replace variables (setq body @@ -52,30 +61,62 @@ (regexp-quote (format "%S" (car pair))) (if (stringp (cdr pair)) (cdr pair) (format "%S" (cdr pair))) - body))) (nth 1 (org-babel-process-params params))) - body) + body))) (mapcar #'cdr (org-babel-get-header params :var))) + (org-babel-trim body)) -(defvar org-format-latex-options) -(defvar org-export-latex-packages-alist) (defun org-babel-execute:latex (body params) "Execute a block of Latex code with Babel. This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) (if (cdr (assoc :file params)) - (let ((out-file (cdr (assoc :file params))) - (tex-file (make-temp-file "org-babel-latex" nil ".tex")) - (pdfheight (cdr (assoc :pdfheight params))) - (pdfwidth (cdr (assoc :pdfwidth params))) - (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) - (org-export-latex-packages-alist - (append (cdr (assoc :packages params)) - org-export-latex-packages-alist))) + (let* ((out-file (cdr (assoc :file params))) + (tex-file (org-babel-temp-file "latex-" ".tex")) + (border (cdr (assoc :border params))) + (fit (or (cdr (assoc :fit params)) border)) + (height (and fit (cdr (assoc :pdfheight params)))) + (width (and fit (cdr (assoc :pdfwidth params)))) + (headers (cdr (assoc :headers params))) + (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) + (org-export-latex-packages-alist + (append (cdr (assoc :packages params)) + org-export-latex-packages-alist))) (cond ((string-match "\\.png$" out-file) (org-create-formula-image body out-file org-format-latex-options in-buffer)) ((string-match "\\.pdf$" out-file) - (org-babel-latex-body-to-tex-file tex-file body pdfheight pdfwidth) + (require 'org-latex) + (with-temp-file tex-file + (insert + (org-splice-latex-header + org-format-latex-header + (delq + nil + (mapcar + (lambda (el) + (unless (and (listp el) (string= "hyperref" (cadr el))) + el)) + org-export-latex-default-packages-alist)) + org-export-latex-packages-alist + org-format-latex-header-extra) + (if fit "\n\\usepackage[active, tightpage]{preview}\n" "") + (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "") + (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") + (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") + (if headers + (concat "\n" + (if (listp headers) + (mapconcat #'identity headers "\n") + headers) "\n") + "") + (if org-format-latex-header-extra + (concat "\n" org-format-latex-header-extra) + "") + (if fit + (concat "\n\\begin{document}\n\\begin{preview}\n" body + "\n\\end{preview}\n\\end{document}\n") + (concat "\n\\begin{document}\n" body "\n\\end{document}\n"))) + (org-export-latex-fix-inputenc)) (when (file-exists-p out-file) (delete-file out-file)) (rename-file (org-babel-latex-tex-to-pdf tex-file) out-file)) ((string-match "\\.\\([^\\.]+\\)$" out-file) @@ -84,67 +125,48 @@ out-file) body)) -(defvar org-format-latex-header) -(defvar org-format-latex-header-extra) -(defvar org-export-latex-packages-alist) -(defvar org-export-latex-default-packages-alist) -(defun org-babel-latex-body-to-tex-file (tex-file body &optional height width) - "Place the contents of BODY into TEX-FILE. -Extracted from `org-create-formula-image' in org.el." - (with-temp-file tex-file - (insert (org-splice-latex-header - org-format-latex-header - (delq - nil - (mapcar - (lambda (el) (unless (and (listp el) (string= "hyperref" (cadr el))) - el)) - org-export-latex-default-packages-alist)) - org-export-latex-packages-alist - org-format-latex-header-extra) - (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") - (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") - (if org-format-latex-header-extra - (concat "\n" org-format-latex-header-extra) - "") - "\n\\begin{document}\n" body "\n\\end{document}\n") - (org-export-latex-fix-inputenc))) - -(defvar org-export-pdf-logfiles) -(defvar org-latex-to-pdf-process) -(defvar org-export-pdf-remove-logfiles) -(defun org-babel-latex-tex-to-pdf (tex-file) - "Generate a pdf file according to the contents TEX-FILE. +(defun org-babel-latex-tex-to-pdf (file) + "Generate a pdf file according to the contents FILE. Extracted from `org-export-as-pdf' in org-latex.el." (let* ((wconfig (current-window-configuration)) - (default-directory (file-name-directory tex-file)) - (base (file-name-sans-extension tex-file)) + (default-directory (file-name-directory file)) + (base (file-name-sans-extension file)) (pdffile (concat base ".pdf")) (cmds org-latex-to-pdf-process) (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) - cmd) + output-dir cmd) + (with-current-buffer outbuf (erase-buffer)) + (message (concat "Processing LaTeX file " file "...")) + (setq output-dir (file-name-directory file)) (if (and cmds (symbolp cmds)) - (funcall cmds tex-file) + (funcall cmds (shell-quote-argument file)) (while cmds - (setq cmd (pop cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%s" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument tex-file)) - t t cmd))) - (shell-command cmd outbuf outbuf))) + (setq cmd (pop cmds)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument base)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument file)) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf))) + (message (concat "Processing LaTeX file " file "...done")) (if (not (file-exists-p pdffile)) - (error "PDF file was not produced from %s" tex-file) + (error (concat "PDF file " pdffile " was not produced")) (set-window-configuration wconfig) (when org-export-pdf-remove-logfiles - (dolist (ext org-export-pdf-logfiles) - (setq tex-file (concat base "." ext)) - (and (file-exists-p tex-file) (delete-file tex-file)))) + (dolist (ext org-export-pdf-logfiles) + (setq file (concat base "." ext)) + (and (file-exists-p file) (delete-file file)))) + (message "Exporting to PDF...done") pdffile))) (defun org-babel-prep-session:latex (session params)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/org/ob-ledger.el Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,72 @@ +;;; ob-ledger.el --- org-babel functions for ledger evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric S Fraga +;; Keywords: literate programming, reproducible research, accounting +;; Homepage: http://orgmode.org +;; Version: 7.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ledger entries. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in ledger +;; +;; 2) we are generally only going to return output from the leger program +;; +;; 3) we are adding the "cmdline" header argument +;; +;; 4) there are no variables + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:ledger + '((:results . "output") (:cmdline . "bal")) + "Default arguments to use when evaluating a ledger source block.") + +(defun org-babel-execute:ledger (body params) + "Execute a block of Ledger entries with org-babel. This function is +called by `org-babel-execute-src-block'." + (message "executing Ledger source code block") + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "ledger-")) + (out-file (org-babel-temp-file "ledger-output-"))) + (with-temp-file in-file (insert body)) + (message (concat "ledger" + " -f " (org-babel-process-file-name in-file) + " " cmdline)) + (with-output-to-string + (shell-command (concat "ledger" + " -f " (org-babel-process-file-name in-file) + " " cmdline + " > " (org-babel-process-file-name out-file)))) + (with-temp-buffer (insert-file-contents out-file) (buffer-string)))) + +(defun org-babel-prep-session:ledger (session params) + (error "Ledger does not support sessions")) + +(provide 'ob-ledger) + +;; arch-tag: 7bbb529e-95a1-4236-9d29-b0000b918c7c + +;;; ob-ledger.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/org/ob-lisp.el Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,108 @@ +;;; ob-lisp.el --- org-babel functions for Common Lisp + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: David T. O'Toole <dto@gnu.org> +;; Eric Schulte +;; Keywords: literate programming, reproducible research, lisp +;; Homepage: http://orgmode.org +;; Version: 7.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.) +;; See http://common-lisp.net/project/slime/ + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(declare-function slime-eval "ext:slime" (form)) +(declare-function slime-connected-p "ext:slime" ()) +(declare-function slime-process "ext:slime" ()) +(require 'slime nil 'noerror) + +(defvar org-babel-default-header-args:lisp '() + "Default header arguments for lisp code blocks.") + +(defcustom org-babel-lisp-cmd "sbcl --script" + "Name of command used to evaluate lisp blocks.") + +(defun org-babel-expand-body:lisp (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + +(defun org-babel-execute:lisp (body params) + "Execute a block of Lisp code with org-babel. +This function is called by `org-babel-execute-src-block'" + (message "executing Lisp source code block") + (let* ((session (org-babel-lisp-initiate-session + (cdr (assoc :session params)))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:lisp body params))) + (read + (if session + ;; session evaluation + (save-window-excursion + (cadr (slime-eval `(swank:eval-and-grab-output ,full-body)))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "lisp-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format "(print %s)" full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-lisp-cmd + (org-babel-process-file-name script-file)) "")))))) + +;; This function should be used to assign any variables in params in +;; the context of the session environment. +(defun org-babel-prep-session:lisp (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "not yet implemented")) + +(defun org-babel-lisp-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (unless (string= session "none") + (save-window-excursion + (or (slime-connected-p) + (slime-process))))) + +(provide 'ob-lisp) + +;; arch-tag: 18086168-009f-4947-bbb5-3532375d851d + +;;; ob-lisp.el ends here
--- a/lisp/org/ob-lob.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-lob.el Wed Nov 17 13:09:08 2010 +0900 @@ -2,10 +2,11 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte, Dan Davison +;; Author: Eric Schulte +;; Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -25,7 +26,7 @@ ;;; Commentary: ;; See the online documentation for more information -;; +;; ;; http://orgmode.org/worg/org-contrib/babel/ ;;; Code: @@ -45,15 +46,22 @@ ;;;###autoload (defun org-babel-lob-ingest (&optional file) - "Add all source-blocks defined in FILE to `org-babel-library-of-babel'." + "Add all named source-blocks defined in FILE to +`org-babel-library-of-babel'." (interactive "f") - (org-babel-map-src-blocks file - (let* ((info (org-babel-get-src-block-info)) - (source-name (intern (nth 4 info)))) - (when source-name - (setq org-babel-library-of-babel - (cons (cons source-name info) - (assq-delete-all source-name org-babel-library-of-babel))))))) + (let ((lob-ingest-count 0)) + (org-babel-map-src-blocks file + (let* ((info (org-babel-get-src-block-info 'light)) + (source-name (nth 4 info))) + (when source-name + (setq source-name (intern source-name) + org-babel-library-of-babel + (cons (cons source-name info) + (assq-delete-all source-name org-babel-library-of-babel)) + lob-ingest-count (1+ lob-ingest-count))))) + (message "%d src block%s added to Library of Babel" + lob-ingest-count (if (> lob-ingest-count 1) "s" "")) + lob-ingest-count)) (defconst org-babel-lob-call-aliases '("lob" "call") "Aliases to call a source block function. @@ -61,9 +69,10 @@ become unusable by other org-babel users, and vice versa.") (defconst org-babel-lob-one-liner-regexp - (concat "^\\([ \t]*\\)#\\+\\(?:" - (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") - "\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)[ \t]*\\([^\n]*\\)") + (concat + "^\\([ \t]*\\)#\\+\\(?:" + (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") + "\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\([^\n]*\\)") "Regexp to match calls to predefined source block functions.") ;; functions for executing lob one-liners @@ -76,36 +85,32 @@ (let ((info (org-babel-lob-get-info))) (if (nth 0 info) (progn (org-babel-lob-execute info) t) nil))) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-lob-execute-maybe) - ;;;###autoload (defun org-babel-lob-get-info () - "Return a Library of Babel function call as a string. - -This function is analogous to org-babel-get-src-block-name. For -both functions, after they are called, (match-string 1) matches -the function name, and (match-string 2) matches the function -arguments inside the parentheses. I think perhaps these functions -should be renamed to bring out this similarity, perhaps involving -the word 'call'." + "Return a Library of Babel function call as a string." (let ((case-fold-search t)) (save-excursion (beginning-of-line 1) (if (looking-at org-babel-lob-one-liner-regexp) - (append (mapcar #'org-babel-clean-text-properties - (list (format "%s(%s)" (match-string 2) (match-string 3)) - (match-string 4))) - (list (length (match-string 1)))))))) - + (append + (mapcar #'org-babel-clean-text-properties + (list + (format "%s(%s)%s" + (match-string 2) (match-string 3) (match-string 4)) + (match-string 5))) + (list (length (match-string 1)))))))) + (defun org-babel-lob-execute (info) "Execute the lob call specified by INFO." - (let ((params (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-buffer) - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-babel-clean-text-properties - (concat ":var results=" (mapconcat #'identity (butlast info) " "))))))) + (let ((params (org-babel-process-params + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" + (mapconcat #'identity (butlast info) " ")))))))) (org-babel-execute-src-block nil (list "emacs-lisp" "results" params nil nil (nth 2 info)))))
--- a/lisp/org/ob-matlab.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-matlab.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs.
--- a/lisp/org/ob-mscgen.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-mscgen.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Juan Pechiar ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -62,9 +62,6 @@ '((:results . "file") (:exports . "results")) "Default arguments to use when evaluating a mscgen source block.") -(defun org-babel-expand-body:mscgen (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." body) - (defun org-babel-execute:mscgen (body params) "Execute a block of Mscgen code with Babel. This function is called by `org-babel-execute-src-block'.
--- a/lisp/org/ob-ocaml.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-ocaml.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -51,20 +51,12 @@ (defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") (defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe") -(defun org-babel-expand-body:ocaml (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) - (concat - (mapconcat - (lambda (pair) (format "let %s = %s;;" (car pair) - (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) - vars "\n") "\n" body "\n"))) - (defun org-babel-execute:ocaml (body params) "Execute a block of Ocaml code with Babel." - (let* ((processed-params (org-babel-process-params params)) - (vars (nth 1 processed-params)) - (full-body (org-babel-expand-body:ocaml body params processed-params)) + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:ocaml params))) (session (org-babel-prep-session:ocaml (cdr (assoc :session params)) params)) (raw (org-babel-comint-with-output @@ -84,9 +76,9 @@ (org-babel-reassemble-table (org-babel-ocaml-parse-output (org-babel-trim clean)) (org-babel-pick-name - (nth 4 processed-params) (cdr (assoc :colnames params))) + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name - (nth 5 processed-params) (cdr (assoc :rownames params)))))) + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) (defvar tuareg-interactive-buffer-name) (defun org-babel-prep-session:ocaml (session params) @@ -100,6 +92,13 @@ (save-window-excursion (tuareg-run-caml) (get-buffer tuareg-interactive-buffer-name)))) +(defun org-babel-variable-assignments:ocaml (params) + "Return list of ocaml statements assigning the block's variables" + (mapcar + (lambda (pair) (format "let %s = %s;;" (car pair) + (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + (defun org-babel-ocaml-elisp-to-ocaml (val) "Return a string of ocaml code which evaluates to VAL." (if (listp val)
--- a/lisp/org/ob-octave.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-octave.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -47,20 +47,6 @@ (defvar org-babel-octave-shell-command "octave -q" "Shell command to run octave as an external process.") -(defun org-babel-expand-body:matlab (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (org-babel-expand-body:octave body params processed-params)) -(defun org-babel-expand-body:octave (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) - (concat - (mapconcat - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-octave-var-to-octave (cdr pair)))) - vars "\n") "\n" body "\n"))) - (defvar org-babel-matlab-with-emacs-link nil "If non-nil use matlab-shell-run-region for session evaluation. This will use EmacsLink if (matlab-with-emacs-link) evaluates @@ -76,7 +62,7 @@ (defvar org-babel-octave-wrapper-method "%s if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); -else, save -ascii %s ans +else, dlmwrite('%s', ans, '\\t') end") (defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") @@ -85,53 +71,60 @@ (defun org-babel-execute:matlab (body params) "Execute a block of matlab code with Babel." - (require 'matlab) (org-babel-execute:octave body params 'matlab)) + (defun org-babel-execute:octave (body params &optional matlabp) "Execute a block of octave code with Babel." - (let* ((processed-params (org-babel-process-params params)) - (session + (let* ((session (funcall (intern (format "org-babel-%s-initiate-session" (if matlabp "matlab" "octave"))) - (nth 0 processed-params) params)) - (vars (nth 1 processed-params)) - (result-params (nth 2 processed-params)) - (result-type (nth 3 processed-params)) + (cdr (assoc :session params)) params)) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) (out-file (cdr (assoc :file params))) - (augmented-body - (org-babel-expand-body:octave body params processed-params)) + (full-body + (org-babel-expand-body:generic + body params (org-babel-variable-assignments:octave params))) (result (org-babel-octave-evaluate - session augmented-body result-type matlabp))) + session full-body result-type matlabp))) (or out-file (org-babel-reassemble-table result (org-babel-pick-name - (nth 4 processed-params) (cdr (assoc :colnames params))) + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name - (nth 5 processed-params) (cdr (assoc :rownames params))))))) + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) (defun org-babel-prep-session:matlab (session params) "Prepare SESSION according to PARAMS." - (require 'matlab) (org-babel-prep-session:octave session params 'matlab)) + +(defun org-babel-variable-assignments:octave (params) + "Return list of octave statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-octave-var-to-octave (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defalias 'org-babel-variable-assignments:matlab + 'org-babel-variable-assignments:octave) + (defun org-babel-octave-var-to-octave (var) "Convert an emacs-lisp value into an octave variable. Converts an emacs-lisp variable into a string of octave code specifying a variable of the same value." (if (listp var) - (concat "[" (mapconcat #'org-babel-octave-var-to-octave var ", ") "]") - (format "%S" var))) + (concat "[" (mapconcat #'org-babel-octave-var-to-octave var + (if (listp (car var)) "; " ",")) "]") + (format "%s" (or var "nil")))) (defun org-babel-prep-session:octave (session params &optional matlabp) "Prepare SESSION according to the header arguments specified in PARAMS." (let* ((session (org-babel-octave-initiate-session session params matlabp)) - (vars (org-babel-ref-variables params)) - (var-lines (mapcar - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-octave-var-to-octave (cdr pair)))) - vars))) + (var-lines (org-babel-variable-assignments:octave params))) (org-babel-comint-in-buffer session (mapc (lambda (var) (end-of-line 1) (insert var) (comint-send-input nil t) @@ -142,13 +135,13 @@ "Create a matlab inferior process buffer. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." - (require 'matlab) (org-babel-octave-initiate-session session params 'matlab)) + (defun org-babel-octave-initiate-session (&optional session params matlabp) "Create an octave inferior process buffer. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." - (require 'octave-inf) + (if matlabp (require 'matlab) (require 'octave-inf)) (unless (string= session "none") (let ((session (or session (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) @@ -161,7 +154,7 @@ (current-buffer)))))) (defun org-babel-octave-evaluate - (session body result-type lang &optional matlabp) + (session body result-type &optional matlabp) "Pass BODY to the octave process in SESSION. If RESULT-TYPE equals 'output then return the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the @@ -177,17 +170,19 @@ org-babel-octave-shell-command))) (case result-type (output (org-babel-eval cmd body)) - (value (let ((tmp-file (make-temp-file "org-babel-results-"))) + (value (let ((tmp-file (org-babel-temp-file "octave-"))) (org-babel-eval cmd - (format org-babel-octave-wrapper-method body tmp-file tmp-file)) - (org-babel-eval-read-file tmp-file)))))) + (format org-babel-octave-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-octave-import-elisp-from-file tmp-file)))))) (defun org-babel-octave-evaluate-session (session body result-type &optional matlabp) "Evaluate BODY in SESSION." - (let* ((tmp-file (make-temp-file "org-babel-results-")) - (wait-file (make-temp-file "org-babel-matlab-emacs-link-wait-signal-")) + (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-"))) + (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) (full-body (case result-type (output @@ -198,11 +193,15 @@ (if (and matlabp org-babel-matlab-with-emacs-link) (concat (format org-babel-matlab-emacs-link-wrapper-method - body tmp-file tmp-file wait-file) "\n") + body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote) wait-file) "\n") (mapconcat #'org-babel-chomp (list (format org-babel-octave-wrapper-method - body tmp-file tmp-file) + body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote)) org-babel-octave-eoe-indicator) "\n"))))) (raw (if (and matlabp org-babel-matlab-with-emacs-link) (save-window-excursion @@ -225,8 +224,7 @@ (insert full-body) (comint-send-input nil t)))) results) (case result-type (value - (org-babel-octave-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file))) + (org-babel-octave-import-elisp-from-file tmp-file)) (output (progn (setq results @@ -244,14 +242,14 @@ "Import data from FILE-NAME. This removes initial blank and comment lines and then calls `org-babel-import-elisp-from-file'." - (let ((temp-file (make-temp-file "org-babel-results-")) beg end) + (let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end) (with-temp-file temp-file (insert-file-contents file-name) (re-search-forward "^[ \t]*[^# \t]" nil t) (if (< (setq beg (point-min)) (setq end (point-at-bol))) (delete-region beg end))) - (org-babel-import-elisp-from-file temp-file))) + (org-babel-import-elisp-from-file temp-file '(16)))) (defun org-babel-octave-read-string (string) "Strip \\\"s from around octave string"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/org/ob-org.el Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,62 @@ +;;; ob-org.el --- org-babel functions for org code block evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is the simplest of code blocks, where upon evaluation the +;; contents of the code block are returned in a raw result. + +;;; Code: +(require 'ob) + +(declare-function org-export-string "org-exp" (string fmt &optional dir)) + +(defvar org-babel-default-header-args:org + '((:results . "raw silent") (:exports . "results")) + "Default arguments for evaluating a org source block.") + +(defvar org-babel-org-default-header + "#+TITLE: default empty header\n" + "Default header inserted during export of org blocks.") + +(defun org-babel-execute:org (body params) + "Execute a block of Org code with. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (body (replace-regexp-in-string "^," "" body))) + (cond + ((member "latex" result-params) (org-export-string body "latex")) + ((member "html" result-params) (org-export-string body "html")) + ((member "ascii" result-params) (org-export-string body "ascii")) + (t body)))) + +(defun org-babel-prep-session:org (session params) + "Return an error because org does not support sessions." + (error "Org does not support sessions")) + +(provide 'ob-org) + +;; arch-tag: 130af5fe-cc56-46bd-9508-fa0ebd94cb1f + +;;; ob-org.el ends here
--- a/lisp/org/ob-perl.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-perl.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,11 +1,12 @@ ;;; ob-perl.el --- org-babel functions for perl evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Dan Davison, Eric Schulte +;; Author: Dan Davison +;; Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -38,39 +39,35 @@ (defvar org-babel-perl-command "perl" "Name of command to use for executing perl code.") -(defun org-babel-expand-body:perl (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) - (concat - (mapconcat ;; define any variables - (lambda (pair) - (format "$%s=%s;" - (car pair) - (org-babel-perl-var-to-perl (cdr pair)))) - vars "\n") "\n" (org-babel-trim body) "\n"))) - (defun org-babel-execute:perl (body params) "Execute a block of Perl code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((processed-params (org-babel-process-params params)) - (session (nth 0 processed-params)) - (vars (nth 1 processed-params)) - (result-params (nth 2 processed-params)) - (result-type (nth 3 processed-params)) - (full-body (org-babel-expand-body:perl - body params processed-params)) + (let* ((session (cdr (assoc :session params))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:perl params))) (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table (org-babel-perl-evaluate session full-body result-type) (org-babel-pick-name - (nth 4 processed-params) (cdr (assoc :colnames params))) + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name - (nth 5 processed-params) (cdr (assoc :rownames params)))))) + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) (defun org-babel-prep-session:perl (session params) "Prepare SESSION according to the header arguments in PARAMS." (error "Sessions are not supported for Perl.")) +(defun org-babel-variable-assignments:perl (params) + "Return list of perl statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "$%s=%s;" + (car pair) + (org-babel-perl-var-to-perl (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + ;; helper functions (defun org-babel-perl-var-to-perl (var) @@ -107,10 +104,11 @@ (when session (error "Sessions are not supported for Perl.")) (case result-type (output (org-babel-eval org-babel-perl-command body)) - (value (let ((tmp-file (make-temp-file "org-babel-perl-results-"))) + (value (let ((tmp-file (org-babel-temp-file "perl-"))) (org-babel-eval org-babel-perl-command - (format org-babel-perl-wrapper-method body tmp-file)) + (format org-babel-perl-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote))) (org-babel-eval-read-file tmp-file))))) (provide 'ob-perl)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/org/ob-plantuml.el Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,83 @@ +;;; ob-plantuml.el --- org-babel functions for plantuml evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Zhang Weize +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating plantuml script. +;; +;; Inspired by Ian Yang's org-export-blocks-format-plantuml +;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el + +;;; Requirements: + +;; plantuml | http://plantuml.sourceforge.net/ +;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:plantuml + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a plantuml source block.") + +(defcustom org-plantuml-jar-path nil + "Path to the plantuml.jar file." + :group 'org-babel + :type 'string) + +(defun org-babel-execute:plantuml (body params) + "Execute a block of plantuml code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (or (cdr (assoc :file params)) + (error "plantuml requires a \":file\" header argument"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "plantuml-")) + (cmd (if (not org-plantuml-jar-path) + (error "`org-plantuml-jar-path' is not set") + (concat "java -jar " + (shell-quote-argument + (expand-file-name org-plantuml-jar-path)) + (if (string= (file-name-extension out-file) "svg") + " -tsvg" "") + " -p " cmdline " < " + (org-babel-process-file-name in-file) + " > " + (org-babel-process-file-name out-file))))) + (unless (file-exists-p org-plantuml-jar-path) + (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) + (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) + (message "%s" cmd) (org-babel-eval cmd "") + out-file)) + +(defun org-babel-prep-session:plantuml (session params) + "Return an error because plantuml does not support sessions." + (error "Plantuml does not support sessions")) + +(provide 'ob-plantuml) + +;; arch-tag: 451f50c5-e779-407e-ad64-70e0e8f161d1 + +;;; ob-plantuml.el ends here
--- a/lisp/org/ob-python.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-python.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,11 +1,12 @@ ;;; ob-python.el --- org-babel functions for python evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte, Dan Davison +;; Author: Eric Schulte +;; Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -47,46 +48,34 @@ (defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python) "Preferred python mode for use in running python interactively.") -(defun org-babel-expand-body:python (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (concat - (mapconcat ;; define any variables - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-python-var-to-python (cdr pair)))) - (nth 1 (or processed-params (org-babel-process-params params))) "\n") - "\n" (org-babel-trim body) "\n")) +(defvar org-src-preserve-indentation) (defun org-babel-execute:python (body params) "Execute a block of Python code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((processed-params (org-babel-process-params params)) - (session (org-babel-python-initiate-session (first processed-params))) - (result-params (nth 2 processed-params)) - (result-type (nth 3 processed-params)) - (full-body (org-babel-expand-body:python - body params processed-params)) + (let* ((session (org-babel-python-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body + (org-babel-expand-body:generic + body params (org-babel-variable-assignments:python params))) (result (org-babel-python-evaluate session full-body result-type result-params))) (or (cdr (assoc :file params)) (org-babel-reassemble-table result - (org-babel-pick-name (nth 4 processed-params) + (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) + (org-babel-pick-name (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) (defun org-babel-prep-session:python (session params) - "Prepare SESSION according to the header arguments in PARAMS." + "Prepare SESSION according to the header arguments in PARAMS. +VARS contains resolved variable references" (let* ((session (org-babel-python-initiate-session session)) - (vars (org-babel-ref-variables params)) - (var-lines (mapcar ;; define any variables - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-python-var-to-python (cdr pair)))) - vars))) + (var-lines + (org-babel-variable-assignments:python params))) (org-babel-comint-in-buffer session (mapc (lambda (var) (end-of-line 1) (insert var) (comint-send-input) @@ -104,6 +93,15 @@ ;; helper functions +(defun org-babel-variable-assignments:python (params) + "Return list of python statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-python-var-to-python (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + (defun org-babel-python-var-to-python (var) "Convert an elisp value to a python variable. Convert an elisp value, VAR, into a string of python source code @@ -125,8 +123,7 @@ (mapcar (lambda (el) (if (equal el 'None) 'hline el)) res) res)) (org-babel-read - (if (or (string-match "^\\[.+\\]$" results) - (string-match "^(.+)$" results)) + (if (and (stringp results) (string-match "^[([].+[])]$" results)) (org-babel-read (concat "'" (replace-regexp-in-string @@ -151,10 +148,10 @@ (let* ((session (if session (intern session) :default)) (python-buffer (org-babel-python-session-buffer session))) (cond - ((and (equal 'python org-babel-python-mode) + ((and (eq 'python org-babel-python-mode) (fboundp 'run-python)) ; python.el (run-python)) - ((and (equal 'python-mode org-babel-python-mode) + ((and (eq 'python-mode org-babel-python-mode) (fboundp 'py-shell)) ; python-mode.el ;; `py-shell' creates a buffer whose name is the value of ;; `py-which-bufname' with '*'s at the beginning and end @@ -195,73 +192,89 @@ open('%s', 'w').write( pprint.pformat(main()) )") (defun org-babel-python-evaluate - (buffer body &optional result-type result-params) - "Pass BODY to the Python process in BUFFER. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY, as elisp." - (if (not buffer) - ;; external process evaluation - (case result-type - (output (org-babel-eval org-babel-python-command body)) - (value (let ((tmp-file (make-temp-file "org-babel-python-results-"))) - (org-babel-eval org-babel-python-command - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation - (org-babel-trim body)) - "[\r\n]") "\n") - tmp-file)) - ((lambda (raw) - (if (or (member "code" result-params) - (member "pp" result-params)) - raw - (org-babel-python-table-or-string raw))) - (org-babel-eval-read-file tmp-file))))) - ;; comint session evaluation - (flet ((dump-last-value (tmp-file pp) - (mapc - (lambda (statement) (insert statement) (comint-send-input)) - (if pp - (list - "import pp" - (format "open('%s', 'w').write(pprint.pformat(_))" tmp-file)) - (list (format "open('%s', 'w').write(str(_))" tmp-file))))) - (input-body (body) - (mapc (lambda (statement) (insert statement) (comint-send-input)) - (split-string (org-babel-trim body) "[\r\n]+")) - (comint-send-input) (comint-send-input))) - (case result-type - (output - (mapconcat - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (buffer org-babel-python-eoe-indicator t body) - (let ((comint-process-echoes nil)) - (input-body body) - (insert org-babel-python-eoe-indicator) - (comint-send-input))) 2) "\n")) - (value - ((lambda (results) - (if (or (member "code" result-params) (member "pp" result-params)) - results - (org-babel-python-table-or-string results))) - (let ((tmp-file (make-temp-file "org-babel-python-results-"))) - (org-babel-comint-with-output - (buffer org-babel-python-eoe-indicator t body) - (let ((comint-process-echoes nil)) - (input-body body) - (dump-last-value tmp-file (member "pp" result-params)) - (comint-send-input) (comint-send-input) - (insert org-babel-python-eoe-indicator) - (comint-send-input))) - (org-babel-eval-read-file tmp-file)))))))) + (session body &optional result-type result-params) + "Evaluate BODY as python code." + (if session + (org-babel-python-evaluate-session + session body result-type result-params) + (org-babel-python-evaluate-external-process + body result-type result-params))) + +(defun org-babel-python-evaluate-external-process + (body &optional result-type result-params) + "Evaluate BODY in external python process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (output (org-babel-eval org-babel-python-command body)) + (value (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-eval org-babel-python-command + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + (org-babel-process-file-name tmp-file 'noquote))) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-python-table-or-string raw))) + (org-babel-eval-read-file tmp-file)))))) + +(defun org-babel-python-evaluate-session + (session body &optional result-type result-params) + "Pass BODY to the Python process in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (flet ((dump-last-value + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (comint-send-input)) + (if pp + (list + "import pp" + (format "open('%s', 'w').write(pprint.pformat(_))" + (org-babel-process-file-name tmp-file 'noquote))) + (list (format "open('%s', 'w').write(str(_))" + (org-babel-process-file-name tmp-file 'noquote)))))) + (input-body (body) + (mapc (lambda (statement) (insert statement) (comint-send-input)) + (split-string (org-babel-trim body) "[\r\n]+")) + (comint-send-input) (comint-send-input))) + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) 2) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-python-table-or-string results))) + (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (dump-last-value tmp-file (member "pp" result-params)) + (comint-send-input) (comint-send-input) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) + (org-babel-eval-read-file tmp-file))))))) (defun org-babel-python-read-string (string) "Strip 's from around python string"
--- a/lisp/org/ob-ref.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-ref.el Wed Nov 17 13:09:08 2010 +0900 @@ -2,10 +2,11 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte, Dan Davison +;; Author: Eric Schulte +;; Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -57,36 +58,26 @@ (declare-function org-at-table-p "org" (&optional table-type)) (declare-function org-count "org" (CL-ITEM CL-SEQ)) -(defun org-babel-ref-variables (params) - "Convert PARAMS to variable names and values. -Takes a parameter alist, and return an alist of variable names, -and the emacs-lisp representation of the related value." - (let ((assignments - (delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params))) - (others - (delq nil (mapcar (lambda (pair) (unless (eq :var (car pair)) pair)) params)))) - (mapcar (lambda (assignment) (org-babel-ref-parse assignment)) assignments))) - (defvar org-babel-ref-split-regexp "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") -(defun org-babel-ref-parse (assignment &optional params) +(defun org-babel-ref-parse (assignment) "Parse a variable ASSIGNMENT in a header argument. If the right hand side of the assignment has a literal value return that value, otherwise interpret as a reference to an external resource and find it's value using -`org-babel-ref-resolve-reference'. Return a list with two -elements. The first element of the list will be the name of the -variable, and the second will be an emacs-lisp representation of -the value of the variable." - (if (string-match org-babel-ref-split-regexp assignment) - (let ((var (match-string 1 assignment)) - (ref (match-string 2 assignment))) - (cons (intern var) - ((lambda (val) - (if (equal :ob-must-be-reference val) - (org-babel-ref-resolve-reference ref params) - val)) (org-babel-ref-literal ref)))))) +`org-babel-ref-resolve'. Return a list with two elements. The +first element of the list will be the name of the variable, and +the second will be an emacs-lisp representation of the value of +the variable." + (when (string-match org-babel-ref-split-regexp assignment) + (let ((var (match-string 1 assignment)) + (ref (match-string 2 assignment))) + (cons (intern var) + ((lambda (val) + (if (equal :ob-must-be-reference val) + (org-babel-ref-resolve ref) val)) + (org-babel-ref-literal ref)))))) (defun org-babel-ref-literal (ref) "Return the value of REF if it is a literal value. @@ -103,7 +94,7 @@ out))) (defvar org-babel-library-of-babel) -(defun org-babel-ref-resolve-reference (ref &optional params) +(defun org-babel-ref-resolve (ref) "Resolve the reference REF and return its value." (save-excursion (let ((case-fold-search t) @@ -119,12 +110,10 @@ (when (string-match "^\\(.+?\\)\(\\(.*\\)\)$" ref) (setq new-refere (match-string 1 ref)) (setq new-referent (match-string 2 ref)) - ;; (message "new-refere=%S, new-referent=%S" new-refere new-referent) ;; debugging (when (> (length new-refere) 0) (if (> (length new-referent) 0) (setq args (mapcar (lambda (ref) (cons :var ref)) (org-babel-ref-split-args new-referent)))) - ;; (message "args=%S" args) ;; debugging (setq ref new-refere))) (when (string-match "^\\(.+\\):\\(.+\\)$" ref) (setq split-file (match-string 1 ref)) @@ -133,7 +122,8 @@ (save-restriction (widen) (goto-char (point-min)) - (if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME\\|RESULTS\\):[ \t]*" + (if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME" + "\\|RESULTS\\):[ \t]*" (regexp-quote ref) "[ \t]*$")) (regexp (concat org-babel-src-name-regexp (regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$"))) @@ -144,7 +134,8 @@ (re-search-forward regexp nil t) (re-search-backward regexp nil t) ;; check the Library of Babel - (setq lob-info (cdr (assoc (intern ref) org-babel-library-of-babel))))) + (setq lob-info (cdr (assoc (intern ref) + org-babel-library-of-babel))))) (unless lob-info (goto-char (match-beginning 0))) ;; ;; TODO: allow searching for names in other buffers ;; (setq id-loc (org-id-find ref 'marker) @@ -159,14 +150,14 @@ (beginning-of-line) (if (or (= (point) (point-min)) (= (point) (point-max))) (error "reference not found")))) - (setq params (org-babel-merge-params params args '((:results . "silent")))) - (setq result - (case type - ('results-line (org-babel-read-result)) - ('table (org-babel-read-table)) - ('file (org-babel-read-link)) - ('source-block (org-babel-execute-src-block nil nil params)) - ('lob (org-babel-execute-src-block nil lob-info params)))) + (let ((params (append args '((:results . "silent"))))) + (setq result + (case type + ('results-line (org-babel-read-result)) + ('table (org-babel-read-table)) + ('file (org-babel-read-link)) + ('source-block (org-babel-execute-src-block nil nil params)) + ('lob (org-babel-execute-src-block nil lob-info params))))) (if (symbolp result) (format "%S" result) (if (and index (listp result)) @@ -199,7 +190,7 @@ (if (or (= 0 (length portion)) (string-match ind-re portion)) (mapcar (lambda (n) (nth n lis)) - (apply 'number-sequence + (apply 'org-number-sequence (if (and (> (length portion) 0) (match-string 2 portion)) (list (wrap (string-to-number (match-string 2 portion)))
--- a/lisp/org/ob-ruby.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-ruby.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,11 +1,11 @@ ;;; ob-ruby.el --- org-babel functions for ruby evaluation -;; Copyright (C) 2009, 2010 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -29,10 +29,10 @@ ;;; Requirements: ;; - ruby and irb executables :: http://www.ruby-lang.org/ -;; +;; ;; - ruby-mode :: Can be installed through ELPA, or from ;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el -;; +;; ;; - inf-ruby mode :: Can be installed through ELPA, or from ;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el @@ -52,48 +52,30 @@ (defvar org-babel-ruby-command "ruby" "Name of command to use for executing ruby code.") -(defun org-babel-expand-body:ruby (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (require 'inf-ruby) - (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) - (concat - (mapconcat ;; define any variables - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-ruby-var-to-ruby (cdr pair)))) - vars "\n") "\n" body "\n"))) - (defun org-babel-execute:ruby (body params) "Execute a block of Ruby code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((processed-params (org-babel-process-params params)) - (session (org-babel-ruby-initiate-session (first processed-params))) - (result-params (nth 2 processed-params)) - (result-type (nth 3 processed-params)) - (full-body (org-babel-expand-body:ruby - body params processed-params)) + (let* ((session (org-babel-ruby-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:ruby params))) (result (org-babel-ruby-evaluate session full-body result-type result-params))) (or (cdr (assoc :file params)) (org-babel-reassemble-table result - (org-babel-pick-name (nth 4 processed-params) + (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) + (org-babel-pick-name (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) (defun org-babel-prep-session:ruby (session params) "Prepare SESSION according to the header arguments specified in PARAMS." ;; (message "params=%S" params) ;; debugging (let* ((session (org-babel-ruby-initiate-session session)) - (vars (org-babel-ref-variables params)) - (var-lines (mapcar ;; define any variables - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-ruby-var-to-ruby (cdr pair)))) - vars))) + (var-lines (org-babel-variable-assignments:ruby params))) (org-babel-comint-in-buffer session (sit-for .5) (goto-char (point-max)) (mapc (lambda (var) @@ -113,6 +95,15 @@ ;; helper functions +(defun org-babel-variable-assignments:ruby (params) + "Return list of ruby statements assigning the block's variables" + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-ruby-var-to-ruby (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + (defun org-babel-ruby-var-to-ruby (var) "Convert VAR into a ruby variable. Convert an elisp value into a string of ruby source code @@ -186,12 +177,13 @@ ;; external process evaluation (case result-type (output (org-babel-eval org-babel-ruby-command body)) - (value (let ((tmp-file (make-temp-file "org-babel-ruby-results-"))) - (org-babel-eval org-babel-ruby-command - (format (if (member "pp" result-params) - org-babel-ruby-pp-wrapper-method - org-babel-ruby-wrapper-method) - body tmp-file)) + (value (let ((tmp-file (org-babel-temp-file "ruby-"))) + (org-babel-eval + org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body (org-babel-process-file-name tmp-file 'noquote))) ((lambda (raw) (if (or (member "code" result-params) (member "pp" result-params)) @@ -221,7 +213,7 @@ (if (or (member "code" result-params) (member "pp" result-params)) results (org-babel-ruby-table-or-string results))) - (let* ((tmp-file (make-temp-file "org-babel-ruby-results-")) + (let* ((tmp-file (org-babel-temp-file "ruby-")) (ppp (or (member "code" result-params) (member "pp" result-params)))) (org-babel-comint-with-output @@ -233,10 +225,12 @@ (append (list body) (if (not ppp) - (list (format org-babel-ruby-f-write tmp-file)) + (list (format org-babel-ruby-f-write + (org-babel-process-file-name tmp-file 'noquote))) (list "results=_" "require 'pp'" "orig_out = $stdout" - (format org-babel-ruby-pp-f-write tmp-file))) + (format org-babel-ruby-pp-f-write + (org-babel-process-file-name tmp-file 'noquote)))) (list org-babel-ruby-eoe-indicator))) (comint-send-input nil t)) (org-babel-eval-read-file tmp-file)))))))
--- a/lisp/org/ob-sass.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-sass.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -43,20 +43,19 @@ (defvar org-babel-default-header-args:sass '()) -(defun org-babel-expand-body:sass (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." body) - (defun org-babel-execute:sass (body params) "Execute a block of Sass code with Babel. This function is called by `org-babel-execute-src-block'." (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (file (cdr (assoc :file params))) - (out-file (or file (make-temp-file "org-babel-sass-out"))) + (out-file (or file (org-babel-temp-file "sass-out-"))) (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-sass-in")) - (cmd (concat "sass " (or cmdline "") in-file " " out-file))) + (in-file (org-babel-temp-file "sass-in-")) + (cmd (concat "sass " (or cmdline "") + " " (org-babel-process-file-name in-file) + " " (org-babel-process-file-name out-file)))) (with-temp-file in-file - (insert (org-babel-expand-body:sass body params))) (shell-command cmd) + (insert (org-babel-expand-body:generic body params))) (shell-command cmd) (or file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) (defun org-babel-prep-session:sass (session params)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/org/ob-scheme.el Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,137 @@ +;;; ob-scheme.el --- org-babel functions for Scheme + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, scheme +;; Homepage: http://orgmode.org +;; Version: 7.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; - a working scheme implementation +;; (e.g. guile http://www.gnu.org/software/guile/guile.html) +;; +;; - for session based evaluation cmuscheme.el is required which is +;; included in Emacs + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-scheme "ext:cmuscheme" (cmd)) + +(defvar org-babel-default-header-args:scheme '() + "Default header arguments for scheme code blocks.") + +(defvar org-babel-scheme-eoe "org-babel-scheme-eoe" + "String to indicate that evaluation has completed.") + +(defcustom org-babel-scheme-cmd "guile" + "Name of command used to evaluate scheme blocks." + :group 'org-babel + :type 'string) + +(defun org-babel-expand-body:scheme (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + +(defvar scheme-program-name) +(defun org-babel-execute:scheme (body params) + "Execute a block of Scheme code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((result-type (cdr (assoc :result-type params))) + (org-babel-scheme-cmd (or (cdr (assoc :scheme params)) + org-babel-scheme-cmd)) + (full-body (org-babel-expand-body:scheme body params))) + (read + (if (not (string= (cdr (assoc :session params)) "none")) + ;; session evaluation + (let ((session (org-babel-prep-session:scheme + (cdr (assoc :session params)) params))) + (org-babel-comint-with-output + (session (format "%S" org-babel-scheme-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body (format "%S" org-babel-scheme-eoe))))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "scheme-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format "(display %s)" full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-scheme-cmd + (org-babel-process-file-name script-file)) "")))))) + +(defun org-babel-prep-session:scheme (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-scheme-initiate-session session)) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (var-lines + (mapcar + (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var))))) + vars))) + (when session + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines))) + session)) + +(defun org-babel-scheme-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (require 'cmuscheme) + (unless (string= session "none") + (let ((session-buffer (save-window-excursion + (run-scheme org-babel-scheme-cmd) + (rename-buffer session) + (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-scheme-initiate-session session))))) + +(provide 'ob-scheme) + +;; arch-tag: 6b2fe76f-4b25-4e87-ad1c-225b2f282a71 + +;;; ob-scheme.el ends here
--- a/lisp/org/ob-screen.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-screen.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,11 +1,11 @@ ;;; ob-screen.el --- org-babel support for interactive terminal -;; Copyright (C) 2009, 2010 Free Software Foundation +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Benjamin Andresen ;; Keywords: literate programming, interactive shell ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -45,28 +45,21 @@ '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) "Default arguments to use when running screen source blocks.") -(defun org-babel-expand-body:screen (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." body) - (defun org-babel-execute:screen (body params) "Send a block of code via screen to a terminal using Babel. -\"default\" session is be used when none is specified." +\"default\" session is used when none is specified." (message "Sending source code block to interactive terminal session...") (save-window-excursion - (let* ((processed-params (org-babel-process-params params)) - (session (nth 0 processed-params)) + (let* ((session (cdr (assoc :session params))) (socket (org-babel-screen-session-socketname session))) (unless socket (org-babel-prep-session:screen session params)) (org-babel-screen-session-execute-string - session (org-babel-expand-body:screen body params))))) + session (org-babel-expand-body:generic body params))))) (defun org-babel-prep-session:screen (session params) "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((processed-params (org-babel-process-params params)) - (session (nth 0 processed-params)) - (vars (nth 1 processed-params)) + (let* ((session (cdr (assoc :session params))) (socket (org-babel-screen-session-socketname session)) - (vars (org-babel-ref-variables params)) (cmd (cdr (assoc :cmd params))) (terminal (cdr (assoc :terminal params))) (process-name (concat "org-babel: terminal (" session ")")))
--- a/lisp/org/ob-sh.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-sh.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -33,7 +33,10 @@ (require 'shell) (eval-when-compile (require 'cl)) -(declare-function org-babel-ref-variables "ob-ref" (params)) +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) +(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) +(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) +(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) (declare-function orgtbl-to-generic "org-table" (table params)) (defvar org-babel-default-header-args:sh '()) @@ -42,44 +45,25 @@ "Command used to invoke a shell. This will be passed to `shell-command-on-region'") -(defun org-babel-expand-body:sh (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (nth 1 (or processed-params (org-babel-process-params params)))) - (sep (cdr (assoc :separator params)))) - (concat - (mapconcat ;; define any variables - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-sh-var-to-sh (cdr pair) sep))) - vars "\n") "\n" body "\n\n"))) - (defun org-babel-execute:sh (body params) "Execute a block of Shell commands with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((processed-params (org-babel-process-params params)) - (session (org-babel-sh-initiate-session (nth 0 processed-params))) - (result-params (nth 2 processed-params)) - (full-body (org-babel-expand-body:sh - body params processed-params))) + (let* ((session (org-babel-sh-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:sh params)))) (org-babel-reassemble-table (org-babel-sh-evaluate session full-body result-params) (org-babel-pick-name - (nth 4 processed-params) (cdr (assoc :colnames params))) + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name - (nth 5 processed-params) (cdr (assoc :rownames params)))))) + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) (defun org-babel-prep-session:sh (session params) "Prepare SESSION according to the header arguments specified in PARAMS." (let* ((session (org-babel-sh-initiate-session session)) - (vars (org-babel-ref-variables params)) - (sep (cdr (assoc :separator params))) - (var-lines (mapcar ;; define any variables - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-sh-var-to-sh (cdr pair) sep))) - vars))) + (var-lines (org-babel-variable-assignments:sh params))) (org-babel-comint-in-buffer session (mapc (lambda (var) (insert var) (comint-send-input nil t) @@ -97,6 +81,16 @@ ;; helper functions +(defun org-babel-variable-assignments:sh (params) + "Return list of shell statements assigning the block's variables" + (let ((sep (cdr (assoc :separator params)))) + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-sh-var-to-sh (cdr pair) sep))) + (mapcar #'cdr (org-babel-get-header params :var))))) + (defun org-babel-sh-var-to-sh (var &optional sep) "Convert an elisp value to a shell variable. Convert an elisp var into a string of shell commands specifying a @@ -108,7 +102,8 @@ (org-babel-sh-var-to-sh el sep)))) (format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)" (orgtbl-to-generic - (deep-string var) (list :sep (or sep "\t"))))) + (deep-string (if (listp (car var)) var (list var))) + (list :sep (or sep "\t"))))) (if (stringp var) (if (string-match "[\n\r]" var) (format "$(cat <<BABEL_STRING\n%s\nBABEL_STRING\n)" var) @@ -148,29 +143,29 @@ of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY." ((lambda (results) - (if (or (member "scalar" result-params) - (member "output" result-params)) - results - (let ((tmp-file (make-temp-file "org-babel-sh"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file)))) + (when results + (if (or (member "scalar" result-params) + (member "output" result-params)) + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))))) (if (not session) (org-babel-eval org-babel-sh-command (org-babel-trim body)) - (let ((tmp-file (make-temp-file "org-babel-sh"))) - (mapconcat - #'org-babel-sh-strip-weird-long-prompt - (mapcar - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (session org-babel-sh-eoe-output t body) - (mapc - (lambda (line) - (insert line) (comint-send-input nil t) (sleep-for 0.25)) - (append - (split-string (org-babel-trim body) "\n") - (list org-babel-sh-eoe-indicator)))) - 2)) "\n"))))) + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) (comint-send-input nil t) (sleep-for 0.25)) + (append + (split-string (org-babel-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n")))) (defun org-babel-sh-strip-weird-long-prompt (string) "Remove prompt cruft from a string of shell output."
--- a/lisp/org/ob-sql.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-sql.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -50,33 +50,37 @@ (defvar org-babel-default-header-args:sql '()) -(defun org-babel-expand-body:sql (body params &optional processed-params) - "Expand BODY according to PARAMS, return the expanded body." body) - (defun org-babel-execute:sql (body params) "Execute a block of Sql code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (processed-params (org-babel-process-params params)) + (let* ((result-params (cdr (assoc :result-params params))) (cmdline (cdr (assoc :cmdline params))) (engine (cdr (assoc :engine params))) - (in-file (make-temp-file "org-babel-sql-in")) + (in-file (org-babel-temp-file "sql-in-")) (out-file (or (cdr (assoc :out-file params)) - (make-temp-file "org-babel-sql-out"))) + (org-babel-temp-file "sql-out-"))) (command (case (intern engine) ('mysql (format "mysql %s -e \"source %s\" > %s" - (or cmdline "") in-file out-file)) + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) (t (error "no support for the %s sql engine" engine))))) (with-temp-file in-file - (insert (org-babel-expand-body:sql body params))) + (insert (org-babel-expand-body:generic body params))) (message command) (shell-command command) (with-temp-buffer (org-table-import out-file nil) (org-babel-reassemble-table (org-table-to-lisp) - (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) - (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))))) (defun org-babel-prep-session:sql (session params)
--- a/lisp/org/ob-sqlite.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-sqlite.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,11 +1,11 @@ ;;; ob-sqlite.el --- org-babel functions for sqlite database interaction -;; Copyright (C) 2010 Free Software Foundation +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -41,9 +41,10 @@ '(db header echo bail csv column html line list separator nullvalue) "Sqlite specific header args.") -(defun org-babel-expand-body:sqlite (body params &optional processed-params) +(defun org-babel-expand-body:sqlite (body params) + "Expand BODY according to the values of PARAMS." (org-babel-sqlite-expand-vars - body (or (nth 1 processed-params) (org-babel-ref-variables params)))) + body (mapcar #'cdr (org-babel-get-header params :var)))) (defvar org-babel-sqlite3-command "sqlite3") @@ -51,7 +52,7 @@ "Execute a block of Sqlite code with Babel. This function is called by `org-babel-execute-src-block'." (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (vars (org-babel-ref-variables params)) + (vars (org-babel-get-header params :var)) (db (cdr (assoc :db params))) (separator (cdr (assoc :separator params))) (nullvalue (cdr (assoc :nullvalue params))) @@ -70,10 +71,9 @@ (list (cons "body" ((lambda (sql-file) (with-temp-file sql-file - (insert (org-babel-expand-body:sqlite - body nil (list nil vars)))) + (insert (org-babel-expand-body:sqlite body params))) sql-file) - (make-temp-file "ob-sqlite-sql"))) + (org-babel-temp-file "sqlite-sql-"))) (cons "cmd" org-babel-sqlite3-command) (cons "header" (if headers-p "-header" "-noheader")) (cons "separator" @@ -117,8 +117,8 @@ el (format "%S" el))))))) data-file) - (make-temp-file "ob-sqlite-data")) - (format "%S" val))) + (org-babel-temp-file "sqlite-data-")) + (if (stringp val) val (format "%S" val)))) (cdr pair)) body))) vars)
--- a/lisp/org/ob-table.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-table.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -79,13 +79,24 @@ cell's value as a string, prefix the identifier with two \"$\"s rather than a single \"$\" (i.e. \"$$2\" instead of \"$2\" in the example above." - (let ((variables (mapcar - (lambda (var) - (if (and (= 3 (length var)) (eq (nth 1 var) '$)) - (list (car var) (format "\"%s\"" (last var))) - var)) - variables))) - (unless (stringp source-block) (setq source-block (symbol-name source-block))) + (let* (quote + (variables + (mapcar + (lambda (var) + ;; ensure that all cells prefixed with $'s are strings + (cons (car var) + (delq nil (mapcar + (lambda (el) + (if (eq '$ el) + (setq quote t) + (prog1 (if quote + (format "\"%s\"" el) + (org-babel-clean-text-properties el)) + (setq quote nil)))) + (cdr var))))) + variables))) + (unless (stringp source-block) + (setq source-block (symbol-name source-block))) (org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line (if (and source-block (> (length source-block) 0)) (let ((params @@ -93,13 +104,18 @@ (concat ":var results=" ,source-block "(" - (mapconcat (lambda (var-spec) - (format "%S=%s" (nth 0 var-spec) (nth 1 var-spec))) - ',variables ", ") + (mapconcat + (lambda (var-spec) + (if (> (length (cdr var-spec)) 1) + (format "%S='%S" + (car var-spec) + (mapcar #'read (cdr var-spec))) + (format "%S=%s" + (car var-spec) (cadr var-spec)))) + ',variables ", ") ")"))))) (org-babel-execute-src-block - nil (list "emacs-lisp" "results" - (org-babel-merge-params '((:results . "silent")) params)))) + nil (list "emacs-lisp" "results" params) '((:results . "silent")))) "")))) (provide 'ob-table)
--- a/lisp/org/ob-tangle.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob-tangle.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -34,7 +34,11 @@ (declare-function org-link-escape "org" (text &optional table)) (declare-function org-heading-components "org" ()) +(declare-function org-back-to-heading "org" (invisible-ok)) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-babel-update-block-body "org" (new-body)) +;;;###autoload (defcustom org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "Alist mapping languages to their file extensions. @@ -53,18 +57,66 @@ :group 'org-babel :type 'hook) +(defcustom org-babel-pre-tangle-hook '(save-buffer) + "Hook run at the beginning of `org-babel-tangle'." + :group 'org-babel + :type 'hook) + +(defcustom org-babel-tangle-pad-newline t + "Switch indicating whether to pad tangled code with newlines." + :group 'org-babel + :type 'boolean) + +(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block + +Whether or not comments are inserted during tangling is +controlled by the :comments header argument." + :group 'org-babel + :type 'string) + +(defcustom org-babel-tangle-comment-format-end "%source-name ends here" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block + +Whether or not comments are inserted during tangling is +controlled by the :comments header argument." + :group 'org-babel + :type 'string) + +(defun org-babel-find-file-noselect-refresh (file) + "Find file ensuring that the latest changes on disk are +represented in the file." + (find-file-noselect file) + (with-current-buffer (get-file-buffer file) + (revert-buffer t t t))) + (defmacro org-babel-with-temp-filebuffer (file &rest body) "Open FILE into a temporary buffer execute BODY there like `progn', then kill the FILE buffer returning the result of evaluating BODY." (declare (indent 1)) (let ((temp-result (make-symbol "temp-result")) - (temp-file (make-symbol "temp-file"))) - `(let (,temp-result ,temp-file) - (find-file ,file) - (setf ,temp-file (current-buffer)) - (setf ,temp-result (progn ,@body)) - (kill-buffer ,temp-file) + (temp-file (make-symbol "temp-file")) + (visited-p (make-symbol "visited-p"))) + `(let (,temp-result ,temp-file + (,visited-p (get-file-buffer ,file))) + (org-babel-find-file-noselect-refresh ,file) + (setf ,temp-file (get-file-buffer ,file)) + (with-current-buffer ,temp-file + (setf ,temp-result (progn ,@body))) + (unless ,visited-p (kill-buffer ,temp-file)) ,temp-result))) ;;;###autoload @@ -117,7 +169,7 @@ source blocks. Optional argument LANG can be used to limit the exported source code blocks by language." (interactive) - (save-buffer) + (run-hooks 'org-babel-pre-tangle-hook) (save-excursion (let ((block-counter 0) (org-babel-default-header-args @@ -142,7 +194,7 @@ (mapc (lambda (spec) (flet ((get-spec (name) - (cdr (assoc name (nth 2 spec))))) + (cdr (assoc name (nth 4 spec))))) (let* ((tangle (get-spec :tangle)) (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) (get-spec :shebang))) @@ -177,14 +229,15 @@ (insert content) (write-region nil nil file-name)))) ;; if files contain she-bangs, then make the executable - (when she-bang (set-file-modes file-name ?\755)) + (when she-bang (set-file-modes file-name #o755)) ;; update counter (setq block-counter (+ 1 block-counter)) (add-to-list 'path-collector file-name))))) specs))) (org-babel-tangle-collect-blocks lang)) - (message "tangled %d code block%s" block-counter - (if (= block-counter 1) "" "s")) + (message "tangled %d code block%s from %s" block-counter + (if (= block-counter 1) "" "s") + (file-name-nondirectory (buffer-file-name (current-buffer)))) ;; run `org-babel-post-tangle-hook' in all tangled files (when org-babel-post-tangle-hook (mapc @@ -209,7 +262,7 @@ (save-excursion (end-of-line 1) (forward-char 1) (point))))) (defvar org-stored-links) -(defun org-babel-tangle-collect-blocks (&optional lang) +(defun org-babel-tangle-collect-blocks (&optional language) "Collect source blocks in the current Org-mode file. Return an association list of source-code block specifications of the form used by `org-babel-spec-to-string' grouped by language. @@ -224,44 +277,69 @@ (setq current-heading new-heading)) (setq block-counter (+ 1 block-counter)))) (replace-regexp-in-string "[ \t]" "-" - (nth 4 (org-heading-components)))) - (let* ((link (progn (call-interactively 'org-store-link) - (org-babel-clean-text-properties - (car (pop org-stored-links))))) - (info (org-babel-get-src-block-info)) - (source-name (intern (or (nth 4 info) - (format "%s:%d" - current-heading block-counter)))) - (src-lang (nth 0 info)) - (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) - (params (nth 2 info)) - by-lang) - (unless (string= (cdr (assoc :tangle params)) "no") ;; skip - (unless (and lang (not (string= lang src-lang))) ;; limit by language - ;; add the spec for this block to blocks under it's language - (setq by-lang (cdr (assoc src-lang blocks))) - (setq blocks (delq (assoc src-lang blocks) blocks)) - (setq blocks - (cons - (cons src-lang - (cons (list link source-name params - ((lambda (body) - (if (assoc :no-expand params) - body - (funcall - (if (fboundp expand-cmd) - expand-cmd - 'org-babel-expand-body:generic) - body - params))) - (if (and (cdr (assoc :noweb params)) - (string= - "yes" - (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references - info) - (nth 1 info)))) - by-lang)) blocks)))))) + (condition-case nil + (nth 4 (org-heading-components)) + (error (buffer-file-name))))) + (let* ((start-line (save-restriction (widen) + (+ 1 (line-number-at-pos (point))))) + (file (buffer-file-name)) + (info (org-babel-get-src-block-info 'light)) + (src-lang (nth 0 info))) + (unless (string= (cdr (assoc :tangle (nth 2 info))) "no") + (unless (and language (not (string= language src-lang))) + (let* ((info (org-babel-get-src-block-info)) + (params (nth 2 info)) + (link (progn (call-interactively 'org-store-link) + (org-babel-clean-text-properties + (car (pop org-stored-links))))) + (source-name + (intern (or (nth 4 info) + (format "%s:%d" + current-heading block-counter)))) + (expand-cmd + (intern (concat "org-babel-expand-body:" src-lang))) + (assignments-cmd + (intern (concat "org-babel-variable-assignments:" src-lang))) + (body + ((lambda (body) + (if (assoc :no-expand params) + body + (if (fboundp expand-cmd) + (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params + (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (if (and (cdr (assoc :noweb params)) + (let ((nowebs (split-string + (cdr (assoc :noweb params))))) + (or (member "yes" nowebs) + (member "tangle" nowebs)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (comment + (when (or (string= "both" (cdr (assoc :comments params))) + (string= "org" (cdr (assoc :comments params)))) + ;; from the previous heading or code-block end + (buffer-substring + (max (condition-case nil + (save-excursion + (org-back-to-heading t) (point)) + (error 0)) + (save-excursion + (re-search-backward + org-babel-src-block-regexp nil t) + (match-end 0))) + (point)))) + by-lang) + ;; add the spec for this block to blocks under it's language + (setq by-lang (cdr (assoc src-lang blocks))) + (setq blocks (delq (assoc src-lang blocks) blocks)) + (setq blocks (cons + (cons src-lang + (cons (list start-line file link + source-name params body comment) + by-lang)) blocks))))))) ;; ensure blocks in the correct order (setq blocks (mapcar @@ -276,22 +354,97 @@ assumes that the appropriate major-mode is set. SPEC has the form - (link source-name params body)" - (let ((link (nth 0 spec)) - (source-name (nth 1 spec)) - (body (nth 3 spec)) - (commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes"))) + (start-line file link source-name params body comment)" + (let* ((start-line (nth 0 spec)) + (file (nth 1 spec)) + (link (org-link-escape (nth 2 spec))) + (source-name (nth 3 spec)) + (body (nth 5 spec)) + (comment (nth 6 spec)) + (comments (cdr (assoc :comments (nth 4 spec)))) + (link-p (or (string= comments "both") (string= comments "link") + (string= comments "yes"))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + ((lambda (le) + (if (stringp le) le (format "%S" le))) + (eval el)))) + '(start-line file link source-name)))) (flet ((insert-comment (text) - (when commentable - (insert "\n") - (comment-region (point) - (progn (insert text) (point))) - (end-of-line nil) - (insert "\n")))) - (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name)) - (insert (format "\n%s\n" (replace-regexp-in-string - "^," "" (org-babel-chomp body)))) - (insert-comment (format "%s ends here" source-name))))) + (let ((text (org-babel-trim text))) + (when (and comments (not (string= comments "no")) + (> (length text) 0)) + (when org-babel-tangle-pad-newline (insert "\n")) + (comment-region (point) (progn (insert text) (point))) + (end-of-line nil) (insert "\n"))))) + (when comment (insert-comment comment)) + (when link-p + (insert-comment + (org-fill-template org-babel-tangle-comment-format-beg link-data))) + (when org-babel-tangle-pad-newline (insert "\n")) + (insert + (format + "%s\n" + (replace-regexp-in-string + "^," "" + (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) + (when link-p + (insert-comment + (org-fill-template org-babel-tangle-comment-format-end link-data)))))) + +;; detangling functions +(defvar org-bracket-link-analytic-regexp) +(defun org-babel-detangle (&optional source-code-file) + "Propagate changes in source file back original to Org-mode file. +This requires that code blocks were tangled with link comments +which enable the original code blocks to be found." + (interactive) + (save-excursion + (when source-code-file (find-file source-code-file)) + (goto-char (point-min)) + (let ((counter 0) new-body end) + (while (re-search-forward org-bracket-link-analytic-regexp nil t) + (when (re-search-forward + (concat " " (regexp-quote (match-string 5)) " ends here")) + (setq end (match-end 0)) + (forward-line -1) + (save-excursion + (when (setq new-body (org-babel-tangle-jump-to-org)) + (org-babel-update-block-body new-body))) + (setq counter (+ 1 counter))) + (goto-char end)) + (prog1 counter (message "detangled %d code blocks" counter))))) + +(defun org-babel-tangle-jump-to-org () + "Jump from a tangled code file to the related Org-mode file." + (interactive) + (let ((mid (point)) + target-buffer target-char + start end link path block-name body) + (save-window-excursion + (save-excursion + (unless (and (re-search-backward org-bracket-link-analytic-regexp nil t) + (setq start (point-at-eol)) + (setq link (match-string 0)) + (setq path (match-string 3)) + (setq block-name (match-string 5)) + (re-search-forward + (concat " " (regexp-quote block-name) " ends here") nil t) + (setq end (point-at-bol)) + (< start mid) (< mid end)) + (error "not in tangled code")) + (setq body (org-babel-trim (buffer-substring start end)))) + (when (string-match "::" path) + (setq path (substring path 0 (match-beginning 0)))) + (find-file path) (setq target-buffer (current-buffer)) + (goto-char start) (org-open-link-from-string link) + (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) + (org-babel-next-src-block + (string-to-number (match-string 1 block-name))) + (org-babel-goto-named-src-block block-name)) + (setq target-char (point))) + (pop-to-buffer target-buffer) + (prog1 body (goto-char target-char)))) (provide 'ob-tangle)
--- a/lisp/org/ob.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/ob.el Wed Nov 17 13:09:08 2010 +0900 @@ -2,10 +2,11 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Eric Schulte, Dan Davison +;; Author: Eric Schulte +;; Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -40,28 +41,38 @@ (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) (declare-function tramp-file-name-user "tramp" (vec)) (declare-function tramp-file-name-host "tramp" (vec)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) (declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-edit-src-code "org-src" - (&optional context code edit-buffer-name)) +(declare-function org-edit-src-code "org-src" + (&optional context code edit-buffer-name quietp)) +(declare-function org-edit-src-exit "org-src" (&optional context)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) +(declare-function org-save-outline-visibility "org" (use-markers &rest body)) +(declare-function org-outline-overlay-data "org" (&optional use-markers)) +(declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-narrow-to-subtree "org" ()) -(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) (declare-function org-make-options-regexp "org" (kwds &optional extra)) (declare-function org-do-remove-indentation "org" (&optional n)) (declare-function org-show-context "org" (&optional key)) (declare-function org-at-table-p "org" (&optional table-type)) (declare-function org-cycle "org" (&optional arg)) (declare-function org-uniquify "org" (list)) +(declare-function org-current-level "org" ()) (declare-function org-table-import "org-table" (file arg)) -(declare-function org-add-hook "org-compat" (hook function &optional append local)) +(declare-function org-add-hook "org-compat" + (hook function &optional append local)) (declare-function org-table-align "org-table" ()) (declare-function org-table-end "org-table" (&optional table-type)) (declare-function orgtbl-to-generic "org-table" (table params)) (declare-function orgtbl-to-orgtbl "org-table" (table params)) (declare-function org-babel-lob-get-info "ob-lob" nil) (declare-function org-babel-ref-split-args "ob-ref" (arg-string)) -(declare-function org-babel-ref-variables "ob-ref" (params)) -(declare-function org-babel-ref-resolve-reference "ob-ref" (ref &optional params)) +(declare-function org-babel-ref-parse "ob-ref" (assignment)) +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function org-babel-lob-execute-maybe "ob-lob" ()) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -100,8 +111,15 @@ "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*" "Regular expression used to match a source name line.") +(defvar org-babel-multi-line-header-regexp + "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" + "Regular expression used to match multi-line header arguments.") + (defvar org-babel-src-name-w-name-regexp (concat org-babel-src-name-regexp + "\\(" + org-babel-multi-line-header-regexp + "\\)*" "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)") "Regular expression matching source name lines with a name.") @@ -127,51 +145,54 @@ "{\\([^\f\n\r\v]+?\\)}\\)") "Regexp used to identify inline src-blocks.") -(defun org-babel-get-src-block-info (&optional header-vars-only) +(defun org-babel-get-header (params key &optional others) + "Select only header argument of type KEY from a list. +Optional argument OTHERS indicates that only the header that do +not match KEY should be returned." + (delq nil + (mapcar + (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) + params))) + +(defun org-babel-get-src-block-info (&optional light) "Get information on the current source block. +Optional argument LIGHT does not resolve remote variable +references; a process which could likely result in the execution +of other code blocks. + Returns a list - (language body header-arguments-alist switches name function-args indent). -Unless HEADER-VARS-ONLY is non-nil, any variable -references provided in 'function call style' (i.e. in a -parenthesised argument list following the src block name) are -added to the header-arguments-alist." - (let ((case-fold-search t) head info args indent) + (language body header-arguments-alist switches name indent)." + (let ((case-fold-search t) head info name indent) + ;; full code block (if (setq head (org-babel-where-is-src-block-head)) - (save-excursion + (save-excursion (goto-char head) (setq info (org-babel-parse-src-block-match)) (setq indent (car (last info))) (setq info (butlast info)) - (forward-line -1) - (if (and (looking-at org-babel-src-name-w-name-regexp) - (match-string 2)) - (progn - (setq info (append info (list (org-babel-clean-text-properties - (match-string 2))))) - ;; Note that e.g. "name()" and "name( )" result in - ;; ((:var . "")). We maintain that behaviour, and the - ;; resulting non-nil sixth element is relied upon in - ;; org-babel-exp-code to detect a functional-style - ;; block in those cases. However, "name" without any - ;; parentheses would result in the same thing, so we - ;; explicitly avoid that. - (if (setq args (match-string 4)) - (setq info - (append info (list - (mapcar - (lambda (ref) (cons :var ref)) - (org-babel-ref-split-args args)))))) - (unless header-vars-only - (setf (nth 2 info) - (org-babel-merge-params (nth 5 info) (nth 2 info))))) - (setq info (append info (list nil nil)))) - (append info (list indent))) - (if (save-excursion ;; inline source block - (re-search-backward "[ \f\t\n\r\v]" nil t) - (looking-at org-babel-inline-src-block-regexp)) - (org-babel-parse-inline-src-block-match) - nil)))) + (while (and (forward-line -1) + (looking-at org-babel-multi-line-header-regexp)) + (setf (nth 2 info) + (org-babel-merge-params + (org-babel-parse-header-arguments (match-string 1)) + (nth 2 info)))) + (when (looking-at org-babel-src-name-w-name-regexp) + (setq name (org-babel-clean-text-properties (match-string 4))) + (when (match-string 6) + (setf (nth 2 info) ;; merge functional-syntax vars and header-args + (org-babel-merge-params + (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args (match-string 6))) + (nth 2 info)))))) + ;; inline source block + (when (save-excursion (re-search-backward "[ \f\t\n\r\v]" nil t) + (looking-at org-babel-inline-src-block-regexp)) + (setq info (org-babel-parse-inline-src-block-match)))) + ;; resolve variable references and add summary parameters + (when (and info (not light)) + (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) + (when info (append info (list name indent))))) (defun org-babel-confirm-evaluate (info) "Confirm evaluation of the code block INFO. @@ -182,31 +203,42 @@ Note disabling confirmation may result in accidental evaluation of potentially harmful code." - (let* ((eval (cdr (assoc :eval (nth 2 info)))) + (let* ((eval (or (cdr (assoc :eval (nth 2 info))) + (when (assoc :noeval (nth 2 info)) "no"))) (query (or (equal eval "query") - (and (functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - (nth 0 info) (nth 1 info))) - org-confirm-babel-evaluate))) - (when (or (equal eval "never") - (and query - (not (yes-or-no-p - (format "Evaluate this%scode on your system? " - (if info (format " %s " (nth 0 info)) " ")))))) - (error "evaluation aborted")))) + (if (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + (nth 0 info) (nth 1 info)) + org-confirm-babel-evaluate)))) + (if (or (equal eval "never") (equal eval "no") + (and query + (not (yes-or-no-p + (format "Evaluate this%scode on your system? " + (if info (format " %s " (nth 0 info)) " ")))))) + (prog1 nil (message "evaluation aborted")) + t))) ;;;###autoload +(defun org-babel-execute-safely-maybe () + (unless org-babel-no-eval-on-ctrl-c-ctrl-c + (org-babel-execute-maybe))) + +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) + +;;;###autoload +(defun org-babel-execute-maybe () + (interactive) + (or (org-babel-execute-src-block-maybe) + (org-babel-lob-execute-maybe))) + (defun org-babel-execute-src-block-maybe () "Conditionally execute a source block. Detect if this is context for a Babel src-block and if so then run `org-babel-execute-src-block'." (interactive) - (if (not org-babel-no-eval-on-ctrl-c-ctrl-c) - (let ((info (org-babel-get-src-block-info))) - (if info - (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)) - nil)) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-execute-src-block current-prefix-arg info) t) nil))) ;;;###autoload (defun org-babel-expand-src-block-maybe () @@ -245,7 +277,7 @@ (defconst org-babel-header-arg-names '(cache cmdline colnames dir exports file noweb results - session tangle var noeval comments) + session tangle var eval noeval comments) "Common header arguments used by org-babel. Note that individual languages may define their own language specific header arguments as well.") @@ -259,7 +291,8 @@ '((:session . "none") (:results . "silent") (:exports . "results")) "Default arguments to use when evaluating an inline source block.") -(defvar org-babel-current-buffer-properties) +(defvar org-babel-current-buffer-properties nil + "Local cache for buffer properties.") (make-variable-buffer-local 'org-babel-current-buffer-properties) (defvar org-babel-result-regexp @@ -299,12 +332,17 @@ ;;; functions (defvar call-process-region) ;;;###autoload + (defun org-babel-execute-src-block (&optional arg info params) "Execute the current source code block. Insert the results of execution into the buffer. Source code execution and the collection and formatting of results can be controlled through a variety of header arguments. +With prefix argument ARG, force re-execution even if a an +existing result cached in the buffer would otherwise have been +returned. + Optionally supply a value for INFO in the form returned by `org-babel-get-src-block-info'. @@ -312,73 +350,73 @@ the header arguments specified at the front of the source code block." (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) - ;; note the `evaluation-confirmed' variable is currently not - ;; used, but could be used later to avoid the need for - ;; chaining confirmations - (evaluation-confirmed (org-babel-confirm-evaluate info)) - (lang (nth 0 info)) - (params (setf (nth 2 info) - (sort (org-babel-merge-params (nth 2 info) params) - (lambda (el1 el2) (string< (symbol-name (car el1)) - (symbol-name (car el2))))))) - (new-hash - (if (and (cdr (assoc :cache params)) - (string= "yes" (cdr (assoc :cache params)))) - (org-babel-sha1-hash info))) - (old-hash (org-babel-result-hash info)) - (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (result-params (split-string (or (cdr (assoc :results params)) ""))) - (result-type (cond ((member "output" result-params) 'output) - ((member "value" result-params) 'value) - (t 'value))) - (cmd (intern (concat "org-babel-execute:" lang))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) - (org-babel-call-process-region-original - (if (boundp 'org-babel-call-process-region-original) org-babel-call-process-region-original - (symbol-function 'call-process-region))) - (indent (car (last info))) - result) - (unwind-protect - (flet ((call-process-region (&rest args) - (apply 'org-babel-tramp-handle-call-process-region args))) - (unless (fboundp cmd) - (error "No org-babel-execute function for %s!" lang)) - (if (and (not arg) new-hash (equal new-hash old-hash)) - (save-excursion ;; return cached result - (goto-char (org-babel-where-is-src-block-result nil info)) - (end-of-line 1) (forward-char 1) - (setq result (org-babel-read-result)) - (message (replace-regexp-in-string "%" "%%" - (format "%S" result))) result) - (message "executing %s code block%s..." - (capitalize lang) - (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) - (setq result (funcall cmd body params)) - (if (eq result-type 'value) - (setq result (if (and (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) - result))) - (org-babel-insert-result - result result-params info new-hash indent lang) - (run-hooks 'org-babel-after-execute-hook) - result)) - (setq call-process-region 'org-babel-call-process-region-original)))) + (let ((info (or info (org-babel-get-src-block-info)))) + (when (org-babel-confirm-evaluate info) + (let* ((lang (nth 0 info)) + (params (if params + (org-babel-process-params + (org-babel-merge-params (nth 2 info) params)) + (nth 2 info))) + (cache? (and (not arg) (cdr (assoc :cache params)) + (string= "yes" (cdr (assoc :cache params))))) + (result-params (cdr (assoc :result-params params))) + (new-hash (when cache? (org-babel-sha1-hash info))) + (old-hash (when cache? (org-babel-result-hash info))) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (cmd (intern (concat "org-babel-execute:" lang))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (org-babel-call-process-region-original + (if (boundp 'org-babel-call-process-region-original) + org-babel-call-process-region-original + (symbol-function 'call-process-region))) + (indent (car (last info))) + result) + (unwind-protect + (flet ((call-process-region (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args))) + (unless (fboundp cmd) + (error "No org-babel-execute function for %s!" lang)) + (if (and (not arg) new-hash (equal new-hash old-hash)) + (save-excursion ;; return cached result + (goto-char (org-babel-where-is-src-block-result nil info)) + (end-of-line 1) (forward-char 1) + (setq result (org-babel-read-result)) + (message (replace-regexp-in-string + "%" "%%" (format "%S" result))) result) + (message "executing %s code block%s..." + (capitalize lang) + (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) + (setq result + ((lambda (result) + (cond + ((member "file" result-params) + (cdr (assoc :file params))) + ((and (eq (cdr (assoc :result-type params)) 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result))) + (t result))) + (funcall cmd body params))) + (org-babel-insert-result + result result-params info new-hash indent lang) + (run-hooks 'org-babel-after-execute-hook) + result)) + (setq call-process-region 'org-babel-call-process-region-original)))))) -(defun org-babel-expand-body:generic (body params &optional processed-params) +(defun org-babel-expand-body:generic (body params &optional var-lines) "Expand BODY with PARAMS. Expand a block of code with org-babel according to it's header arguments. This generic implementation of body expansion is called for languages which have not defined their own specific -org-babel-expand-body:lang function." body) +org-babel-expand-body:lang function." + (mapconcat #'identity (append var-lines (list body)) "\n")) ;;;###autoload (defun org-babel-expand-src-block (&optional arg info params) @@ -391,14 +429,17 @@ (params (setf (nth 2 info) (sort (org-babel-merge-params (nth 2 info) params) (lambda (el1 el2) (string< (symbol-name (car el1)) - (symbol-name (car el2))))))) + (symbol-name (car el2))))))) (body (setf (nth 1 info) (if (and (cdr (assoc :noweb params)) (string= "yes" (cdr (assoc :noweb params)))) (org-babel-expand-noweb-references info) (nth 1 info)))) - (cmd (intern (concat "org-babel-expand-body:" lang))) - (expanded (funcall (if (fboundp cmd) cmd 'org-babel-expand-body:generic) - body params))) + (expand-cmd (intern (concat "org-babel-expand-body:" lang))) + (assignments-cmd (intern (concat "org-babel-variable-assignments:" lang))) + (expanded + (if (fboundp expand-cmd) (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) (org-edit-src-code nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")))) @@ -411,9 +452,16 @@ (interactive) (let* ((info (or info (org-babel-get-src-block-info))) (lang (nth 0 info)) - (body (nth 1 info)) (params (nth 2 info)) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) (cmd (intern (concat "org-babel-load-session:" lang)))) (unless (fboundp cmd) (error "No org-babel-load-session function for %s!" lang)) @@ -421,13 +469,13 @@ (end-of-line 1))) ;;;###autoload -(defun org-babel-switch-to-session (&optional arg info) - "Switch to the session of the current source-code block. -If called with a prefix argument then evaluate the header arguments -for the source block before entering the session. Copy the body -of the source block to the kill ring." - (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) +(defun org-babel-initiate-session (&optional arg info) + "Initiate session for current code block. +If called with a prefix argument then resolve any variable +references in the header arguments and assign these variables in +the session. Copy the body of the code block to the kill ring." + (interactive "P") + (let* ((info (or info (org-babel-get-src-block-info (not arg)))) (lang (nth 0 info)) (body (nth 1 info)) (params (nth 2 info)) @@ -435,23 +483,74 @@ (dir (cdr (assoc :dir params))) (default-directory (or (and dir (file-name-as-directory dir)) default-directory)) - (cmd (intern (format "org-babel-%s-initiate-session" lang))) - (cmd2 (intern (concat "org-babel-prep-session:" lang)))) - (unless (fboundp cmd) + (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) + (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) + (if (and (stringp session) (string= session "none")) + (error "This block is not using a session!")) + (unless (fboundp init-cmd) (error "No org-babel-initiate-session function for %s!" lang)) - ;; copy body to the kill ring (with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max))) - ;; if called with a prefix argument, then process header arguments - (unless (fboundp cmd2) - (error "No org-babel-prep-session function for %s!" lang)) - (when arg (funcall cmd2 session params)) - ;; just to the session using pop-to-buffer - (pop-to-buffer (funcall cmd session params)) - (end-of-line 1))) + (when arg + (unless (fboundp prep-cmd) + (error "No org-babel-prep-session function for %s!" lang)) + (funcall prep-cmd session params)) + (funcall init-cmd session params))) + +;;;###autoload +(defun org-babel-switch-to-session (&optional arg info) + "Switch to the session of the current code block. +Uses `org-babel-initiate-session' to start the session. If called +with a prefix argument then this is passed on to +`org-babel-initiate-session'." + (interactive "P") + (pop-to-buffer (org-babel-initiate-session arg info)) + (end-of-line 1)) (defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) +;;;###autoload +(defun org-babel-switch-to-session-with-code (&optional arg info) + "Switch to code buffer and display session." + (interactive "P") + (flet ((swap-windows + () + (let ((other-window-buffer (window-buffer (next-window)))) + (set-window-buffer (next-window) (current-buffer)) + (set-window-buffer (selected-window) other-window-buffer)) + (other-window 1))) + (let ((info (org-babel-get-src-block-info)) + (org-src-window-setup 'reorganize-frame)) + (save-excursion + (org-babel-switch-to-session arg info)) + (org-edit-src-code)) + (swap-windows))) + +(defmacro org-babel-do-in-edit-buffer (&rest body) + "Evaluate BODY in edit buffer if there is a code block at point. +Return t if a code block was found at point, nil otherwise." + `(let ((org-src-window-setup 'switch-invisibly)) + (when (and (org-babel-where-is-src-block-head) + (org-edit-src-code nil nil nil 'quietly)) + (unwind-protect (progn ,@body) + (if (org-bound-and-true-p org-edit-src-from-org-mode) + (org-edit-src-exit))) + t))) + +(defun org-babel-do-key-sequence-in-edit-buffer (key) + "Read key sequence and execute the command in edit buffer. +Enter a key sequence to be executed in the language major-mode +edit buffer. For example, TAB will alter the contents of the +Org-mode code block according to the effect of TAB in the +language major-mode buffer. For languages that support +interactive sessions, this can be used to send code from the Org +buffer to the session for evaluation using the native major-mode +evaluation mechanisms." + (interactive "kEnter key-sequence to execute in edit buffer: ") + (org-babel-do-in-edit-buffer + (call-interactively + (key-binding (or key (read-key-sequence nil)))))) + (defvar org-bracket-link-regexp) ;;;###autoload (defun org-babel-open-src-block-result (&optional re-run) @@ -490,15 +589,9 @@ Call `org-babel-execute-src-block' on every source block in the current buffer." (interactive "P") - (save-excursion - (org-save-outline-visibility t - (goto-char (point-min)) - (show-all) - (while (re-search-forward org-babel-src-block-regexp nil t) - (let ((pos-end (match-end 0))) - (goto-char (match-beginning 0)) - (org-babel-execute-src-block arg) - (goto-char pos-end)))))) + (org-save-outline-visibility t + (org-babel-map-src-blocks nil + (org-babel-execute-src-block arg)))) ;;;###autoload (defun org-babel-execute-subtree (&optional arg) @@ -509,19 +602,34 @@ (save-restriction (save-excursion (org-narrow-to-subtree) - (org-babel-execute-buffer) + (org-babel-execute-buffer arg) (widen)))) ;;;###autoload (defun org-babel-sha1-hash (&optional info) "Generate an sha1 hash based on the value of info." (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) - (hash (sha1 (format "%s-%s" (mapconcat (lambda (arg) (format "%S" arg)) - (nth 2 info) ":") - (nth 1 info))))) - (when (interactive-p) (message hash)) - hash)) + (let ((print-level nil) + (info (or info (org-babel-get-src-block-info)))) + (setf (nth 2 info) + (sort (copy-sequence (nth 2 info)) + (lambda (a b) (string< (car a) (car b))))) + (let ((hash (sha1 + (format "%s-%s" + (mapconcat + #'identity + (delq nil + (mapcar + (lambda (arg) + (let ((v (cdr arg))) + (when (and v (not (and (sequencep v) + (not (consp v)) + (= (length v) 0)))) + (format "%S" v)))) + (nth 2 info))) ":") + (nth 1 info))))) + (when (interactive-p) (message hash)) + hash))) (defun org-babel-result-hash (&optional info) "Return the in-buffer hash associated with INFO." @@ -647,23 +755,58 @@ ;; Remove overlays when changing major mode (add-hook 'org-mode-hook (lambda () (org-add-hook 'change-major-mode-hook - 'org-babel-show-result-all 'append 'local))) + 'org-babel-show-result-all 'append 'local))) (defmacro org-babel-map-src-blocks (file &rest body) - "Evaluate BODY forms on each source-block in FILE." + "Evaluate BODY forms on each source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. During evaluation of BODY the following local variables +are set relative to the currently matched code block. + +full-block ------- string holding the entirety of the code block +beg-block -------- point at the beginning of the code block +end-block -------- point at the end of the matched code block +lang ------------- string holding the language of the code block +beg-lang --------- point at the beginning of the lang +end-lang --------- point at the end of the lang +switches --------- string holding the switches +beg-switches ----- point at the beginning of the switches +end-switches ----- point at the end of the switches +header-args ------ string holding the header-args +beg-header-args -- point at the beginning of the header-args +end-header-args -- point at the end of the header-args +body ------------- string holding the body of the code block +beg-body --------- point at the beginning of the body +end-body --------- point at the end of the body" (declare (indent 1)) - `(let ((visited-p (get-file-buffer (expand-file-name ,file))) - to-be-removed) + `(let ((visited-p (or (null ,file) + (get-file-buffer (expand-file-name ,file)))) + (point (point)) to-be-removed) (save-window-excursion - (find-file ,file) + (when ,file (find-file ,file)) (setq to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward org-babel-src-block-regexp nil t) (goto-char (match-beginning 0)) - (save-match-data ,@body) - (goto-char (match-end 0)))) - (unless visited-p - (kill-buffer to-be-removed)))) + (let ((full-block (match-string 0)) + (beg-block (match-beginning 0)) + (end-block (match-end 0)) + (lang (match-string 2)) + (beg-lang (match-beginning 2)) + (end-lang (match-end 2)) + (switches (match-string 3)) + (beg-switches (match-beginning 3)) + (end-switches (match-end 3)) + (header-args (match-string 4)) + (beg-header-args (match-beginning 4)) + (end-header-args (match-end 4)) + (body (match-string 5)) + (beg-body (match-beginning 5)) + (end-body (match-end 5))) + ,@body + (goto-char end-block)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point))) (defvar org-file-properties) (defun org-babel-params-from-properties (&optional lang) @@ -680,7 +823,8 @@ (org-entry-get (point) header-arg t) (error nil)) (cdr (assoc header-arg org-file-properties)))) - (cons (intern (concat ":" header-arg)) val))) + (cons (intern (concat ":" header-arg)) + (org-babel-read val)))) (mapcar 'symbol-name (append @@ -757,30 +901,33 @@ "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" arg) (cons (intern (concat ":" (match-string 1 arg))) - (let ((raw (org-babel-chomp (match-string 2 arg)))) - (if (org-babel-number-p raw) - raw (org-babel-read raw)))) + (org-babel-read (org-babel-chomp (match-string 2 arg)))) (cons (intern (concat ":" arg)) nil))) (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))) (defun org-babel-process-params (params) - "Parse params and resolve references. - -Return a list (session vars result-params result-type colnames rownames)." - (let* ((session (cdr (assoc :session params))) - (vars-and-names (org-babel-disassemble-tables - (org-babel-ref-variables params) - (cdr (assoc :hlines params)) - (cdr (assoc :colnames params)) - (cdr (assoc :rownames params)))) - (vars (car vars-and-names)) - (colnames (cadr vars-and-names)) - (rownames (caddr vars-and-names)) - (result-params (split-string (or (cdr (assoc :results params)) ""))) - (result-type (cond ((member "output" result-params) 'output) - ((member "value" result-params) 'value) - (t 'value)))) - (list session vars result-params result-type colnames rownames))) + "Expand variables in PARAMS and add summary parameters." + (let* ((vars-and-names (org-babel-disassemble-tables + (mapcar (lambda (el) + (if (consp (cdr el)) + (cdr el) (org-babel-ref-parse (cdr el)))) + (org-babel-get-header params :var)) + (cdr (assoc :hlines params)) + (cdr (assoc :colnames params)) + (cdr (assoc :rownames params)))) + (result-params (append + (split-string (or (cdr (assoc :results params)) "")) + (cdr (assoc :result-params params))))) + (append + (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) + (list + (cons :colname-names (cadr vars-and-names)) + (cons :rowname-names (caddr vars-and-names)) + (cons :result-params result-params) + (cons :result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value)))) + (org-babel-get-header params :var 'other)))) ;; row and column names (defun org-babel-del-hlines (table) @@ -802,12 +949,14 @@ colnames, and the `cdr' of which contains a list of the column names. Note: this function removes any hlines in TABLE." (flet ((trans (table) (apply #'mapcar* #'list table))) - (let* ((width (apply 'max (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) + (let* ((width (apply 'max + (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) (table (trans (mapcar (lambda (row) (if (not (equal row 'hline)) row (setq row '()) - (dotimes (n width) (setq row (cons 'hline row))) + (dotimes (n width) + (setq row (cons 'hline row))) row)) table)))) (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row)) @@ -828,13 +977,18 @@ table)) (defun org-babel-pick-name (names selector) - "Select one out of an alist of row or column names." - (when names - (if (and selector (symbolp selector) (not (equal t selector))) - (cdr (assoc selector names)) - (if (integerp selector) - (nth (- selector 1) names) - (cdr (car (last names))))))) + "Select one out of an alist of row or column names. +SELECTOR can be either a list of names in which case those names +will be returned directly, or an index into the list NAMES in +which case the indexed names will be return." + (if (listp selector) + selector + (when names + (if (and selector (symbolp selector) (not (equal t selector))) + (cdr (assoc selector names)) + (if (integerp selector) + (nth (- selector 1) names) + (cdr (car (last names)))))))) (defun org-babel-disassemble-tables (vars hlines colnames rownames) "Parse tables for further processing. @@ -903,6 +1057,14 @@ (point)))))) ;;;###autoload +(defun org-babel-goto-src-block-head () + "Go to the beginning of the current code block." + (interactive) + ((lambda (head) + (if head (goto-char head) (error "not currently in a code block"))) + (org-babel-where-is-src-block-head))) + +;;;###autoload (defun org-babel-goto-named-src-block (name) "Go to a named source-code block." (interactive @@ -934,7 +1096,7 @@ (when file (find-file file)) (goto-char (point-min)) (let (names) (while (re-search-forward org-babel-src-name-w-name-regexp nil t) - (setq names (cons (org-babel-clean-text-properties (match-string 2)) + (setq names (cons (org-babel-clean-text-properties (match-string 3)) names))) names))) @@ -978,7 +1140,9 @@ With optional prefix argument ARG, jump forward ARG many source blocks." (interactive "P") (when (looking-at org-babel-src-block-regexp) (forward-char 1)) - (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) + (condition-case nil + (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) + (error (error "No further code blocks"))) (goto-char (match-beginning 0)) (org-show-context)) ;;;###autoload @@ -986,9 +1150,68 @@ "Jump to the previous source block. With optional prefix argument ARG, jump backward ARG many source blocks." (interactive "P") - (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) + (condition-case nil + (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) + (error (error "No previous code blocks"))) (goto-char (match-beginning 0)) (org-show-context)) +(defvar org-babel-load-languages) + +;;;###autoload +(defun org-babel-mark-block () + "Mark current src block" + (interactive) + ((lambda (head) + (when head + (save-excursion + (goto-char head) + (looking-at org-babel-src-block-regexp)) + (push-mark (match-end 5) nil t) + (goto-char (match-beginning 5)))) + (org-babel-where-is-src-block-head))) + +(defun org-babel-demarcate-block (&optional arg) + "Wrap or split the code in the region or on the point. +When called from inside of a code block the current block is +split. When called from outside of a code block a new code block +is created. In both cases if the region is demarcated and if the +region is not active then the point is demarcated." + (interactive "P") + (let ((info (org-babel-get-src-block-info 'light)) + (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) + (if info + (mapc + (lambda (place) + (save-excursion + (goto-char place) + (let ((lang (nth 0 info)) + (indent (make-string (nth 5 info) ? ))) + (when (string-match "^[[:space:]]*$" + (buffer-substring (point-at-bol) + (point-at-eol))) + (delete-region (point-at-bol) (point-at-eol))) + (insert (concat (if (looking-at "^") "" "\n") + indent "#+end_src\n" + (if arg stars indent) "\n" + indent "#+begin_src " lang + (if (looking-at "[\n\r]") "" "\n"))))) + (move-end-of-line 2)) + (sort (if (region-active-p) (list (mark) (point)) (list (point))) #'>)) + (let ((start (point)) + (lang (org-icompleting-read "Lang: " + (mapcar (lambda (el) (symbol-name (car el))) + org-babel-load-languages))) + (body (delete-and-extract-region + (if (region-active-p) (mark) (point)) (point)))) + (insert (concat (if (looking-at "^") "" "\n") + (if arg (concat stars "\n") "") + "#+begin_src " lang "\n" + body + (if (or (= (length body) 0) + (string-match "[\r\n]$" body)) "" "\n") + "#+end_src\n")) + (goto-char start) (move-end-of-line 1))))) + (defvar org-babel-lob-one-liner-regexp) (defun org-babel-where-is-src-block-result (&optional insert info hash indent) "Find where the current source block results begin. @@ -1050,7 +1273,7 @@ (if indent (mapconcat (lambda (el) " ") - (number-sequence 1 indent) "") + (org-number-sequence 1 indent) "") "") "#+results" (when hash (concat "["hash"]")) @@ -1130,7 +1353,12 @@ is a good option if you code block will output org-mode formatted text. -org ----- this is the same as the 'raw' option +org ----- similar in effect to raw, only the results are wrapped + in an org code block. Similar to the raw option, on + export the results will be interpreted as org-formatted + text, however by wrapping the results in an org code + block they can be replaced upon re-execution of the + code block. html ---- results are added inside of a #+BEGIN_HTML block. This is a good option if you code block will output html @@ -1151,73 +1379,79 @@ (when (member "file" result-params) (setq result (org-babel-result-to-file result)))) (unless (listp result) (setq result (format "%S" result)))) - (if (= (length result) 0) - (if (member "value" result-params) - (message "No result returned by source block") - (message "Source block produced no output")) - (if (and result-params (member "silent" result-params)) - (progn - (message (replace-regexp-in-string "%" "%%" (format "%S" result))) - result) - (when (and (stringp result) ;; ensure results end in a newline - (not (or (string-equal (substring result -1) "\n") - (string-equal (substring result -1) "\r")))) - (setq result (concat result "\n"))) - (save-excursion - (let ((existing-result (org-babel-where-is-src-block-result - t info hash indent)) - (results-switches - (cdr (assoc :results_switches (nth 2 info)))) - beg end) - (when existing-result - (goto-char existing-result) - (save-excursion - (re-search-forward "#" nil t) - (setq indent (- (current-column) 1))) - (forward-line 1) + (if (and result-params (member "silent" result-params)) + (progn + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (when (and (stringp result) ;; ensure results end in a newline + (> (length result) 0) + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) + (save-excursion + (let ((existing-result (org-babel-where-is-src-block-result + t info hash indent)) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + beg end) + (if (not existing-result) (setq beg (point)) - (cond - ((member "replace" result-params) - (delete-region (point) (org-babel-result-end))) - ((member "append" result-params) - (goto-char (org-babel-result-end)) (setq beg (point))) - ((member "prepend" result-params) ;; already there - ))) - (setq results-switches - (if results-switches (concat " " results-switches) "")) + (goto-char existing-result) + (save-excursion + (re-search-forward "#" nil t) + (setq indent (- (current-column) 1))) + (forward-line 1) + (setq beg (point)) (cond - ;; assume the result is a table if it's not a string - ((not (stringp result)) - (insert (concat (orgtbl-to-orgtbl - (if (or (eq 'hline (car result)) - (and (listp (car result)) - (listp (cdr (car result))))) - result (list result)) - '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) - (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((member "file" result-params) - (insert result)) - ((member "html" result-params) - (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" - results-switches result))) - ((member "latex" result-params) - (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" - results-switches result))) - ((member "code" result-params) - (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" - (or lang "none") results-switches result))) - ((or (member "raw" result-params) (member "org" result-params)) - (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) - (t - (org-babel-examplize-region - (point) (progn (insert result) (point)) results-switches))) - ;; possibly indent the results to match the #+results line - (setq end (if (listp result) (org-table-end) (point))) - (when (and indent (> indent 0) - ;; in this case `table-align' does the work for us - (not (and (listp result) - (member "append" result-params)))) - (indent-rigidly beg end indent)))) + ((member "replace" result-params) + (delete-region (point) (org-babel-result-end))) + ((member "append" result-params) + (goto-char (org-babel-result-end)) (setq beg (point))) + ((member "prepend" result-params) ;; already there + ))) + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (cond + ;; do nothing for an empty result + ((= (length result) 0)) + ;; assume the result is a table if it's not a string + ((not (stringp result)) + (insert (concat (orgtbl-to-orgtbl + (if (or (eq 'hline (car result)) + (and (listp (car result)) + (listp (cdr (car result))))) + result (list result)) + '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) + (goto-char beg) (when (org-at-table-p) (org-table-align))) + ((member "file" result-params) + (insert result)) + ((member "html" result-params) + (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" + results-switches result))) + ((member "latex" result-params) + (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" + results-switches result))) + ((member "code" result-params) + (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" + (or lang "none") results-switches result))) + ((member "org" result-params) + (insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result))) + ((member "raw" result-params) + (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) + (t + (org-babel-examplize-region + (point) (progn (insert result) (point)) results-switches))) + ;; possibly indent the results to match the #+results line + (setq end (if (listp result) (org-table-end) (point))) + (when (and indent (> indent 0) + ;; in this case `table-align' does the work for us + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)))) + (if (= (length result) 0) + (if (member "value" result-params) + (message "No result returned by source block") + (message "Source block produced no output")) (message "finished")))) (defun org-babel-remove-result (&optional info) @@ -1272,7 +1506,7 @@ (let ((size (count-lines beg end))) (save-excursion (cond ((= size 0) - (error (concat "This should be impossible:" + (error (concat "This should not be impossible:" "a newline was appended to result if missing"))) ((< size org-babel-min-lines-for-block-output) (goto-char beg) @@ -1286,6 +1520,14 @@ (forward-char (- end beg)) (insert "#+end_example\n")))))) +(defun org-babel-update-block-body (new-body) + "Update the body of the current code block to NEW-BODY." + (if (not (org-babel-where-is-src-block-head)) + (error "not in source block") + (save-match-data + (replace-match (concat (org-babel-trim new-body) "\n") nil nil nil 5)) + (indent-rigidly (match-beginning 5) (match-end 5) 2))) + (defun org-babel-merge-params (&rest plists) "Combine all parameter association lists in PLISTS. Later elements of PLISTS override the values of previous element. @@ -1298,7 +1540,7 @@ ("output" "value"))) (exports-exclusive-groups '(("code" "results" "both" "none"))) - params results exports tangle noweb cache vars var ref shebang comments) + params results exports tangle noweb cache vars shebang comments) (flet ((e-merge (exclusive-groups &rest result-params) ;; maintain exclusivity of mutually exclusive parameters (let (output) @@ -1318,63 +1560,60 @@ new-params)) result-params) output))) - (mapc (lambda (plist) - (mapc (lambda (pair) - (case (car pair) - (:var - ;; we want only one specification per variable - (when (string-match - (concat "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" - "[ \t]*\\([^\f\n\r\v]+\\)$") (cdr pair)) - ;; TODO: When is this not true? - (setq var (intern (match-string 1 (cdr pair))) - ref (match-string 2 (cdr pair)) - vars (cons (cons var ref) - (assq-delete-all var vars))))) - (:results - (setq results - (e-merge results-exclusive-groups - results (split-string (cdr pair))))) - (:file - (when (cdr pair) - (setq results (e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (e-merge exports-exclusive-groups - exports '("results")))) - (setq params - (cons pair - (assq-delete-all (car pair) params))))) - (:exports - (setq exports - (e-merge exports-exclusive-groups - exports (split-string (cdr pair))))) - (:tangle ;; take the latest -- always overwrite - (setq tangle (or (list (cdr pair)) tangle))) - (:noweb - (setq noweb - (e-merge '(("yes" "no")) noweb - (split-string (or (cdr pair) ""))))) - (:cache - (setq cache - (e-merge '(("yes" "no")) cache - (split-string (or (cdr pair) ""))))) - (:shebang ;; take the latest -- always overwrite - (setq shebang (or (list (cdr pair)) shebang))) - (:comments - (setq comments - (e-merge '(("yes" "no")) comments - (split-string (or (cdr pair) ""))))) - (t ;; replace: this covers e.g. :session - (setq params - (cons pair - (assq-delete-all (car pair) params)))))) - plist)) - plists)) - (setq vars (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars)) - (while vars (setq params (cons (cons :var (pop vars)) params))) + (mapc + (lambda (plist) + (mapc + (lambda (pair) + (case (car pair) + (:var + (let ((name (if (listp (cdr pair)) + (cadr pair) + (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + (cdr pair)) + (intern (match-string 1 (cdr pair))))))) + (when name + (setq vars + (cons (cons name pair) + (if (member name (mapcar #'car vars)) + (delq nil + (mapcar + (lambda (p) (unless (equal (car p) name) p)) + vars)) + vars)))))) + (:results + (setq results (e-merge results-exclusive-groups + results (split-string (cdr pair))))) + (:file + (when (cdr pair) + (setq results (e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (e-merge exports-exclusive-groups + exports '("results")))) + (setq params (cons pair (assq-delete-all (car pair) params))))) + (:exports + (setq exports (e-merge exports-exclusive-groups + exports (split-string (cdr pair))))) + (:tangle ;; take the latest -- always overwrite + (setq tangle (or (list (cdr pair)) tangle))) + (:noweb + (setq noweb (e-merge '(("yes" "no")) noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache (e-merge '(("yes" "no")) cache + (split-string (or (cdr pair) ""))))) + (:shebang ;; take the latest -- always overwrite + (setq shebang (or (list (cdr pair)) shebang))) + (:comments + (setq comments (e-merge '(("yes" "no")) comments + (split-string (or (cdr pair) ""))))) + (t ;; replace: this covers e.g. :session + (setq params (cons pair (assq-delete-all (car pair) params)))))) + plist)) + plists)) + (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) (cons (cons :comments (mapconcat 'identity comments " ")) (cons (cons :shebang (mapconcat 'identity shebang " ")) (cons (cons :cache (mapconcat 'identity cache " ")) @@ -1445,8 +1684,7 @@ #'identity (split-string (if evaluate - (let ((raw (org-babel-ref-resolve-reference - source-name nil))) + (let ((raw (org-babel-ref-resolve source-name))) (if (stringp raw) raw (format "%S" raw))) (save-restriction (widen) @@ -1497,14 +1735,14 @@ cell)) (defun org-babel-number-p (string) - "Return t if STRING represents a number." + "If STRING represents a number return it's value." (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string) (= (length (substring string (match-beginning 0) (match-end 0))) (length string))) (string-to-number string))) -(defun org-babel-import-elisp-from-file (file-name) +(defun org-babel-import-elisp-from-file (file-name &optional separator) "Read the results located at FILE-NAME into an elisp table. If the table is trivial, then return it as a scalar." (let (result) @@ -1512,7 +1750,7 @@ (with-temp-buffer (condition-case nil (progn - (org-table-import file-name nil) + (org-table-import file-name separator) (delete-file file-name) (setq result (mapcar (lambda (row) (mapcar #'org-babel-string-read row)) @@ -1569,21 +1807,77 @@ ;; bug in tramp (apply 'process-file program tmpfile buffer display args) (delete-file tmpfile))) - ;; org-babel-call-process-region-original is the original emacs definition. It - ;; is in scope from the let binding in org-babel-execute-src-block + ;; org-babel-call-process-region-original is the original emacs + ;; definition. It is in scope from the let binding in + ;; org-babel-execute-src-block (apply org-babel-call-process-region-original start end program delete buffer display args))) -(defun org-babel-maybe-remote-file (file) - "Conditionally parse information on a remote connnection. -If FILE specifies a remove file, then parse the information on -the remote connection." +(defun org-babel-local-file-name (file) + "Return the local name component of FILE." + (if (file-remote-p file) + (let (localname) + (with-parsed-tramp-file-name file nil + localname)) + file)) + +(defun org-babel-process-file-name (name &optional no-quote-p) + "Prepare NAME to be used in an external process. +If NAME specifies a remote location, the remote portion of the +name is removed, since in that case the process will be executing +remotely. The file name is then processed by +`expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, +the file name is additionally processed by +`shell-quote-argument'" + ((lambda (f) (if no-quote-p f (shell-quote-argument f))) + (expand-file-name (org-babel-local-file-name name)))) + +(defvar org-babel-temporary-directory) +(unless (or noninteractive (boundp 'org-babel-temporary-directory)) + (defvar org-babel-temporary-directory + (or (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + (make-temp-file "babel-" t)) + "Directory to hold temporary files created to execute code blocks. +Used by `org-babel-temp-file'. This directory will be removed on +Emacs shutdown.")) + +(defun org-babel-temp-file (prefix &optional suffix) + "Create a temporary file in the `org-babel-temporary-directory'. +Passes PREFIX and SUFFIX directly to `make-temp-file' with the +value of `temporary-file-directory' temporarily set to the value +of `org-babel-temporary-directory'." (if (file-remote-p default-directory) - (let* ((vec (tramp-dissect-file-name default-directory)) - (user (tramp-file-name-user vec)) - (host (tramp-file-name-host vec))) - (concat "/" user (when user "@") host ":" file)) - file)) + (make-temp-file + (concat (file-remote-p default-directory) + (expand-file-name + prefix temporary-file-directory) + nil suffix)) + (let ((temporary-file-directory + (or (and (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + temporary-file-directory))) + (make-temp-file prefix nil suffix)))) + +(defun org-babel-remove-temporary-directory () + "Remove `org-babel-temporary-directory' on Emacs shutdown." + (when (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory)) + ;; taken from `delete-directory' in files.el + (mapc (lambda (file) + ;; This test is equivalent to + ;; (and (file-directory-p fn) (not (file-symlink-p fn))) + ;; but more efficient + (if (eq t (car (file-attributes file))) + (delete-directory file) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files org-babel-temporary-directory 'full + "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + (delete-directory org-babel-temporary-directory))) + +(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) (provide 'ob)
--- a/lisp/org/org-agenda.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-agenda.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -62,6 +62,7 @@ (declare-function org-habit-parse-todo "org-habit" (&optional pom)) (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) (defvar calendar-mode-map) +(defvar org-clock-current-task) ; defined in org-clock.el (defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el (defvar org-habit-show-habits) (defvar org-habit-show-habits-only-for-today) @@ -749,6 +750,22 @@ :tag "Org Agenda Startup" :group 'org-agenda) +(defcustom org-agenda-menu-show-matcher t + "Non-nil menas show the match string in the agenda dispatcher menu. +When nil, the matcher string is not shown, but is put into the help-echo +property so than moving the mouse over the command shows it. +Setting it to nil is good if matcher strings are very long and/or if +you wnat to use two-column display (see `org-agenda-menu-two-column')." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-menu-two-column nil + "Non-nil means, use two columns to show custom commands in the dispatcher. +If you use this, you probably want to set `org-agenda-menu-show-matcher' +to nil." + :group 'org-agenda + :type 'boolean) + (defcustom org-finalize-agenda-hook nil "Hook run just before displaying an agenda buffer." :group 'org-agenda-startup @@ -1359,7 +1376,7 @@ "Regular expression used to filter away specific tags in agenda views. This means that these tags will be present, but not be shown in the agenda line. Secondary filtering will still work on the hidden tags. -The value nil means don't hide any tags." +Nil means don't hide any tags." :group 'org-agenda-line-format :type '(choice (const :tag "Hide none" nil) @@ -1471,6 +1488,18 @@ (require 'cl)) (require 'org) +(defmacro org-agenda-with-point-at-orig-entry (string &rest body) + "Execute BODY with point at location given by `org-hd-marker' property. +If STRING is non-nil, the text property will be fetched from position 0 +in that string. If STRING is nil, it will be fetched from the beginning +of the current line." + `(let ((marker (get-text-property (if string 0 (point-at-bol)) + 'org-hd-marker string))) + (with-current-buffer (marker-buffer marker) + (save-excursion + (goto-char marker) + ,@body)))) + (defun org-add-agenda-custom-command (entry) "Replace or add a command in `org-agenda-custom-commands'. This is mostly for hacking and trying a new command - once the command @@ -1651,7 +1680,7 @@ (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-agenda-mode-map "J" 'org-clock-goto) +(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto) (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) @@ -2073,7 +2102,8 @@ (custom org-agenda-custom-commands) (selstring "") restriction second-time - c entry key type match prefixes rmheader header-end custom1 desc) + c entry key type match prefixes rmheader header-end custom1 desc + line lines left right n n1) (save-window-excursion (delete-other-windows) (org-switch-to-buffer-other-window " *Agenda Commands*") @@ -2111,56 +2141,91 @@ (move-marker header-end (match-end 0))) (goto-char header-end) (delete-region (point) (point-max)) + + ;; Produce all the lines that describe custom commands and prefixes + (setq lines nil) (while (setq entry (pop custom1)) (setq key (car entry) desc (nth 1 entry) type (nth 2 entry) match (nth 3 entry)) (if (> (length key) 1) (add-to-list 'prefixes (string-to-char key)) - (insert - (format - "\n%-4s%-14s: %s" - (org-add-props (copy-sequence key) - '(face bold)) - (cond - ((string-match "\\S-" desc) desc) - ((eq type 'agenda) "Agenda for current week or day") - ((eq type 'alltodo) "List of all TODO entries") - ((eq type 'search) "Word search") - ((eq type 'stuck) "List of stuck projects") - ((eq type 'todo) "TODO keyword") - ((eq type 'tags) "Tags query") - ((eq type 'tags-todo) "Tags (TODO)") - ((eq type 'tags-tree) "Tags tree") - ((eq type 'todo-tree) "TODO kwd tree") - ((eq type 'occur-tree) "Occur tree") - ((functionp type) (if (symbolp type) - (symbol-name type) - "Lambda expression")) - (t "???")) - (cond - ((stringp match) - (setq match (copy-sequence match)) - (org-add-props match nil 'face 'org-warning)) - (match - (format "set of %d commands" (length match))) - (t "")))))) + (setq line + (format + "%-4s%-14s" + (org-add-props (copy-sequence key) + '(face bold)) + (cond + ((string-match "\\S-" desc) desc) + ((eq type 'agenda) "Agenda for current week or day") + ((eq type 'alltodo) "List of all TODO entries") + ((eq type 'search) "Word search") + ((eq type 'stuck) "List of stuck projects") + ((eq type 'todo) "TODO keyword") + ((eq type 'tags) "Tags query") + ((eq type 'tags-todo) "Tags (TODO)") + ((eq type 'tags-tree) "Tags tree") + ((eq type 'todo-tree) "TODO kwd tree") + ((eq type 'occur-tree) "Occur tree") + ((functionp type) (if (symbolp type) + (symbol-name type) + "Lambda expression")) + (t "???")))) + (if org-agenda-menu-show-matcher + (setq line + (concat line ": " + (cond + ((stringp match) + (setq match (copy-sequence match)) + (org-add-props match nil 'face 'org-warning)) + (match + (format "set of %d commands" (length match))) + (t "")))) + (if (org-string-nw-p match) + (add-text-properties + 0 (length line) (list 'help-echo + (concat "Matcher: "match)) line))) + (push line lines))) + (setq lines (nreverse lines)) (when prefixes (mapc (lambda (x) - (insert - (format "\n%s %s" + (push + (format "%s %s" (org-add-props (char-to-string x) - nil 'face 'bold) - (or (cdr (assoc (concat selstring (char-to-string x)) + nil 'face 'bold) + (or (cdr (assoc (concat selstring + (char-to-string x)) prefix-descriptions)) - "Prefix key")))) + "Prefix key")) + lines)) prefixes)) + + ;; Check if we should display in two columns + (if org-agenda-menu-two-column + (progn + (setq n (length lines) + n1 (+ (/ n 2) (mod n 2)) + right (nthcdr n1 lines) + left (copy-sequence lines)) + (setcdr (nthcdr (1- n1) left) nil)) + (setq left lines right nil)) + (while left + (insert "\n" (pop left)) + (when right + (if (< (current-column) 40) + (move-to-column 40 t) + (insert " ")) + (insert (pop right)))) + + ;; Make the window the right size (goto-char (point-min)) (if second-time (if (not (pos-visible-in-window-p (point-max))) (org-fit-window-to-buffer)) (setq second-time t) (org-fit-window-to-buffer)) + + ;; Ask for selection (message "Press key for agenda command%s:" (if (or restrict-ok org-agenda-overriding-restriction) (if org-agenda-overriding-restriction @@ -2450,16 +2515,15 @@ (interactive "FWrite agenda to file: \nP") (if (not (file-writable-p file)) (error "Cannot write agenda to file %s" file)) - (cond - ((string-match "\\.html?\\'" file) (require 'htmlize)) - ((string-match "\\.ps\\'" file) (require 'ps-print))) (org-let (if nosettings nil org-agenda-exporter-settings) - `(save-excursion + '(save-excursion (save-window-excursion (org-agenda-mark-filtered-text) (let ((bs (copy-sequence (buffer-string))) beg) (org-agenda-unmark-filtered-text) (with-temp-buffer + (rename-buffer "Agenda View" t) + (set-buffer-modified-p nil) (insert bs) (org-agenda-remove-marked-text 'org-filtered) (while (setq beg (text-property-any (point-min) (point-max) @@ -2472,6 +2536,7 @@ ((org-bound-and-true-p org-mobile-creating-agendas) (org-mobile-write-agenda-for-mobile file)) ((string-match "\\.html?\\'" file) + (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) (when (and org-agenda-export-html-style @@ -2486,18 +2551,17 @@ (message "HTML written to %s" file)) ((string-match "\\.ps\\'" file) (require 'ps-print) - ,(flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces file)) + (ps-print-buffer-with-faces file) (message "Postscript written to %s" file)) ((string-match "\\.pdf\\'" file) (require 'ps-print) - ,(flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces - (concat (file-name-sans-extension file) ".ps"))) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps")) (call-process "ps2pdf" nil nil nil (expand-file-name (concat (file-name-sans-extension file) ".ps")) (expand-file-name file)) + (delete-file (concat (file-name-sans-extension file) ".ps")) (message "PDF written to %s" file)) ((string-match "\\.ics\\'" file) (require 'org-icalendar) @@ -2563,7 +2627,9 @@ (setq txt (org-agenda-get-some-entry-text m org-agenda-add-entry-text-maxlines " > ")) (end-of-line 1) - (if (string-match "\\S-" txt) (insert "\n" txt))))))) + (if (string-match "\\S-" txt) + (insert "\n" txt) + (or (eobp) (forward-char 1)))))))) (defun org-agenda-get-some-entry-text (marker n-lines &optional indent &rest keep) @@ -2717,7 +2783,10 @@ This must be a list of strings, each string must be a single tag preceded by \"+\" or \"-\". This variable should not be set directly, but agenda custom commands can -bind it in the options section.") +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") (defun org-prepare-agenda (&optional name) (setq org-todo-keywords-for-agenda nil) @@ -2760,7 +2829,11 @@ (switch-to-buffer-other-frame abuf)) ((equal org-agenda-window-setup 'reorganize-frame) (delete-other-windows) - (org-switch-to-buffer-other-window abuf)))) + (org-switch-to-buffer-other-window abuf))) + ;; additional test in case agenda is invoked from within agenda + ;; buffer via elisp link + (unless (equal (current-buffer) abuf) + (switch-to-buffer abuf))) (setq buffer-read-only nil) (let ((inhibit-read-only t)) (erase-buffer)) (org-agenda-mode) @@ -3009,7 +3082,8 @@ (let* ((dopast t) (dotodo include-all) (doclosed org-agenda-show-log) - (entry buffer-file-name) + (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) + (current-buffer)))) (date (calendar-current-date)) (beg (if (org-region-active-p) (region-beginning) (point-min))) (end (if (org-region-active-p) (region-end) (point-max))) @@ -3031,8 +3105,7 @@ (setq day-numbers (delq nil (mapcar (lambda(x) (if (>= x today) x nil)) day-numbers)))) - (org-prepare-agenda (concat "Timeline " - (file-name-nondirectory buffer-file-name))) + (org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry))) (if doclosed (push :closed args)) (push :timestamp args) (push :deadline args) @@ -3483,6 +3556,20 @@ (member (string-to-char words) '(?- ?+ ?\{))) (setq boolean t)) (setq words (org-split-string words)) + (let (www w) + (while (setq w (pop words)) + (while (and (string-match "\\\\\\'" w) words) + (setq w (concat (substring w 0 -1) " " (pop words)))) + (push w www)) + (setq words (nreverse www) www nil) + (while (setq w (pop words)) + (when (and (string-match "\\`[-+]?{" w) + (not (string-match "}\\'" w))) + (while (and words (not (string-match "}\\'" (car words)))) + (setq w (concat w " " (pop words)))) + (setq w (concat w " " (pop words)))) + (push w www)) + (setq words (nreverse www))) (setq org-agenda-last-search-view-search-was-boolean boolean) (when boolean (let (wds w) @@ -3933,8 +4020,7 @@ "Create agenda view for projects that are stuck. Stuck projects are project that have no next actions. For the definitions of what a project is and how to check if it stuck, customize the variable -`org-stuck-projects'. -MATCH is being ignored." +`org-stuck-projects'." (interactive) (let* ((org-agenda-skip-function 'org-agenda-skip-entry-when-regexp-matches-in-subtree) @@ -3956,11 +4042,11 @@ "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") + (org-re "^\\*+ .*:[[:alnum:]_@#%]+:[ \t]*$") (if tags (concat "^\\*+ .*:\\(" (mapconcat 'identity tags "\\|") - (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))) + (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) (gen-re (nth 3 org-stuck-projects)) (re-list (delq nil @@ -4413,17 +4499,20 @@ category (org-get-category beg) todo-state (org-get-todo-state)) - (if (string-match "\\S-" result) - (setq txt result) - (setq txt "SEXP entry returned empty string")) - - (setq txt (org-format-agenda-item - "" txt category tags 'time)) - (org-add-props txt props 'org-marker marker) - (org-add-props txt nil - 'org-category category 'date date 'todo-state todo-state - 'type "sexp") - (push txt ee)))) + (dolist (r (if (stringp result) + (list result) + result)) ;; we expect a list here + (if (string-match "\\S-" r) + (setq txt r) + (setq txt "SEXP entry returned empty string")) + + (setq txt (org-format-agenda-item + "" txt category tags 'time)) + (org-add-props txt props 'org-marker marker) + (org-add-props txt nil + 'org-category category 'date date 'todo-state todo-state + 'type "sexp") + (push txt ee))))) (nreverse ee))) (defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) @@ -4919,7 +5008,7 @@ (setq h (/ m 60) m (- m (* h 60))) (setq s2 (format "%02d:%02d" h m)))) - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) ;; Tags are in the string (if (or (eq org-agenda-remove-tags t) @@ -4993,7 +5082,7 @@ The modified list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." (when (or add-inherited hide-re) - (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") txt) + (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) (setq txt (substring txt 0 (match-beginning 0)))) (setq tags (delq nil @@ -5049,13 +5138,13 @@ (throw 'exit list)) (while (setq time (pop gridtimes)) (unless (and remove (member time have)) - (setq time (int-to-string time)) + (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) (push (org-format-agenda-item nil string "" nil (concat (substring time 0 -2) ":" (substring time -2))) new) (put-text-property - 1 (length (car new)) 'face 'org-time-grid (car new)))) + 2 (length (car new)) 'face 'org-time-grid (car new)))) (if (member 'time-up org-agenda-sorting-strategy-selected) (append new list) (append list new))))) @@ -5142,11 +5231,33 @@ (int-to-string t0)))) (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) +(defvar org-agenda-before-sorting-filter-function nil + "Function to be applied to agenda items prior to sorting. +Prior to sorting also means just before they are inserted into the agenda. + +To aid sorting, you may revisit the original entries and add more text +properties which will later be used by the sorting functions. + +The function should take a string argument, an agenda line. +It has access to the text properties in that line, which contain among +other things, the property `org-hd-marker' that points to the entry +where the line comes from. Note that not all lines going into the agenda +have this property, only most. + +The function should return the modified string. It is probably best +to ONLY change text properties. + +You can also use this function as a filter, by returning nil for lines +you don't want to have in the agenda at all. For this application, you +could bind the variable in the options section of a custom command.") + (defun org-finalize-agenda-entries (list &optional nosort) "Sort and concatenate the agenda items." (setq list (mapcar 'org-agenda-highlight-todo list)) (if nosort list + (when org-agenda-before-sorting-filter-function + (setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list)))) (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) (defun org-agenda-highlight-todo (x) @@ -5312,8 +5423,9 @@ (alpha-up (and (org-em 'alpha-up 'alpha-down ss) (org-cmp-alpha a b))) (alpha-down (if alpha-up (- alpha-up) nil)) + (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) user-defined-up user-defined-down) - (if (and org-agenda-cmp-user-defined + (if (and need-user-cmp org-agenda-cmp-user-defined (functionp org-agenda-cmp-user-defined)) (setq user-defined-up (funcall org-agenda-cmp-user-defined a b) @@ -5635,7 +5747,9 @@ (if (not (eval org-agenda-filter-form)) (org-agenda-filter-by-tag-hide-line)) (beginning-of-line 2)) - (beginning-of-line 2)))))) + (beginning-of-line 2)))) + (if (get-char-property (point) 'invisible) + (org-agenda-previous-line)))) (defun org-agenda-filter-by-tag-hide-line () (let (ov) @@ -5712,7 +5826,9 @@ (defun org-agenda-goto-date (date) "Jump to DATE in agenda." - (interactive (list (org-read-date))) + (interactive (list (let ((org-read-date-prefer-future + (eval org-agenda-jump-prefer-future))) + (org-read-date)))) (org-agenda-list nil date)) (defun org-agenda-goto-today () @@ -6636,7 +6752,7 @@ (let ((inhibit-read-only t) l c) (save-excursion (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") + (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") (if line (point-at-eol) nil) t) (add-text-properties (match-beginning 2) (match-end 2) @@ -7059,9 +7175,9 @@ (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker))))) -(defun org-agenda-clock-out (&optional arg) +(defun org-agenda-clock-out () "Stop the currently running clock." - (interactive "P") + (interactive) (unless (marker-buffer org-clock-marker) (error "No running clock")) (let ((marker (make-marker)) newhead) @@ -7086,6 +7202,23 @@ (org-with-remote-undo (marker-buffer org-clock-marker) (org-clock-cancel))) +(defun org-agenda-clock-goto () + "Jump to the currently clocked in task within the agenda. +If the currently clocked in task is not listed in the agenda +buffer, display it in another window." + (interactive) + (let (pos) + (mapc (lambda (o) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (setq pos (overlay-start o)))) + (overlays-in (point-min) (point-max))) + (cond (pos (goto-char pos)) + ;; If the currently clocked entry is not in the agenda + ;; buffer, we visit it in another window: + (org-clock-current-task + (org-switch-to-buffer-other-window (org-clock-goto))) + (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) + (defun org-agenda-diary-entry-in-org-file () "Make a diary entry in the file `org-agenda-diary-file'." (let (d1 d2 char (text "") dp1 dp2) @@ -7171,7 +7304,8 @@ (let ((calendar-date-display-form (if (if (boundp 'calendar-date-style) (eq calendar-date-style 'european) - (org-bound-and-true-p european-calendar-style)) ; Emacs 22 + (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (org-bound-and-true-p european-calendar-style))) ; Emacs 22 '(day " " month " " year) '(month " " day " " year))))
--- a/lisp/org/org-archive.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-archive.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -115,7 +115,7 @@ ((or (re-search-backward re nil t) (re-search-forward re nil t)) (match-string 1)) - (t org-archive-location (match-string 1))))))) + (t org-archive-location)))))) (defun org-add-archive-files (files) "Splice the archive files into the list of files. @@ -268,7 +268,7 @@ (progn (if (re-search-forward (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) + (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")) nil t) (goto-char (match-end 0)) ;; Heading not found, just insert it at the end
--- a/lisp/org/org-ascii.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-ascii.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -311,7 +311,7 @@ :add-text (plist-get opt-plist :text)) "\n")) thetoc have-headings first-heading-pos - table-open table-buffer link-buffer link desc desc0 rpl wrap) + table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc) (let ((inhibit-read-only t)) (org-unmodified (remove-text-properties (point-min) (point-max) @@ -347,7 +347,7 @@ (if (and (or author email) org-export-author-info) - (insert(concat (nth 1 lang-words) ": " (or author "") + (insert (concat (nth 1 lang-words) ": " (or author "") (if (and org-export-email-info email (string-match "\\S-" email)) (concat " <" email ">") "") @@ -400,7 +400,7 @@ (if (and (memq org-export-with-tags '(not-in-toc nil)) (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") txt)) (setq txt (replace-match "" t t txt))) (if (string-match quote-re0 txt) @@ -431,10 +431,12 @@ ;; Remove the quoted HTML tags. (setq line (org-html-expand-for-ascii line)) ;; Replace links with the description when possible - (while (string-match org-bracket-link-regexp line) - (setq link (match-string 1 line) - desc0 (match-string 3 line) - desc (or desc0 (match-string 1 line))) + (while (string-match org-bracket-link-analytic-regexp++ line) + (setq path (match-string 3 line) + link (concat (match-string 1 line) path) + type (match-string 2 line) + desc0 (match-string 5 line) + desc (or desc0 link)) (if (and (> (length link) 8) (equal (substring link 0 8) "coderef:")) (setq line (replace-match @@ -443,15 +445,18 @@ (substring link 8) org-export-code-refs))) t t line)) - (setq rpl (concat "[" - (or (match-string 3 line) (match-string 1 line)) - "]")) - (when (and desc0 (not (equal desc0 link))) - (if org-export-ascii-links-to-notes - (push (cons desc0 link) link-buffer) - (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0 line))) - (length desc))))) + (setq rpl (concat "[" desc "]")) + (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + (setq rpl (or (save-match-data + (funcall fnc (org-link-unescape path) + desc0 'ascii)) + rpl)) + (when (and desc0 (not (equal desc0 link))) + (if org-export-ascii-links-to-notes + (push (cons desc0 link) link-buffer) + (setq rpl (concat rpl " (" link ")") + wrap (+ (length line) (- (length (match-string 0 line))) + (length desc)))))) (setq line (replace-match rpl t t line)))) (when custom-times (setq line (org-translate-time line))) @@ -482,7 +487,8 @@ (org-format-table-ascii table-buffer) "\n") "\n"))) (t - (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) + (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" + line) (setq line (replace-match "\\1\\3:" t nil line))) (setq line (org-fix-indentation line org-ascii-current-indentation)) ;; Remove forced line breaks @@ -571,9 +577,12 @@ (replace-match "\\1\\2"))) ;; Remove list start counters (goto-char (point-min)) - (while (re-search-forward "\\[@start:[0-9]+\\] ?" nil t) - (org-if-unprotected - (replace-match "")))) + (while (org-search-forward-unenclosed + "\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t) + (replace-match "")) + (remove-text-properties + (point-min) (point-max) + '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil))) (defun org-html-expand-for-ascii (line) "Handle quoted HTML for ASCII export." @@ -586,7 +595,7 @@ (defun org-ascii-replace-entities () "Replace entities with the ASCII representation." (let (e) - (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)" nil t) + (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t) (org-if-unprotected-at (match-beginning 1) (setq e (org-entity-get-representation (match-string 1) org-export-ascii-entities)) @@ -645,7 +654,7 @@ (insert "\n")) (setq char (nth (- umax level) (reverse org-export-ascii-underline))) (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match "" t t title)))) (if org-export-with-section-numbers (setq title (concat (org-section-number level) " " title)))
--- a/lisp/org/org-attach.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-attach.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-bbdb.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-bbdb.el Wed Nov 17 13:09:08 2010 +0900 @@ -7,7 +7,7 @@ ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -322,8 +322,8 @@ (when rec (let* ((class (or (nth 2 rec) org-bbdb-default-anniversary-format)) - (form (or (cdr (assoc class - org-bbdb-anniversary-format-alist)) + (form (or (cdr (assoc-string + class org-bbdb-anniversary-format-alist t)) class)) ; (as format string) (name (nth 1 rec)) (years (- y (car rec))) @@ -338,8 +338,7 @@ (setq text (append text (list tmp))) (setq text (list tmp))))) )) - (when text - (mapconcat 'identity text "; ")))) + text)) (defun org-bbdb-complete-link () "Read a bbdb link with name completion."
--- a/lisp/org/org-beamer.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-beamer.el Wed Nov 17 13:09:08 2010 +0900 @@ -2,7 +2,7 @@ ;; ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; -;; Version: 7.01 +;; Version: 7.3 ;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -373,7 +373,7 @@ (let (dovl) (goto-char (point-min)) (while (re-search-forward - "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|desctiption\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t) + "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t) (if (setq dovl (cdr (assoc "BEAMER_dovl" (get-text-property (match-end 0) 'org-props)))) @@ -382,7 +382,7 @@ (insert dovl))))))) (defun org-beamer-amend-header () - "Add `org-beamer-header-extra' to the LaTeX herder. + "Add `org-beamer-header-extra' to the LaTeX header. If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line by itself, it will be replaced with `org-beamer-header-extra'. If not, the value will be inserted right after the documentclass statement."
--- a/lisp/org/org-bibtex.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-bibtex.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Bastien Guerry <bzg at altern dot org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> ;; Keywords: org, wp, remember -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-capture.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-capture.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -185,6 +185,10 @@ which means that the new line should become the third line before the second horizontal separator line. + :kill-buffer If the target file was not yet visited by a buffer when + capture was invoked, kill the buffer again after capture + is finalized. + The template defines the text to be inserted. Often this is an org-mode entry (so the first line should start with a star) that will be filed as a child of the target headline. It can also be freely formatted text. @@ -220,20 +224,23 @@ Apart from these general escapes, you can access information specific to the link type that is created. For example, calling `org-capture' in emails or gnus will record the author and the subject of the message, which you -can access with \"%:author\" and \"%:subject\", respectively. Here is a +can access with \"%:from\" and \"%:subject\", respectively. Here is a complete list of what is recorded for each link type. -Link type | Available information --------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" +Link type | Available information +------------------------+------------------------------------------------------ +bbdb | %:type %:name %:company +vm, wl, mh, mew, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:fromto (either \"to NAME\" or \"from NAME\") + | %:date + | %:date-timestamp (as active timestamp) + | %:date-timestamp-inactive (as inactive timestamp) +gnus | %:group, for messages also all email fields +w3, w3m | %:type %:url +info | %:type %:file %:node +calendar | %:type %:date" :group 'org-capture :type '(repeat @@ -289,7 +296,7 @@ (file :tag "Template file")) (list :tag "Function" (const :format "" function) - (file :tag "Template function"))) + (function :tag "Template function"))) (plist :inline t ;; Give the most common options as checkboxes :options (((const :format "%v " :prepend) (const t)) @@ -297,7 +304,8 @@ ((const :format "%v " :empty-lines) (const 1)) ((const :format "%v " :clock-in) (const t)) ((const :format "%v " :clock-resume) (const t)) - ((const :format "%v " :unnarrowed) (const t)))))))) + ((const :format "%v " :unnarrowed) (const t)) + ((const :format "%v " :kill-buffer) (const t)))))))) (defcustom org-capture-before-finalize-hook nil "Hook that is run right before a remember process is finalized. @@ -382,6 +390,11 @@ (initial (and (org-region-active-p) (buffer-substring (point) (mark)))) (entry (org-capture-select-template keys))) + (when (stringp initial) + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (when (stringp annotation) + (remove-text-properties 0 (length annotation) + '(read-only t) annotation)) (cond ((equal entry "C") (customize-variable 'org-capture-templates)) @@ -467,8 +480,9 @@ (markerp (org-capture-get :interrupted-clock 'local)) (buffer-live-p (marker-buffer (org-capture-get :interrupted-clock 'local)))) - (org-with-point-at (org-capture-get :interrupted-clock 'local) - (org-clock-in)) + (let ((clock-in-task (org-capture-get :interrupted-clock 'local))) + (org-with-point-at clock-in-task + (org-clock-in))) (message "Interrupted clock has been resumed"))) (let ((beg (point-min)) @@ -519,14 +533,25 @@ ;; Kill the indirect buffer (save-buffer) - (let ((return-wconf (org-capture-get :return-to-wconf 'local))) + (let ((return-wconf (org-capture-get :return-to-wconf 'local)) + (new-buffer (org-capture-get :new-buffer 'local)) + (kill-buffer (org-capture-get :kill-buffer 'local)) + (base-buffer (buffer-base-buffer (current-buffer)))) + + ;; Kill the indiret buffer (kill-buffer (current-buffer)) + + ;; Kill the target buffer if that is desired + (when (and base-buffer new-buffer kill-buffer) + (with-current-buffer base-buffer (save-buffer)) + (kill-buffer base-buffer)) + ;; Restore the window configuration before capture (set-window-configuration return-wconf)) (when abort-note (cond ((equal abort-note 'clean) - (message "Capture process aborted and target file cleaned up")) + (message "Capture process aborted and target buffer cleaned up")) ((equal abort-note 'dirty) (error "Capture process aborted, but target buffer could not be cleaned up correctly")))))) @@ -588,6 +613,8 @@ (set-buffer (org-capture-target-buffer (nth 1 target))) (let ((hd (nth 2 target))) (goto-char (point-min)) + (unless (org-mode-p) + (error "Target buffer for file+headline should be in Org mode")) (if (re-search-forward (format org-complex-heading-regexp-format (regexp-quote hd)) nil t) @@ -651,8 +678,12 @@ (defun org-capture-target-buffer (file) "Get a buffer for FILE." + (setq file (or (org-string-nw-p file) + org-default-notes-file + (error "No notes file specified, and no default available"))) (or (org-find-base-buffer-visiting file) - (find-file-noselect (expand-file-name file org-directory)))) + (progn (org-capture-put :new-buffer t) + (find-file-noselect (expand-file-name file org-directory))))) (defun org-capture-steal-local-variables (buffer) "Install Org-mode local variables." @@ -666,6 +697,7 @@ (delete-other-windows) (org-switch-to-buffer-other-window (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) + (widen) (show-all) (goto-char (org-capture-get :pos)) (org-set-local 'org-capture-target-marker @@ -676,7 +708,8 @@ ((nil entry) (org-capture-place-entry)) (table-line (org-capture-place-table-line)) (plain (org-capture-place-plain-text)) - (item (org-capture-place-item)))) + (item (org-capture-place-item)) + (checkitem (org-capture-place-item)))) (org-capture-mode 1) (org-set-local 'org-capture-current-plist org-capture-plist)) @@ -695,7 +728,8 @@ (setq level 1) (if reversed (progn (goto-char (point-min)) - (outline-next-heading)) + (or (org-at-heading-p) + (outline-next-heading))) (goto-char (point-max)) (or (bolp) (insert "\n")))) (t @@ -718,6 +752,7 @@ (setq end (point)) (org-capture-mark-kill-region beg (1- end)) (org-capture-narrow beg (1- end)) + (goto-char beg) (if (re-search-forward "%\\?" end t) (replace-match "")))) (defun org-capture-place-item () @@ -738,14 +773,14 @@ (if (org-capture-get :prepend) (progn (goto-char beg) - (if (re-search-forward (concat "^" (org-item-re)) nil t) + (if (org-search-forward-unenclosed org-item-beginning-re end t) (progn (goto-char (match-beginning 0)) (setq ind (org-get-indentation))) (goto-char end) (setq ind 0))) (goto-char end) - (if (re-search-backward (concat "^" (org-item-re)) nil t) + (if (org-search-backward-unenclosed org-item-beginning-re beg t) (progn (setq ind (org-get-indentation)) (org-end-of-item)) @@ -929,7 +964,7 @@ (let ((pos (point))) (org-back-over-empty-lines) (delete-region (point) pos) - (newline n))) + (if (> n 0) (newline n)))) (defun org-capture-empty-lines-after (&optional n) "Arrange for the correct number of empty lines after the inserted string. @@ -938,7 +973,7 @@ (org-back-over-empty-lines) (while (looking-at "[ \t]*\n") (replace-match "")) (let ((pos (point))) - (newline n) + (if (> n 0) (newline n)) (goto-char pos))) (defvar org-clock-marker) ; Defined in org.el @@ -967,7 +1002,7 @@ (insert template) (org-capture-empty-lines-after) (goto-char beg) - (org-maybe-renumber-ordered-list) + (org-list-repair) (org-end-of-item) (setq end (point))) (t (insert template))) @@ -1023,17 +1058,19 @@ (defun org-capture-select-template (&optional keys) "Select a capture template. Lisp programs can force the template by setting KEYS to a string." - (when org-capture-templates - (if keys - (or (assoc keys org-capture-templates) - (error "No capture template referred to by \"%s\" keys" keys)) - (if (= 1 (length org-capture-templates)) - (car org-capture-templates) - (org-mks org-capture-templates - "Select a capture template\n=========================" - "Template key: " - '(("C" "Customize org-capture-templates") - ("q" "Abort"))))))) + (if org-capture-templates + (if keys + (or (assoc keys org-capture-templates) + (error "No capture template referred to by \"%s\" keys" keys)) + (if (= 1 (length org-capture-templates)) + (car org-capture-templates) + (org-mks org-capture-templates + "Select a capture template\n=========================" + "Template key: " + '(("C" "Customize org-capture-templates") + ("q" "Abort"))))) + ;; Use an arbitrary default template + '("t" "Task" entry (file+headline "" "Tasks") "* TODO %?\n %u\n %a"))) (defun org-capture-fill-template (&optional template initial annotation) "Fill a template and return the filled template as a string. @@ -1098,6 +1135,7 @@ (plist-put org-store-link-plist :annotation v-a) org-store-link-plist (plist-put org-store-link-plist :initial v-i)) + (setq initial v-i) (unless template (setq template "") (message "No template") (ding) (sit-for 1)) @@ -1138,6 +1176,7 @@ (insert result))))) ;; Simple %-escapes + (goto-char (point-min)) (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) (unless (org-capture-escaped-%) (when (and initial (equal (match-string 0) "%i")) @@ -1181,6 +1220,7 @@ "org-capture-template-prompt-history::" (or prompt ""))) completions (mapcar 'list completions))) + (unless (boundp histvar) (set histvar nil)) (cond ((member char '("G" "g")) (let* ((org-last-tags-completion-table @@ -1195,12 +1235,13 @@ 'org-tags-history))) (setq ins (mapconcat 'identity (org-split-string - ins (org-re "[^[:alnum:]_@]+")) + ins (org-re "[^[:alnum:]_@#%]+")) ":")) (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":")) (insert ins) - (or (equal (char-after) ?:) (insert ":"))))) + (or (equal (char-after) ?:) (insert ":")) + (and (org-on-heading-p) (org-set-tags nil 'align))))) ((equal char "C") (cond ((= (length clipboards) 1) (insert (car clipboards))) ((> (length clipboards) 1)
--- a/lisp/org/org-clock.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-clock.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -35,6 +35,7 @@ (require 'cl)) (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) +(declare-function notifications-notify "notifications" (&rest params)) (defvar org-time-stamp-formats) (defgroup org-clock nil @@ -557,6 +558,14 @@ ((stringp org-show-notification-handler) (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) + ((featurep 'notifications) + (require 'notifications) + (notifications-notify + :title "Org-mode message" + :body notification + ;; FIXME how to link to the Org icon? + ;; :app-icon "~/.emacs.d/icons/mail.png" + :urgency 'low)) ((org-program-exists "notify-send") (start-process "emacs-timer-notification" nil "notify-send" notification)) @@ -950,7 +959,7 @@ ;; We are interrupting the clocking of a different task. ;; Save a marker to this task, so that we can go back. ;; First check if we are trying to clock into the same task! - (if (save-excursion + (when (save-excursion (unless selected-task (org-back-to-heading t)) (and (equal (marker-buffer org-clock-hd-marker) @@ -961,13 +970,13 @@ (if selected-task (marker-position selected-task) (point))))) - (message "Clock continues in \"%s\"" org-clock-heading) - (progn - (move-marker org-clock-interrupted-task - (marker-position org-clock-marker) - (org-clocking-buffer)) - (let ((org-clock-clocking-in t)) - (org-clock-out t))))) + (message "Clock continues in \"%s\"" org-clock-heading) + (throw 'abort nil)) + (move-marker org-clock-interrupted-task + (marker-position org-clock-marker) + (marker-buffer org-clock-marker)) + (let ((org-clock-clocking-in t)) + (org-clock-out t))) (when (equal select '(16)) ;; Mark as default clocking task @@ -1098,6 +1107,7 @@ (defun org-clock-set-current () "Set `org-clock-current-task' to the task currently clocked in." (setq org-clock-current-task (nth 4 (org-heading-components)))) + (defun org-clock-delete-current () "Reset `org-clock-current-task' to nil." (setq org-clock-current-task nil)) @@ -1830,6 +1840,7 @@ (org-prepare-agenda-buffers files) (while (setq file (pop files)) (with-current-buffer (find-buffer-visiting file) + (setq org-clock-file-total-minutes 0) (setq tbl1 (org-dblock-write:clocktable p1)) (when tbl1 (push (org-clocktable-add-file @@ -1862,7 +1873,7 @@ (when (setq time (get-text-property p :org-clock-minutes)) (save-excursion (beginning-of-line 1) - (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$")) + (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))) (<= level maxlevel)) @@ -1970,10 +1981,22 @@ (when block (setq cc (org-clock-special-range block nil t) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (if ts (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))))) - (if te (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te))))) + (cond + ((numberp ts) + ;; If ts is a number, it's an absolute day number from org-agenda. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) + (setq ts (org-float-time (encode-time 0 0 0 day month year))))) + (ts + (setq ts (org-float-time + (apply 'encode-time (org-parse-time-string ts)))))) + (cond + ((numberp te) + ;; Likewise for te. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) + (setq te (org-float-time (encode-time 0 0 0 day month year))))) + (te + (setq te (org-float-time + (apply 'encode-time (org-parse-time-string te)))))) (setq p1 (plist-put p1 :header "")) (setq p1 (plist-put p1 :step nil)) (setq p1 (plist-put p1 :block nil))
--- a/lisp/org/org-colview.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-colview.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -228,7 +228,9 @@ (overlay-put ov 'org-columns-value (cdr ass)) (overlay-put ov 'org-columns-value-modified modval) (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f)) + (overlay-put ov 'org-columns-format f) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "")) (if (or (not (char-after beg)) (equal (char-after beg) ?\n)) (let ((inhibit-read-only t)) @@ -241,6 +243,8 @@ (overlay-put ov 'invisible t) (overlay-put ov 'keymap org-columns-map) (overlay-put ov 'intangible t) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") (push ov org-columns-overlays) (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) (overlay-put ov 'keymap org-columns-map) @@ -464,7 +468,7 @@ (call-interactively 'org-schedule)))) ((equal key "BEAMER_env") (setq eval '(org-with-point-at pom - (call-interactively 'org-beamer-set-environment-tag)))) + (call-interactively 'org-beamer-select-environment)))) (t (setq allowed (org-property-get-allowed-values pom key 'table)) (if allowed @@ -515,7 +519,7 @@ (txt (match-string 3)) (post "") txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt) + (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) (setq post (match-string 0 txt) txt (substring txt 0 (match-beginning 0)))) (setq txt2 (read-string "Edit: " txt)) @@ -746,7 +750,8 @@ ("@max" max_age max (lambda (x) (- org-columns-time x))) ("@mean" mean_age (lambda (&rest x) (/ (apply '+ x) (float (length x)))) - (lambda (x) (- org-columns-time x)))) + (lambda (x) (- org-columns-time x))) + ("est+" estimate org-estimate-combine)) "Operator <-> format,function,calc map. Used to compile/uncompile columns format and completing read in interactive function `org-columns-new'. @@ -1031,6 +1036,7 @@ (defun org-columns-number-to-string (n fmt &optional printf) "Convert a computed column number to a string value, according to FMT." (cond + ((memq fmt '(estimate)) (org-estimate-print n printf)) ((not (numberp n)) "") ((memq fmt '(add_times max_times min_times mean_times)) (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) @@ -1054,28 +1060,30 @@ (format "[%d/%d]" n m) (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m))))))) + (defun org-columns-string-to-number (s fmt) "Convert a column value to a number that can be used for column computing." (if s (cond ((memq fmt '(min_age max_age mean_age)) - (cond ((string= s "") org-columns-time) - ((string-match - "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" - s) - (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - (string-to-number (match-string 3 s)))) - (string-to-number (match-string 4 s)))) - (t (time-to-number-of-days (apply 'encode-time - (org-parse-time-string s t)))))) + (cond ((string= s "") org-columns-time) + ((string-match + "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" + s) + (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) + (string-to-number (match-string 2 s)))) + (string-to-number (match-string 3 s)))) + (string-to-number (match-string 4 s)))) + (t (time-to-number-of-days (apply 'encode-time + (org-parse-time-string s t)))))) ((string-match ":" s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum)) ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) - (if (equal s "[X]") 1. 0.000001)) + (if (equal s "[X]") 1. 0.000001)) + ((memq fmt '(estimate)) (org-string-to-estimate s)) (t (string-to-number s))))) (defun org-columns-uncompile-format (cfmt) @@ -1491,6 +1499,41 @@ (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) "")) +(defun org-estimate-mean-and-var (v) + "Return the mean and variance of an estimate." + (let* ((low (float (car v))) + (high (float (cadr v))) + (mean (/ (+ low high) 2.0)) + (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) + (list mean var))) + +(defun org-estimate-combine (&rest el) + "Combine a list of estimates, using mean and variance. +The mean and variance of the result will be the sum of the means +and variances (respectively) of the individual estimates." + (let ((mean 0) + (var 0)) + (mapc (lambda (e) + (let ((stats (org-estimate-mean-and-var e))) + (setq mean (+ mean (car stats))) + (setq var (+ var (cadr stats))))) + el) + (let ((stdev (sqrt var))) + (list (- mean stdev) (+ mean stdev))))) + +(defun org-estimate-print (e &optional fmt) + "Prepare a string representation of an estimate. +This formats these numbers as two numbers with a \"-\" between them." + (if (null fmt) (set 'fmt "%.0f")) + (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))) + +(defun org-string-to-estimate (s) + "Convert a string to an estimate. +The string should be two numbers joined with a \"-\"." + (if (string-match "\\(.*\\)-\\(.*\\)" s) + (list (string-to-number (match-string 1 s)) + (string-to-number(match-string 2 s))) + (list (string-to-number s) (string-to-number s)))) (provide 'org-colview)
--- a/lisp/org/org-compat.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-compat.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -162,6 +162,15 @@ (let ((x (org-get-x-clipboard-compat value))) (if x (org-no-properties x))))) +(defsubst org-decompose-region (beg end) + "Decompose from BEG to END." + (if (featurep 'xemacs) + (let ((modified-p (buffer-modified-p)) + (buffer-read-only nil)) + (remove-text-properties beg end '(composition nil)) + (set-buffer-modified-p modified-p)) + (decompose-region beg end))) + ;; Miscellaneous functions (defun org-add-hook (hook function &optional append local) @@ -197,6 +206,26 @@ (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) +(defun org-number-sequence (from &optional to inc) + "Call `number-sequence or emulate it." + (if (fboundp 'number-sequence) + (number-sequence from to inc) + (if (or (not to) (= from to)) + (list from) + (or inc (setq inc 1)) + (when (zerop inc) (error "The increment can not be zero")) + (let (seq (n 0) (next from)) + (if (> inc 0) + (while (<= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc)))) + (while (>= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc))))) + (nreverse seq))))) + ;; Region compatibility (defvar org-ignore-region nil @@ -353,7 +382,7 @@ (if (fboundp 'looking-at-p) (apply 'looking-at-p args) (save-match-data - (apply 'looking-at-p args)))) + (apply 'looking-at args)))) ; XEmacs does not have `looking-back'. (if (fboundp 'looking-back)
--- a/lisp/org/org-crypt.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-crypt.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; Emacs Lisp Archive Entry ;; Filename: org-crypt.el -;; Version: 7.01 +;; Version: 7.3 ;; Keywords: org-mode ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: Peter Jones <pjones@pmade.com>
--- a/lisp/org/org-ctags.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-ctags.el Wed Nov 17 13:09:08 2010 +0900 @@ -3,10 +3,10 @@ ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Paul Sexton <eeeickythump@gmail.com> -;; Version: 7.01 +;; Version: 7.3 ;; Keywords: org, wp -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-datetree.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-datetree.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-docbook.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-docbook.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-docbook.el -;; Version: 7.01 +;; Version: 7.3 ;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Keywords: org, wp, docbook @@ -552,9 +552,9 @@ (nth 2 (assoc "=" org-export-docbook-emphasis-alist))) table-open type table-buffer table-orig-buffer - ind item-type starter didclose + ind item-type starter rpl path attr caption label desc descp desc1 desc2 link - fnc item-tag initial-number + fnc item-tag item-number footref-seen footnote-list id-file ) @@ -671,7 +671,21 @@ (org-export-docbook-open-para)) (throw 'nextline nil)) - (org-export-docbook-close-lists-maybe line) + ;; List ender: close every open list. + (when (equal "ORG-LIST-END" line) + (while local-list-type + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type)) + ;; We did close a list, normal text follows: need <para> + (org-export-docbook-open-para) + (setq local-list-indent nil + in-local-list nil) + (throw 'nextline nil)) ;; Protected HTML (when (get-text-property 0 'org-protected line) @@ -963,18 +977,6 @@ txt (match-string 2 line)) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) (org-export-docbook-level-start level txt) ;; QUOTES (when (string-match quote-re line) @@ -1003,7 +1005,9 @@ table-orig-buffer (nreverse table-orig-buffer)) (org-export-docbook-close-para-maybe) (insert (org-export-docbook-finalize-table - (org-format-table-html table-buffer table-orig-buffer))))) + (org-format-table-html table-buffer table-orig-buffer + 'no-css))))) + (t ;; Normal lines (when (string-match @@ -1020,34 +1024,14 @@ (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) item-tag nil - initial-number nil) - (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) - (setq initial-number (match-string 1 line) + item-number nil) + (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) + (setq item-number (match-string 1 line) line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) line (substring line (match-end 0)))) - (when (and (not (equal item-type "d")) - (not (string-match "[^ \t]" line))) - ;; Empty line. Pretend indentation is large. - (setq ind (if org-empty-line-terminates-plain-lists - 0 - (1+ (or (car local-list-indent) 1))))) - (setq didclose nil) - (while (and in-local-list - (or (and (= ind (car local-list-indent)) - (not starter)) - (< ind (car local-list-indent)))) - (setq didclose t) - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) (cond ((and starter (or (not in-local-list) @@ -1056,7 +1040,7 @@ (org-export-docbook-close-para-maybe) (insert (cond ((equal item-type "u") "<itemizedlist>\n<listitem>\n") - ((equal item-type "o") + ((and (equal item-type "o") item-number) ;; Check for a specific start number. If it ;; is specified, we use the ``override'' ;; attribute of element <listitem> to pass the @@ -1064,10 +1048,8 @@ ;; ``startingnumber'' attribute of element ;; <orderedlist>, but the former works on both ;; DocBook 5.0 and prior versions. - (if initial-number - (format "<orderedlist>\n<listitem override=\"%s\">\n" - initial-number) - "<orderedlist>\n<listitem>\n")) + (format "<orderedlist>\n<listitem override=\"%s\">\n" item-number)) + ((equal item-type "o") "<orderedlist>\n<listitem>\n") ((equal item-type "d") (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag)))) ;; For DocBook, we need to open a para right after tag @@ -1076,11 +1058,27 @@ (push item-type local-list-type) (push ind local-list-indent) (setq in-local-list t)) + ;; Continue current list (starter - ;; Continue current list + ;; terminate any previous sublist but first ensure + ;; list is not ill-formed + (let ((min-ind (apply 'min local-list-indent))) + (when (< ind min-ind) (setq ind min-ind))) + (while (< ind (car local-list-indent)) + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + ;; insert new item (let ((listtype (car local-list-type))) (org-export-docbook-close-li listtype) (insert (cond + ((and (equal listtype "o") item-number) + (format "<listitem override=\"%s\">" item-number)) ((equal listtype "o") "<listitem>") ((equal listtype "u") "<listitem>") ((equal listtype "d") (format @@ -1089,9 +1087,6 @@ "???")))))) ;; For DocBook, we need to open a para right after tag ;; <listitem>. - (org-export-docbook-open-para)) - (didclose - ;; We did close a list, normal text follows: need <para> (org-export-docbook-open-para))) ;; Checkboxes. (if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line) @@ -1134,18 +1129,7 @@ (when inquote (insert "]]></programlisting>\n") (org-export-docbook-open-para)) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) + ;; Close all open sections. (org-export-docbook-level-start 1 nil) @@ -1212,24 +1196,6 @@ (defvar in-local-list) (defvar local-list-indent) (defvar local-list-type) -(defun org-export-docbook-close-lists-maybe (line) - (let ((ind (or (get-text-property 0 'original-indentation line))) -; (and (string-match "\\S-" line) -; (org-get-indentation line)))) - didclose) - (when ind - (while (and in-local-list - (<= ind (car local-list-indent))) - (setq didclose t) - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - (and didclose (org-export-docbook-open-para))))) (defun org-export-docbook-level-start (level title) "Insert a new level in DocBook export. @@ -1249,7 +1215,7 @@ ;; all levels, so the rest is done only if title is given. ;; ;; Format tags: put them into a superscript like format. - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match (if org-export-with-tags @@ -1273,7 +1239,7 @@ Applies all active conversions. If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) m s l res) (while (setq m (string-match re string)) (setq s (substring string 0 m)
--- a/lisp/org/org-docview.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-docview.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Jan Böcker <jan.boecker at jboecker dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -45,7 +45,10 @@ (require 'org) -(eval-when-compile (require 'doc-view)) ; doc-view-current-page macro + +(declare-function doc-view-goto-page "ext:doc-view" (page)) +(declare-function image-mode-window-get "ext:image-mode" + (prop &optional winprops)) (autoload 'doc-view-goto-page "doc-view") @@ -66,7 +69,7 @@ (when (eq major-mode 'doc-view-mode) ;; This buffer is in doc-view-mode (let* ((path buffer-file-name) - (page (doc-view-current-page)) + (page (image-mode-window-get 'page)) (link (concat "docview:" path "::" (number-to-string page))) (description "")) (org-store-link-props
--- a/lisp/org/org-entities.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-entities.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Ulf Stegemann <ulf at zeitform dot de> ;; Keywords: outlines, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-exp-blocks.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-exp-blocks.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Eric Schulte -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. ;; @@ -201,7 +201,8 @@ (interblock start (point-max)) (run-hooks 'org-export-blocks-postblock-hook))))) -(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) +(add-hook 'org-export-preprocess-after-include-files-hook + 'org-export-blocks-preprocess) ;;================================================================================ ;; type specific functions
--- a/lisp/org/org-exp.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-exp.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -181,7 +181,7 @@ ("no" "Forfatter" "Dato" "Innhold" "Fotnoter") ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l) ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk) - ("pl" "Autor" "Data" "Spis treści" "Przypis") + ("pl" "Autor" "Data" "Spis treści" "Przypis") ("sv" "Författare" "Datum" "Innehåll" "Fotnoter")) "Terms used in export text, translated to different languages. Use the variable `org-export-default-language' to set the language, @@ -417,6 +417,10 @@ This is run after blockquote/quote/verse/center have been marked with cookies.") +(defvar org-export-preprocess-after-radio-targets-hook nil + "Hook for preprocessing an export buffer. +This is run after radio target processing.") + (defvar org-export-preprocess-before-normalizing-links-hook nil "Hook for preprocessing an export buffer. This hook is run before links are normalized.") @@ -467,20 +471,34 @@ :group 'org-export-latex :type 'boolean) -(defcustom org-export-with-LaTeX-fragments nil - "Non-nil means convert LaTeX fragments to images when exporting to HTML. -When set, the exporter will find LaTeX environments if the \\begin line is -the first non-white thing on a line. It will also find the math delimiters -like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for -display math. +(defcustom org-export-with-LaTeX-fragments t + "Non-nil means process LaTeX math fragments for HTML display. +When set, the exporter will find and process LaTeX environments if the +\\begin line is the first non-white thing on a line. It will also find +and process the math delimiters like $a=b$ and \\( a=b \\) for inline math, +$$a=b$$ and \\[ a=b \\] for display math. + +This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\". -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\". +Allowed values are: + +nil Don't do anything. +verbatim Keep eveything in verbatim +dvipng Process the LaTeX fragments to images. + This will also include processing of non-math environments. +t Do MathJax preprocessing if there is at least on math snippet, + and arrange for MathJax.js to be loaded. The default is nil, because this option needs the `dvipng' program which is not available on all systems." :group 'org-export-translation :group 'org-export-latex - :type 'boolean) + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Obsolete, use dvipng setting" t) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) (defcustom org-export-with-fixed-width t "Non-nil means lines starting with \":\" will be in fixed width font. @@ -671,12 +689,14 @@ (let ((re (org-make-options-regexp (append '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE" + "MATHJAX" "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER" "LATEX_CLASS" "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT") (mapcar 'car org-export-inbuffer-options-extra)))) - p key val text options a pr style + (case-fold-search t) + p key val text options mathjax a pr style latex-header latex-class macros letbind ext-setup-or-nil setup-contents (start 0)) (while (or (and ext-setup-or-nil @@ -708,6 +728,8 @@ (setq text (if text (concat text "\n" val) val))) ((string-equal key "OPTIONS") (setq options (concat val " " options))) + ((string-equal key "MATHJAX") + (setq mathjax (concat val " " mathjax))) ((string-equal key "BIND") (push (read (concat "(" val ")")) letbind)) ((string-equal key "XSLT") @@ -744,9 +766,12 @@ (setq p (plist-put p :latex-class latex-class))) (when options (setq p (org-export-add-options-to-plist p options))) + (when mathjax + (setq p (plist-put p :mathjax mathjax))) ;; Add macro definitions (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))")) (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))")) + (setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))")) (setq p (plist-put p :macro-modification-time (and (buffer-file-name) @@ -1052,6 +1077,9 @@ (plist-get parameters :exclude-tags)) (run-hooks 'org-export-preprocess-after-tree-selection-hook) + ;; Mark end of lists + (org-export-mark-list-ending backend) + ;; Handle source code snippets (org-export-replace-src-segments-and-examples backend) @@ -1120,6 +1148,7 @@ ;; Find matches for radio targets and turn them into internal links (org-export-mark-radio-links) + (run-hooks 'org-export-preprocess-after-radio-targets-hook) ;; Find all links that contain a newline and put them into a single line (org-export-concatenate-multiline-links) @@ -1138,7 +1167,8 @@ (when (plist-get parameters :emph-multiline) (org-export-concatenate-multiline-emphasis)) - ;; Remove special table lines + ;; Remove special table lines, and store alignment information + (org-store-forced-table-alignment) (when org-export-table-remove-special-lines (org-export-remove-special-table-lines)) @@ -1185,6 +1215,10 @@ p (or (next-single-property-change p :org-license-to-kill) (point-max)))))) +(defvar org-export-define-heading-targets-headline-hook nil + "Hook that is run when a headline was matched during target search. +This is part of the preprocessing for export.") + (defun org-export-define-heading-targets (target-alist) "Find all headings and define the targets for them. The new targets are added to TARGET-ALIST, which is also returned. @@ -1228,7 +1262,8 @@ (push (cons target target) target-alist) (add-text-properties (point-at-bol) (point-at-eol) - (list 'target target)))))) + (list 'target target)) + (run-hooks 'org-export-define-heading-targets-headline-hook))))) target-alist) (defun org-export-handle-invisible-targets (target-alist) @@ -1289,18 +1324,19 @@ (string-match "^\\." link)) nil) (t - (save-excursion - (setq found (condition-case nil (org-link-search link) - (error nil))) - (when (and found - (or (org-on-heading-p) - (not (eq found 'dedicated)))) - (or (get-text-property (point) 'target) - (get-text-property - (max (point-min) - (1- (or (previous-single-property-change - (point) 'target) 0))) - 'target)))))))) + (let ((org-link-search-inhibit-query t)) + (save-excursion + (setq found (condition-case nil (org-link-search link) + (error nil))) + (when (and found + (or (org-on-heading-p) + (not (eq found 'dedicated)))) + (or (get-text-property (point) 'target) + (get-text-property + (max (point-min) + (1- (or (previous-single-property-change + (point) 'target) 0))) + 'target))))))))) (when target (set-match-data md) (goto-char (match-beginning 1)) @@ -1316,7 +1352,7 @@ (goto-char (point-min)) (let (class) (while (re-search-forward - "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(\\S-+\\)" nil t) + "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t) (setq class (match-string 1)) (save-excursion (org-back-to-heading t) @@ -1446,7 +1482,7 @@ (goto-char (point-min)) (while (re-search-forward re-archive nil t) (if (not (org-on-heading-p t)) - (org-end-of-subtree t) + (goto-char (point-at-eol)) (beginning-of-line 1) (setq a (if export-archived-trees (1+ (point-at-eol)) (point)) @@ -1595,6 +1631,31 @@ (delete-region beg end) (insert (org-add-props content nil 'original-indentation ind)))))) +(defun org-export-mark-list-ending (backend) + "Mark list endings with special cookies. +These special cookies will later be interpreted by the backend. +`org-list-end-re' is replaced by a blank line in the process." + (let ((process-buffer + (lambda (end-list-marker) + (goto-char (point-min)) + (while (org-search-forward-unenclosed org-item-beginning-re nil t) + (goto-char (org-list-bottom-point)) + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (replace-match "\n")) + (insert end-list-marker))))) + ;; We need to divide backends into 3 categories. + (cond + ;; 1. Backends using `org-list-parse-list' do not need markers. + ((memq backend '(latex)) + nil) + ;; 2. Line-processing backends need to be told where lists end. + ((memq backend '(html docbook)) + (funcall process-buffer "ORG-LIST-END\n")) + ;; 3. Others backends do not need to know this: clean list enders. + (t + (funcall process-buffer ""))))) + (defun org-export-attach-captions-and-attributes (backend target-alist) "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. If the next thing following is a table, add the text properties to the first @@ -1691,7 +1752,7 @@ (while (or (looking-at re) (re-search-forward re nil t)) (setq pos (match-beginning 0)) - (if (get-text-property (point) 'org-protected) + (if (get-text-property (match-beginning 1) 'org-protected) (goto-char (1+ pos)) (goto-char (1+ pos)) (replace-match "") @@ -1712,8 +1773,30 @@ (org-if-unprotected (replace-match "\\1[[\\2]]"))))))) +(defun org-store-forced-table-alignment () + "Find table lines which force alignment, store the results in properties." + (let (line cnt aligns) + (goto-char (point-min)) + (while (re-search-forward "|[ \t]*<[lrc][0-9]*>[ \t]*|" nil t) + ;; OK, this looks like a table line with an alignment cookie + (org-if-unprotected + (setq line (buffer-substring (point-at-bol) (point-at-eol))) + (when (and (org-at-table-p) + (org-table-cookie-line-p line)) + (setq cnt 0 aligns nil) + (mapc + (lambda (x) + (setq cnt (1+ cnt)) + (if (string-match "\\`<\\([lrc]\\)" x) + (push (cons cnt (downcase (match-string 1 x))) aligns))) + (org-split-string line "[ \t]*|[ \t]*")) + (add-text-properties (org-table-begin) (org-table-end) + (list 'org-forced-aligns aligns)))) + (goto-char (point-at-eol))))) + (defun org-export-remove-special-table-lines () - "Remove tables lines that are used for internal purposes." + "Remove tables lines that are used for internal purposes. +Also, store forcedalignment information found in such lines." (goto-char (point-min)) (while (re-search-forward "^[ \t]*|" nil t) (org-if-unprotected-at (1- (point)) @@ -1726,7 +1809,7 @@ (lambda (f) (or (= (length f) 0) (string-match - "\\`<\\([0-9]\\|[rl]\\|[rl][0-9]+\\)>\\'" f))) + "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f))) (org-split-string ;; FIXME, can't we do without splitting??? (buffer-substring (point-at-bol) (point-at-eol)) "[ \t]*|[ \t]*"))))) @@ -1747,16 +1830,19 @@ nodesc) (goto-char (point-min)) (while (re-search-forward re-plain-link nil t) - (goto-char (1- (match-end 0))) - (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((s (concat (match-string 1) - "[[" (match-string 2) ":" (match-string 3) - "][" (match-string 2) ":" (org-export-protect-sub-super - (match-string 3)) - "]]"))) - ;; added 'org-link face to links - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))) + (unless (org-string-match-p + "\\[\\[\\S+:\\S-*?\\<" + (buffer-substring (point-at-bol) (match-beginning 0))) + (goto-char (1- (match-end 0))) + (org-if-unprotected-at (1+ (match-beginning 0)) + (let* ((s (concat (match-string 1) + "[[" (match-string 2) ":" (match-string 3) + "][" (match-string 2) ":" (org-export-protect-sub-super + (match-string 3)) + "]]"))) + ;; added 'org-link face to links + (put-text-property 0 (length s) 'face 'org-link s) + (replace-match s t t))))) (goto-char (point-min)) (while (re-search-forward re-angle-link nil t) (goto-char (1- (match-end 0))) @@ -1807,7 +1893,9 @@ (if (and (not (= (char-after (match-beginning 3)) (char-after (match-beginning 4)))) (save-excursion (goto-char (match-beginning 0)) - (save-match-data (not (org-at-table-p))))) + (save-match-data + (and (not (org-at-table-p)) + (not (org-at-heading-p)))))) (org-if-unprotected (subst-char-in-region (match-beginning 0) (match-end 0) ?\n ?\ t) @@ -1976,16 +2064,15 @@ (intern (concat ":" key))))) (save-match-data (when args - (setq args (org-split-string args ",[ \t\n]*") args2 nil) - (setq args (mapcar 'org-trim args)) + (setq args (org-split-string args ",") args2 nil) (while args (while (string-match "\\\\\\'" (car args)) ;; repair bad splits (setcar (cdr args) (concat (substring (car args) 0 -1) - ";" (nth 1 args))) + "," (nth 1 args))) (pop args)) (push (pop args) args2)) - (setq args (nreverse args2)) + (setq args (mapcar 'org-trim (nreverse args2))) (setq s 0) (while (string-match "\\$\\([0-9]+\\)" val s) (setq s (1+ (match-beginning 0)) @@ -2146,6 +2233,9 @@ (defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el (defvar org-export-latex-listings) ;; defined in org-latex.el (defvar org-export-latex-listings-langs) ;; defined in org-latex.el +(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el +(defvar org-export-latex-minted-langs) ;; defined in org-latex.el +(defvar org-export-latex-minted-with-line-numbers) ;; defined in org-latex.el (defun org-export-format-source-code-or-example (backend lang code &optional opts indent caption) @@ -2275,32 +2365,56 @@ (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) (concat "#+BEGIN_LaTeX\n" (org-add-props - (if org-export-latex-listings - (concat - (if lang - (let* - ((lang-sym (intern lang)) - (lstlang - (or (cadr - (assq - lang-sym - org-export-latex-listings-langs)) - lang))) - (format "\\lstset{language=%s}\n" lstlang)) - "\n") - (when caption - (format "\n%s $\\equiv$ \n" caption)) - "\\begin{lstlisting}\n" - rtn "\\end{lstlisting}\n") - (concat (car org-export-latex-verbatim-wrap) - rtn (cdr org-export-latex-verbatim-wrap))) - '(org-protected t org-example t)) - "#+END_LaTeX\n")) - ((eq backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) - (concat caption "\n" - "#+BEGIN_ASCII\n" + (cond + ((and org-export-latex-listings + (not (eq org-export-latex-listings 'minted))) + (concat + (if lang + (let* + ((lang-sym (intern lang)) + (lstlang + (or (cadr + (assq + lang-sym + org-export-latex-listings-langs)) + lang))) + (format "\\lstset{language=%s}\n" lstlang)) + "\n") + (when (and caption + org-export-latex-listings-w-names) + (format "\n%s $\\equiv$ \n" + (replace-regexp-in-string + "_" "\\\\_" caption))) + "\\begin{lstlisting}\n" + rtn "\\end{lstlisting}\n")) + ((eq org-export-latex-listings 'minted) + (if lang + (let* + ((lang-sym (intern lang)) + (minted-lang + (or (cadr + (assq + lang-sym + org-export-latex-minted-langs)) + (downcase lang)))) + (concat + (when (and caption + org-export-latex-listings-w-names) + (format "\n%s $\\equiv$ \n" + (replace-regexp-in-string + "_" "\\\\_" caption))) + (format + "\\begin{minted}[mathescape,%s\nnumbersep=5pt,\nframe=lines,\nframesep=2mm]{%s}\n" (if org-export-latex-minted-with-line-numbers "\nlinenos," "") minted-lang) + rtn "\\end{minted}\n")))) + (t (concat (car org-export-latex-verbatim-wrap) + rtn (cdr org-export-latex-verbatim-wrap)))) + '(org-protected t org-example t)) + "#+END_LaTeX\n")) + ((eq backend 'ascii) + ;; This is not HTML or LaTeX, so just make it an example. + (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) + (concat caption "\n" + "#+BEGIN_ASCII\n" (org-add-props (concat (mapconcat @@ -2498,6 +2612,28 @@ (defvar org-export-htmlized-org-css-url) ;; defined in org-html.el +(defun org-export-string (string fmt &optional dir) + "Export STRING to FMT using existing export facilities. +During export STRING is saved to a temporary file whose location +could vary. Optional argument DIR can be used to force the +directory in which the temporary file is created during export +which can be useful for resolving relative paths. Dir defaults +to the value of `temporary-file-directory'." + (let ((temporary-file-directory (or dir temporary-file-directory)) + (tmp-file (make-temp-file "org-"))) + (unwind-protect + (with-temp-buffer + (insert string) + (write-file tmp-file) + (org-load-modules-maybe) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) + (eval ;; convert to fmt -- mimicing `org-run-like-in-org-mode' + (list 'let org-local-vars + (list (intern (concat "org-export-as-" fmt)) + nil nil nil ''string t)))) + (delete-file tmp-file)))) + ;;;###autoload (defun org-export-as-org (arg &optional hidden ext-plist to-buffer body-only pub-dir) @@ -2760,7 +2896,7 @@ (defun org-export-cleanup-toc-line (s) "Remove tags and timestamps from lines going into the toc." (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s) + (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) (setq s (replace-match "" t t s)))) (when org-export-remove-timestamps-from-toc (while (string-match org-maybe-keyword-time-regexp s)
--- a/lisp/org/org-faces.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-faces.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-feed.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-feed.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -99,11 +99,11 @@ (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) (declare-function xml-get-attribute-or-nil "xml" (node attribute)) -(defvar xml-entity-alist) +(declare-function xml-substitute-special "xml" (string)) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." - :tag "Org ID" + :tag "Org Feed" :group 'org) (defcustom org-feed-alist nil @@ -269,17 +269,6 @@ (defvar org-feed-buffer "*Org feed*" "The buffer used to retrieve a feed.") -(defun org-feed-unescape (s) - "Unescape protected entities in S." - (require 'xml) - (let ((re (concat "&\\(" - (mapconcat 'car xml-entity-alist "\\|") - "\\);"))) - (while (string-match re s) - (setq s (replace-match - (cdr (assoc (match-string 1 s) xml-entity-alist)) nil nil s))) - s)) - ;;;###autoload (defun org-feed-update-all () "Get inbox items from all feeds in `org-feed-alist'." @@ -553,7 +542,8 @@ (setq tmp (org-feed-make-indented-block tmp (org-get-indentation)))))) (replace-match tmp t t)))) - (buffer-string))))) + (decode-coding-string + (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) (defun org-feed-make-indented-block (s n) "Add indentation of N spaces to a multiline string S." @@ -613,6 +603,7 @@ (defun org-feed-parse-rss-entry (entry) "Parse the `:item-full-text' field for xml tags and create new properties." + (require 'xml) (with-temp-buffer (insert (plist-get entry :item-full-text)) (goto-char (point-min)) @@ -620,7 +611,7 @@ nil t) (setq entry (plist-put entry (intern (concat ":" (match-string 1))) - (org-feed-unescape (match-string 2))))) + (xml-substitute-special (match-string 2))))) (goto-char (point-min)) (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) (setq entry (plist-put entry :guid-permalink t)))) @@ -654,7 +645,7 @@ 'href))) ;; Add <title/> as :title. (setq entry (plist-put entry :title - (org-feed-unescape + (xml-substitute-special (car (xml-node-children (car (xml-get-children xml 'title))))))) (let* ((content (car (xml-get-children xml 'content))) @@ -664,12 +655,12 @@ ((string= type "text") ;; We like plain text. (setq entry (plist-put entry :description - (org-feed-unescape + (xml-substitute-special (car (xml-node-children content)))))) ((string= type "html") ;; TODO: convert HTML to Org markup. (setq entry (plist-put entry :description - (org-feed-unescape + (xml-substitute-special (car (xml-node-children content)))))) ((string= type "xhtml") ;; TODO: convert XHTML to Org markup.
--- a/lisp/org/org-footnote.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-footnote.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -49,6 +49,7 @@ (declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-inside-latex-macro-p "org" ()) (defvar org-odd-levels-only) ;; defined in org.el +(defvar message-signature-separator) ;; defined in message.el (defconst org-footnote-re (concat "[^][\n]" ; to make sure it is not at the beginning of a line @@ -188,7 +189,7 @@ (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) (defun org-footnote-goto-previous-reference (label) - "Find the next previous of the footnote with label LABEL." + "Find the first closest (to point) reference of footnote with label LABEL." (interactive "sLabel: ") (org-mark-ring-push) (setq label (org-footnote-normalize-label label)) @@ -302,15 +303,19 @@ (t (setq re (concat "^" org-footnote-tag-for-non-org-mode-files "[ \t]*$")) (unless (re-search-forward re nil t) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n") - (insert "\n\n") - (delete-region (point) (point-max)) - (insert org-footnote-tag-for-non-org-mode-files "\n")) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n"))) - (insert "\n\n") - (insert "[" label "] ") + (let ((max (if (and (eq major-mode 'message-mode) + (re-search-forward message-signature-separator nil t)) + (progn (beginning-of-line) (point)) + (goto-char (point-max))))) + (skip-chars-backward " \t\r\n") + (delete-region (point) max) + (insert "\n\n") + (insert org-footnote-tag-for-non-org-mode-files "\n"))))) + ;; Skip existing footnotes + (while (re-search-forward "^[[:space:]]*\\[[^]]+\\] " nil t) + (forward-line)) + (insert "[" label "] \n") + (goto-char (1- (point))) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))) ;;;###autoload @@ -506,7 +511,8 @@ (beginning-of-line 0)) (if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2)) (end-of-line 1) - (skip-chars-backward "\n\r\t ")) + (skip-chars-backward "\n\r\t ") + (forward-line)) (defun org-footnote-delete (&optional label) "Delete the footnote at point.
--- a/lisp/org/org-freemind.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-freemind.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Lennart Borgman (lennart O borgman A gmail O com) ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -81,31 +81,35 @@ (require 'xml) (require 'org) -(require 'rx) +;(require 'rx) (require 'org-exp) (eval-when-compile (require 'cl)) +(defgroup org-freemind nil + "Customization group for org-freemind export/import." + :group 'org) + ;; Fix-me: I am not sure these are useful: ;; ;; (defcustom org-freemind-main-fgcolor "black" ;; "Color of main node's text." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) ;; (defcustom org-freemind-main-color "black" ;; "Background color of main node." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) ;; (defcustom org-freemind-child-fgcolor "black" ;; "Color of child nodes' text." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) ;; (defcustom org-freemind-child-color "black" ;; "Background color of child nodes." ;; :type 'color -;; :group 'freemind) +;; :group 'org-freemind) (defvar org-freemind-node-style nil "Internal use.") @@ -152,11 +156,25 @@ (string :tag "Font name" :value "SansSerif")) (list :format "%v" (const :format "" font-size) (integer :tag "Font size" :value 12))))))) - :group 'freemind) + :group 'org-freemind) ;;;###autoload -(defun org-export-as-freemind (arg &optional hidden ext-plist +(defun org-export-as-freemind (&optional hidden ext-plist to-buffer body-only pub-dir) + "Export the current buffer as a Freemind file. +If there is an active region, export only the region. HIDDEN is +obsolete and does nothing. EXT-PLIST is a property list with +external parameters overriding org-mode's default settings, but +still inferior to file-local settings. When TO-BUFFER is +non-nil, create a buffer with that name and export to that +buffer. If TO-BUFFER is the symbol `string', don't leave any +buffer behind but just return the resulting HTML as a string. +When BODY-ONLY is set, don't produce the file header and footer, +simply return the content of the document (all top level +sections). When PUB-DIR is set, use this as the publishing +directory. + +See `org-freemind-from-org-mode' for more information." (interactive "P") (let* ((opt-plist (org-combine-plists (org-default-export-plist) ext-plist @@ -203,7 +221,20 @@ (let ((name (read-file-name "FreeMind file: " nil nil nil (if (buffer-file-name) - (file-name-nondirectory (buffer-file-name)) + (let* ((name-ext (file-name-nondirectory (buffer-file-name))) + (name (file-name-sans-extension name-ext)) + (ext (file-name-extension name-ext))) + (cond + ((string= "mm" ext) + name-ext) + ((string= "org" ext) + (let ((name-mm (concat name ".mm"))) + (if (file-exists-p name-mm) + name-mm + (message "Not exported to Freemind format yet") + ""))) + (t + ""))) "") ;; Fix-me: Is this an Emacs bug? ;; This predicate function is never @@ -227,7 +258,7 @@ (dolist (cc chars) (setq fm-str (concat fm-str - (if (< cc 256) + (if (< cc 160) (cond ((= cc ?\") """) ((= cc ?\&) "&") @@ -265,52 +296,84 @@ ))) org-str)))) -;; (org-freemind-test-escape) -(defun org-freemind-test-escape () - (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ") - (str2 (org-freemind-escape-str-from-org str1)) - (str3 (org-freemind-unescape-str-to-org str2)) +;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ") +;; (str2 (org-freemind-escape-str-from-org str1)) +;; (str3 (org-freemind-unescape-str-to-org str2))) +;; (unless (string= str1 str3) +;; (error "Error str3=%s" str3))) + +(defun org-freemind-convert-links-helper (matched) + "Helper for `org-freemind-convert-links-from-org'. +MATCHED is the link just matched." + (let* ((link (match-string 1 matched)) + (text (match-string 2 matched)) + (ext (file-name-extension link)) + (col-pos (string-match-p ":" link)) + (is-img (and (image-type-from-file-name link) + (let ((url-type (substring link 0 col-pos))) + (member url-type '("file" "http" "https"))))) ) - (unless (string= str1 str3) - (error "str3=%s" str3)) - )) + (if is-img + ;; Fix-me: I can't find a way to get the border to "shrink + ;; wrap" around the image using <div>. + ;; + ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">" + ;; "<img src=\"" link "\" alt=\"" text "\" />" + ;; "<br />" + ;; "<i>" text "</i>" + ;; "</div>") + (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>" + "<img src=\"" link "\" alt=\"" text "\" />" + "<br />" + "<i>" text "</i>" + "</td></tr></table>") + (concat "<a href=\"" link "\">" text "</a>")))) (defun org-freemind-convert-links-from-org (org-str) "Convert org links in ORG-STR to freemind links and return the result." (let ((fm-str (replace-regexp-in-string - (rx (not (any "[\"")) - (submatch - "http" - (opt ?\s) - "://" - (1+ - (any "-%.?@a-zA-Z0-9()_/:~=&#")))) + ;;(rx (not (any "[\"")) + ;; (submatch + ;; "http" + ;; (opt ?\s) + ;; "://" + ;; (1+ + ;; (any "-%.?@a-zA-Z0-9()_/:~=&#")))) + "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)" "[[\\1][\\1]]" - org-str))) - (replace-regexp-in-string (rx "[[" - (submatch (*? nonl)) - "][" - (submatch (*? nonl)) - "]]") - "<a href=\"\\1\">\\2</a>" - fm-str))) + org-str + nil ;; fixedcase + nil ;; literal + 1 ;; subexp + ))) + (replace-regexp-in-string + ;;(rx "[[" + ;; (submatch (*? nonl)) + ;; "][" + ;; (submatch (*? nonl)) + ;; "]]") + "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]" + ;;"<a href=\"\\1\">\\2</a>" + 'org-freemind-convert-links-helper + fm-str))) ;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>") (defun org-freemind-convert-links-to-org (fm-str) "Convert freemind links in FM-STR to org links and return the result." (let ((org-str (replace-regexp-in-string - (rx "<a" - space - (0+ - (0+ (not (any ">"))) - space) - "href=\"" - (submatch (0+ (not (any "\"")))) - "\"" - (0+ (not (any ">"))) - ">" - (submatch (0+ (not (any "<")))) - "</a>") + ;;(rx "<a" + ;; space + ;; (0+ + ;; (0+ (not (any ">"))) + ;; space) + ;; "href=\"" + ;; (submatch (0+ (not (any "\"")))) + ;; "\"" + ;; (0+ (not (any ">"))) + ;; ">" + ;; (submatch (0+ (not (any "<")))) + ;; "</a>") + "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>" "[[\\1][\\2]]" fm-str))) org-str)) @@ -319,29 +382,60 @@ ;;(defun org-freemind-convert-drawers-from-org (text) ;; ) -;; (org-freemind-test-links) -;; (defun org-freemind-test-links () ;; (let* ((str1 "[[http://www.somewhere/][link-text]") ;; (str2 (org-freemind-convert-links-from-org str1)) -;; (str3 (org-freemind-convert-links-to-org str2)) -;; ) +;; (str3 (org-freemind-convert-links-to-org str2))) ;; (unless (string= str1 str3) -;; (error "str3=%s" str3)) -;; )) +;; (error "Error str3=%s" str3))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Org => FreeMind +(defvar org-freemind-bol-helper-base-indent nil) + +(defun org-freemind-bol-helper (matched) + "Helper for `org-freemind-convert-text-p'. +MATCHED is the link just matched." + (let ((res "") + (bi org-freemind-bol-helper-base-indent)) + (dolist (cc (append matched nil)) + (if (= 32 cc) + ;;(setq res (concat res " ")) + ;; We need to use the numerical version. Otherwise Freemind + ;; ver 0.9.0 RC9 can not export to html/javascript. + (progn + (if (< 0 bi) + (setq bi (1- bi)) + (setq res (concat res " ")))) + (setq res (concat res (char-to-string cc))))) + res)) +;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n ")) + (defun org-freemind-convert-text-p (text) "Convert TEXT to html with <p> paragraphs." + ;; (string-match-p "[^ ]" " a") + (setq org-freemind-bol-helper-base-indent (string-match-p "[^ ]" text)) (setq text (org-freemind-escape-str-from-org text)) - (setq text (replace-regexp-in-string (rx "\n" (0+ blank) "\n") "</p><p>\n" text)) - ;;(setq text (replace-regexp-in-string (rx bol (1+ blank) eol) "" text)) - ;;(setq text (replace-regexp-in-string (rx bol (1+ blank)) "<br />" text)) + + (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text)) + (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text)) + + (setq text (concat "<p>" text)) + (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text)) + (setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text)) (setq text (replace-regexp-in-string "\n" "<br />" text)) - (concat "<p>" - (org-freemind-convert-links-from-org text) - "</p>\n")) + (setq text (concat text "</p>")) + + (org-freemind-convert-links-from-org text)) + +(defcustom org-freemind-node-css-style + "p { margin-top: 3px; margin-bottom: 3px; }" + "CSS style for Freemind nodes." + ;; Fix-me: I do not understand this. It worked to export from Freemind + ;; with this setting now, but not before??? Was this perhaps a java + ;; bug or is it a windows xp bug (some resource gets exhausted if you + ;; use sticky keys which I do). + :group 'org-freemind) (defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp) "Convert text part of org node to freemind subnode or note. @@ -390,11 +484,14 @@ "<node style=\"bubble\" background_color=\"#eeee00\">\n" "<richcontent TYPE=\"NODE\"><html>\n" "<head>\n" + (if (= 0 (length org-freemind-node-css-style)) + "" + (concat "<style type=\"text/css\">\n" "<!--\n" - "p { margin-top: 0 }\n" + org-freemind-node-css-style "-->\n" - "</style>\n" + "</style>\n")) "</head>\n" "<body>\n")) (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML")) @@ -427,21 +524,28 @@ "</html>\n" "</richcontent>\n" ;; Put a note that this is for the parent node - "<richcontent TYPE=\"NOTE\"><html>" - "<head>" - "</head>" - "<body>" - "<p>" - "-- This is more about \"" node-name "\" --" - "</p>" - "</body>" - "</html>" - "</richcontent>\n" + ;; "<richcontent TYPE=\"NOTE\"><html>" + ;; "<head>" + ;; "</head>" + ;; "<body>" + ;; "<p>" + ;; "-- This is more about \"" node-name "\" --" + ;; "</p>" + ;; "</body>" + ;; "</html>" + ;; "</richcontent>\n" + note-res "</node>\n" ;; ok ))) (list node-res note-res)))) -(defun org-freemind-write-node (mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child) +(defun org-freemind-write-node (mm-buffer drawers-regexp + num-left-nodes base-level + current-level next-level this-m2 + this-node-end + this-children-visible + next-node-start + next-has-some-visible-child) (let* (this-icons this-bg-color this-m2-escaped @@ -503,7 +607,7 @@ (insert "<icon builtin=\"" icon "\"/>\n"))) ) (with-current-buffer mm-buffer - (when this-rich-note (insert this-rich-note)) + ;;(when this-rich-note (insert this-rich-note)) (when this-rich-node (insert this-rich-node)))) num-left-nodes) @@ -521,11 +625,13 @@ (error "File %s already exists" file)) t)) -(defvar org-freemind-node-pattern (rx bol - (submatch (1+ "*")) - (1+ space) - (submatch (*? nonl)) - eol)) +(defvar org-freemind-node-pattern + ;;(rx bol + ;; (submatch (1+ "*")) + ;; (1+ space) + ;; (submatch (*? nonl)) + ;; eol) + "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$") (defun org-freemind-look-for-visible-child (node-level) (save-excursion @@ -573,27 +679,31 @@ node-at-line-last) (with-current-buffer mm-buffer (erase-buffer) - (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n") + (setq buffer-file-coding-system 'utf-8) + ;; Fix-me: Currentl Freemind (ver 0.9.0 RC9) does not support this: + ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n") (insert "<map version=\"0.9.0\">\n") (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n")) (save-excursion ;; Get special buffer vars: (goto-char (point-min)) - (while (re-search-forward (rx bol "#+DRAWERS:") nil t) + (message "Writing Freemind file...") + (while (re-search-forward "^#\\+DRAWERS:" nil t) (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position)))) (setq drawers (append drawers (split-string dr-txt) nil)))) (setq drawers-regexp - (concat (rx bol (0+ blank) ":") + (concat "^[[:blank:]]*:" (regexp-opt drawers) - (rx ":" (0+ blank) - "\n" - (*? anything) - "\n" - (0+ blank) - ":END:" - (0+ blank) - eol) - )) + ;;(rx ":" (0+ blank) + ;; "\n" + ;; (*? anything) + ;; "\n" + ;; (0+ blank) + ;; ":END:" + ;; (0+ blank) + ;; eol) + ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$" + )) (if node-at-line ;; Get number of top nodes and last line for this node @@ -795,7 +905,8 @@ ;;;###autoload (defun org-freemind-from-org-mode-node (node-line mm-file) - "Convert node at line NODE-LINE to the FreeMind file MM-FILE." + "Convert node at line NODE-LINE to the FreeMind file MM-FILE. +See `org-freemind-from-org-mode' for more information." (interactive (progn (unless (org-back-to-heading nil) @@ -808,20 +919,29 @@ ".mm")) (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) (list line mm-file)))) - (when (org-freemind-check-overwrite mm-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) (let ((org-buffer (current-buffer)) (mm-buffer (find-file-noselect mm-file))) (org-freemind-write-mm-buffer org-buffer mm-buffer node-line) (with-current-buffer mm-buffer (basic-save-buffer) - (when (called-interactively-p 'any) + (when (org-called-interactively-p 'any) (switch-to-buffer-other-window mm-buffer) (when (y-or-n-p "Show in FreeMind? ") (org-freemind-show buffer-file-name))))))) ;;;###autoload (defun org-freemind-from-org-mode (org-file mm-file) - "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE." + "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE. +All the nodes will be opened or closed in Freemind just as you +have them in `org-mode'. + +Note that exporting to Freemind also gives you an alternative way +to export from `org-mode' to html. You can create a dynamic html +version of the your org file, by first exporting to Freemind and +then exporting from Freemind to html. The 'As +XHTML (JavaScript)' version in Freemind works very well \(and you +can use a CSS stylesheet to style it)." ;; Fix-me: better doc, include recommendations etc. (interactive (let* ((org-file buffer-file-name) @@ -832,13 +952,13 @@ ".mm")) (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) (list org-file mm-file))) - (when (org-freemind-check-overwrite mm-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer))) (mm-buffer (find-file-noselect mm-file))) (org-freemind-write-mm-buffer org-buffer mm-buffer nil) (with-current-buffer mm-buffer (basic-save-buffer) - (when (called-interactively-p 'any) + (when (org-called-interactively-p 'any) (switch-to-buffer-other-window mm-buffer) (when (y-or-n-p "Show in FreeMind? ") (org-freemind-show buffer-file-name))))))) @@ -855,7 +975,7 @@ "-sparse.mm")) (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) (list (current-buffer) mm-file))) - (when (org-freemind-check-overwrite mm-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) (let (org-buffer (mm-buffer (find-file-noselect mm-file))) (save-window-excursion @@ -864,7 +984,7 @@ (org-freemind-write-mm-buffer org-buffer mm-buffer nil) (with-current-buffer mm-buffer (basic-save-buffer) - (when (called-interactively-p 'any) + (when (org-called-interactively-p 'any) (switch-to-buffer-other-window mm-buffer) (when (y-or-n-p "Show in FreeMind? ") (org-freemind-show buffer-file-name))))))) @@ -1019,7 +1139,7 @@ (save-match-data (let* ((rc (org-freemind-get-richcontent-node node)) (txt (org-freemind-get-tree-text rc))) - ;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt))) + ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) txt ))) @@ -1028,7 +1148,7 @@ (save-match-data (let* ((rc (org-freemind-get-richcontent-note node)) (txt (when rc (org-freemind-get-tree-text rc)))) - ;;(when txt (setq txt (replace-regexp-in-string (rx (1+ whitespace)) " " txt))) + ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) txt ))) @@ -1044,6 +1164,7 @@ (let ((qname (car node)) (attributes (cadr node)) text + ;; Fix-me: note is never inserted (note (org-freemind-get-richcontent-note-text node)) (mark "-- This is more about ") (icons (org-freemind-get-icon-names node)) @@ -1074,6 +1195,8 @@ (case qname ('node (insert (make-string (- level skip-levels) ?*) " " text "\n") + (when note + (insert ":COMMENT:\n" note "\n:END:\n")) )))) (dolist (child children) (unless (or (null child) @@ -1091,7 +1214,7 @@ (default-org-file (concat (file-name-nondirectory mm-file) ".org")) (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file))) (list mm-file org-file)))) - (when (org-freemind-check-overwrite org-file (called-interactively-p 'any)) + (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any)) (let ((mm-buffer (find-file-noselect mm-file)) (org-buffer (find-file-noselect org-file))) (with-current-buffer mm-buffer @@ -1100,7 +1223,7 @@ (note (org-freemind-get-richcontent-note-text top-node)) (skip-levels (if (and note - (string-match (rx bol "--org-mode: WHOLE FILE" eol) note)) + (string-match "^--org-mode: WHOLE FILE$" note)) 1 0))) (with-current-buffer org-buffer
--- a/lisp/org/org-gnus.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-gnus.el Wed Nov 17 13:09:08 2010 +0900 @@ -7,7 +7,7 @@ ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -39,9 +39,9 @@ ;; Declare external functions and variables (declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-narrow-to-head-1 "message" nil) +(declare-function nnimap-group-overview-filename "nnimap" (group server)) ;; The following line suppresses a compiler warning stemming from gnus-sum.el (declare-function gnus-summary-last-subject "gnus-sum" nil) - ;; Customization variables (when (fboundp 'defvaralias) @@ -55,6 +55,17 @@ :group 'org-link-store :type 'boolean) +(defcustom org-gnus-nnimap-query-article-no-from-file nil + "If non-nil, `org-gnus-follow-link' will try to translate +Message-Ids to article numbers by querying the .overview file. +Normally, this translation is done by querying the IMAP server, +which is usually very fast. Unfortunately, some (maybe badly +configured) IMAP servers don't support this operation quickly. +So if following a link to a Gnus article takes ages, try setting +this variable to `t'." + :group 'org-link-store + :type 'boolean) + ;; Install the link type (org-add-link-type "gnus" 'org-gnus-open) @@ -62,6 +73,22 @@ ;; Implementation +(defun org-gnus-nnimap-cached-article-number (group server message-id) + "Return cached article number (uid) of message in GROUP on SERVER. +MESSAGE-ID is the message-id header field that identifies the +message. If the uid is not cached, return nil." + (with-temp-buffer + (let ((nov (nnimap-group-overview-filename group server))) + (when (file-exists-p nov) + (mm-insert-file-contents nov) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (catch 'found + (while (search-forward message-id nil t) + (let ((hdr (split-string (thing-at-point 'line) "\t"))) + (if (string= (nth 4 hdr) message-id) + (throw 'found (nth 0 hdr)))))))))) + (defun org-gnus-group-link (group) "Create a link to the Gnus group GROUP. If GROUP is a newsgroup and `org-gnus-prefer-web-links' is @@ -125,6 +152,11 @@ (from (mail-header-from header)) (message-id (org-remove-angle-brackets (mail-header-id header))) (date (mail-header-date header)) + (date-ts (and date (format-time-string + (org-time-stamp-format t) (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) (subject (copy-sequence (mail-header-subject header))) (to (cdr (assq 'To (mail-header-extra header)))) newsgroups x-no-archive desc link) @@ -140,14 +172,27 @@ (setq to (or to (gnus-fetch-original-field "To")) newsgroups (gnus-fetch-original-field "Newsgroups") x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :subject subject + (org-store-link-props :type "gnus" :from from :subject subject :message-id message-id :group group :to to) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description) link (org-gnus-article-link group newsgroups message-id x-no-archive)) (org-add-link-props :link link :description desc) link)))) +(defun org-gnus-open-nntp (path) + "Follow the nntp: link specified by PATH." + (let* ((spec (split-string path "/")) + (server (split-string (nth 2 spec) "@")) + (group (nth 3 spec)) + (article (nth 4 spec))) + (org-gnus-follow-link + (format "nntp+%s:%s" (or (cdr server) (car server)) group) + article))) + (defun org-gnus-open (path) "Follow the Gnus message or folder link specified by PATH." (let (group article) @@ -173,7 +218,9 @@ (cond ((and group article) (gnus-activate-group group t) (condition-case nil - (let ((backend (car (gnus-find-method-for-group group)))) + (let* ((method (gnus-find-method-for-group group)) + (backend (car method)) + (server (cadr method))) (cond ((eq backend 'nndoc) (if (gnus-group-read-group t nil group) @@ -183,6 +230,12 @@ (t (let ((articles 1) group-opened) + (when (and (eq backend 'nnimap) + org-gnus-nnimap-query-article-no-from-file) + (setq article + (or (org-gnus-nnimap-cached-article-number + (nth 1 (split-string group ":")) + server (concat "<" article ">")) article))) (while (and (not group-opened) ;; stop on integer overflows (> articles 0))
--- a/lisp/org/org-habit.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-habit.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -149,15 +149,17 @@ (assert (org-is-habit-p (point))) (let* ((scheduled (org-get-scheduled-time (point))) (scheduled-repeat (org-get-repeat org-scheduled-string)) - (sr-days (org-habit-duration-to-days scheduled-repeat)) (end (org-entry-end-position)) - (habit-entry (org-no-properties (nth 5 (org-heading-components)))) - closed-dates deadline dr-days) + (habit-entry (org-no-properties (nth 4 (org-heading-components)))) + closed-dates deadline dr-days sr-days) (if scheduled (setq scheduled (time-to-days scheduled)) (error "Habit %s has no scheduled date" habit-entry)) (unless scheduled-repeat - (error "Habit %s has no scheduled repeat period" habit-entry)) + (error + "Habit '%s' has no scheduled repeat period or has an incorrect one" + habit-entry)) + (setq sr-days (org-habit-duration-to-days scheduled-repeat)) (unless (> sr-days 0) (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
--- a/lisp/org/org-html.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-html.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -126,6 +126,9 @@ .target { } .timestamp { color: #bebebe; } .timestamp-kwd { color: #5f9ea0; } + .right {margin-left:auto; margin-right:0px; text-align:right;} + .left {margin-left:0px; margin-right:auto; text-align:left;} + .center {margin-left:auto; margin-right:auto; text-align:center;} p.verse { margin-left: 3% } pre { border: 1pt solid #AEBDCC; @@ -136,7 +139,13 @@ overflow:auto; } table { border-collapse: collapse; } - td, th { vertical-align: top; } + td, th { vertical-align: top; } + th.right { text-align:center; } + th.left { text-align:center; } + th.center { text-align:center; } + td.right { text-align:right; } + td.left { text-align:left; } + td.center { text-align:center; } dt { font-weight: bold; } div.figure { padding: 0.5em; } div.figure p { text-align: center; } @@ -209,6 +218,112 @@ ;;;###autoload (put 'org-export-html-style-extra 'safe-local-variable 'stringp) +(defcustom org-export-html-mathjax-options + '((path "http://orgmode.org/mathjax/MathJax.js") + (scale "100") + (align "center") + (indent "2em") + (mathml nil)) + "Options for MathJax setup. + +path The path where to find MathJax +scale Scaling for the HTML-CSS backend, usually between 100 and 133 +align How to align display math: left, center, or right +indent If align is not center, how far from the left/right side? +mathml Should a MathML player be used if available? + This is faster and reduces bandwidth use, but currently + sometimes has lower spacing quality. Therefore, the default is + nil. When browsers get better, this switch can be flipped. + +You can also customize this for each buffer, using something like + +#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" + :group 'org-export-html + :type '(list :greedy t + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "mathml (should MathML display be used is possible)" + (const :format " " mathml) (boolean)))) + +(defun org-export-html-mathjax-config (template options in-buffer) + "Insert the user setup into the matchjax template." + (let (name val (yes " ") (no "// ") x) + (mapc + (lambda (e) + (setq name (car e) val (nth 1 e)) + (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) + (setq val (car (read-from-string + (substring in-buffer (match-end 0)))))) + (if (not (stringp val)) (setq val (format "%s" val))) + (if (string-match (concat "%" (upcase (symbol-name name))) template) + (setq template (replace-match val t t template)))) + options) + (setq val (nth 1 (assq 'mathml options))) + (if (string-match (concat "\\<mathml:") in-buffer) + (setq val (car (read-from-string + (substring in-buffer (match-end 0)))))) + ;; Exchange prefixes depending on mathml setting + (if (not val) (setq x yes yes no no x)) + ;; Replace cookies to turn on or off the config/jax lines + (if (string-match ":MMLYES:" template) + (setq template (replace-match yes t t template))) + (if (string-match ":MMLNO:" template) + (setq template (replace-match no t t template))) + ;; Return the modified template + template)) + +(defcustom org-export-html-mathjax-template + "<script type=\"text/javascript\" src=\"%PATH\"> +<!--/*--><![CDATA[/*><!--*/ + MathJax.Hub.Config({ + // Only one of the two following lines, depending on user settings + // First allows browser-native MathML display, second forces HTML/CSS + :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"], + :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"], + extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\", + \"TeX/noUndefined.js\"], + tex2jax: { + inlineMath: [ [\"\\\\(\",\"\\\\)\"] ], + displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"] ], + skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"], + ignoreClass: \"tex2jax_ignore\", + processEscapes: false, + processEnvironments: true, + preview: \"TeX\" + }, + showProcessingMessages: true, + displayAlign: \"%ALIGN\", + displayIndent: \"%INDENT\", + + \"HTML-CSS\": { + scale: %SCALE, + availableFonts: [\"STIX\",\"TeX\"], + preferredFont: \"TeX\", + webFont: \"TeX\", + imageFont: \"TeX\", + showMathMenu: true, + }, + MMLorHTML: { + prefer: { + MSIE: \"MML\", + Firefox: \"MML\", + Opera: \"HTML\", + other: \"HTML\" + } + } + }); +/*]]>*///--> +</script>" + "The MathJax setup for XHTML files." + :group 'org-export-html + :type 'string) + (defcustom org-export-html-tag-class-prefix "" "Prefix to class names for TODO keywords. Each tag gets a class given by the tag itself, with this prefix. @@ -281,7 +396,7 @@ (const :tag "When there is no description" maybe))) (defcustom org-export-html-inline-image-extensions - '("png" "jpeg" "jpg" "gif") + '("png" "jpeg" "jpg" "gif" "svg") "Extensions of image files that can be inlined into HTML." :group 'org-export-html :type '(repeat (string :tag "Extension"))) @@ -294,17 +409,22 @@ :group 'org-export-html :type 'string) -(defcustom org-export-table-header-tags '("<th scope=\"%s\">" . "</th>") +(defcustom org-export-table-header-tags '("<th scope=\"%s\"%s>" . "</th>") "The opening tag for table header fields. This is customizable so that alignment options can be specified. -%s will be filled with the scope of the field, either row or col. -See also the variable `org-export-html-table-use-header-tags-for-first-column'." +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-export-html-table-use-header-tags-for-first-column'. +See also the variable `org-export-html-table-align-individual-fields'." :group 'org-export-tables :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) -(defcustom org-export-table-data-tags '("<td>" . "</td>") +(defcustom org-export-table-data-tags '("<td%s>" . "</td>") "The opening tag for table data fields. -This is customizable so that alignment options can be specified." +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-export-html-table-align-individual-fields'." :group 'org-export-tables :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) @@ -335,7 +455,13 @@ (string :tag "Specify") (sexp)))) - +(defcustom org-export-html-table-align-individual-fields t + "Non-nil means attach style attributes for alignment to each table field. +When nil, alignment will only be specified in the column tags, but this +is ignored by some browsers (like Firefox, Safari). Opera does it right +though." + :group 'org-export-tables + :type 'boolean) (defcustom org-export-html-table-use-header-tags-for-first-column nil "Non-nil means format column one in tables with header tags. @@ -413,7 +539,7 @@ "Preamble, to be inserted just after <body>. Set by publishing functions. This may also be a function, building and inserting the preamble.") (defvar org-export-html-postamble nil - "Preamble, to be inserted just before </body>. Set by publishing functions. + "Postamble, to be inserted just before </body>. Set by publishing functions. This may also be a function, building and inserting the postamble.") (defvar org-export-html-auto-preamble t "Should default preamble be inserted? Set by publishing functions.") @@ -439,7 +565,13 @@ (file-name-nondirectory org-current-export-file))) org-current-export-dir nil "Creating LaTeX image %s" - nil nil (eq (plist-get parameters :LaTeX-fragments) 'verbatim))) + nil nil + (cond + ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim) + ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax) + ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax) + ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng) + (t nil)))) (goto-char (point-min)) (let (label l1) (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) @@ -562,7 +694,7 @@ (string-match "\\.org$" path) (progn (list - "http" + "file" (concat (substring path 0 (match-beginning 0)) "." @@ -579,13 +711,10 @@ (declare (special org-export-html-inline-images org-export-html-inline-image-extensions)) - (or - (eq t org-export-html-inline-images) - (and - org-export-html-inline-images - (not descp))) - (org-file-image-p - filename org-export-html-inline-image-extensions)) + (and (or (eq t org-export-html-inline-images) + (and org-export-html-inline-images (not descp))) + (org-file-image-p + filename org-export-html-inline-image-extensions))) ;;; org-html-make-link (defun org-html-make-link (opt-plist type path fragment desc attr @@ -611,7 +740,7 @@ ;;Substitute just if original path was absolute. ;;(Otherwise path must remain relative) (if (file-name-absolute-p path) - (expand-file-name path) + (concat "file://" (expand-file-name path)) path))) ((string= type "") (list nil path)) @@ -637,7 +766,8 @@ ((or (not type) (string= type "http") - (string= type "https")) + (string= type "https") + (string= type "file")) (if fragment (setq thefile (concat thefile "#" fragment)))) @@ -647,8 +777,7 @@ (setq thefile (let ((str (org-export-html-format-href thefile))) - (if (and type (not (string= "file" type)) - (org-string-match-p "^//" str)) + (if (and type (not (string= "file" type))) (concat type ":" str) str))) @@ -781,8 +910,8 @@ (string-match "\\S-" (plist-get opt-plist :link-up)) (plist-get opt-plist :link-up))) (link-home (and (plist-get opt-plist :link-home) - (string-match "\\S-" (plist-get opt-plist :link-home)) - (plist-get opt-plist :link-home))) + (string-match "\\S-" (plist-get opt-plist :link-home)) + (plist-get opt-plist :link-home))) (dummy (setq opt-plist (plist-put opt-plist :title title))) (html-table-tag (plist-get opt-plist :html-table-tag)) (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) @@ -815,6 +944,7 @@ (buffer-substring (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) + (org-export-have-math nil) (lines (org-split-string (org-export-preprocess-string @@ -838,11 +968,21 @@ :LaTeX-fragments (plist-get opt-plist :LaTeX-fragments)) "[\r\n]")) + (mathjax + (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax) + (and org-export-have-math + (eq (plist-get opt-plist :LaTeX-fragments) t))) + + (org-export-html-mathjax-config + org-export-html-mathjax-template + org-export-html-mathjax-options + (or (plist-get opt-plist :mathjax) "")) + "")) table-open type table-buffer table-orig-buffer - ind item-type starter didclose + ind item-type starter rpl path attr desc descp desc1 desc2 link - snumber fnc item-tag initial-number + snumber fnc item-tag item-number footnotes footref-seen id-file href ) @@ -907,6 +1047,7 @@ <meta name=\"description\" content=\"%s\"/> <meta name=\"keywords\" content=\"%s\"/> %s +%s </head> <body> <div id=\"content\"> @@ -925,6 +1066,7 @@ (or charset "iso-8859-1") date author description keywords style + mathjax (if (or link-up link-home) (concat (format org-export-html-home/up-format @@ -950,73 +1092,73 @@ (push "<ul>\n<li>" thetoc) (setq lines (mapcar '(lambda (line) - (if (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line))) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) + (if (and (string-match org-todo-line-regexp line) + (not (get-text-property 0 'org-protected line))) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (save-match-data + (org-html-expand + (org-export-cleanup-toc-line + (match-string 3 line)))) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if org-export-with-section-numbers - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n<ul>\n<li>" thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "</li>\n</ul>" thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") - t t line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href - (replace-regexp-in-string - "\\." "_" (format "sec-%s" snumber))) - (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) - (push - (format - (if todo - "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" - "</li>\n<li><a href=\"#%s\">%s</a>") - href txt) thetoc) + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (if (string-match + (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) + (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + (setq snumber (org-section-number level)) + (if org-export-with-section-numbers + (setq txt (concat snumber " " txt))) + (if (<= level (max umax umax-toc)) + (setq head-count (+ head-count 1))) + (if (<= level umax-toc) + (progn + (if (> level org-last-level) + (progn + (setq cnt (- level org-last-level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "\n<ul>\n<li>" thetoc)) + (push "\n" thetoc))) + (if (< level org-last-level) + (progn + (setq cnt (- org-last-level level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "</li>\n</ul>" thetoc)) + (push "\n" thetoc))) + ;; Check for targets + (while (string-match org-any-target-regexp line) + (setq line (replace-match + (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") + t t line))) + (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) + (setq txt (replace-match "" t t txt))) + (setq href + (replace-regexp-in-string + "\\." "_" (format "sec-%s" snumber))) + (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) + (push + (format + (if todo + "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" + "</li>\n<li><a href=\"#%s\">%s</a>") + href txt) thetoc) - (setq org-last-level level)) - ))) - line) + (setq org-last-level level)) + ))) + line) lines)) (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) @@ -1059,7 +1201,16 @@ (org-open-par)) (throw 'nextline nil)) - (org-export-html-close-lists-maybe line) + ;; Explicit list closure + (when (equal "ORG-LIST-END" line) + (while local-list-indent + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) + (pop local-list-indent)) + (setq in-local-list nil) + (org-open-par) + (throw 'nextline nil)) ;; Protected HTML (when (get-text-property 0 'org-protected line) @@ -1178,79 +1329,79 @@ desc2 (if (match-end 2) (concat type ":" path) path) descp (and desc1 (not (equal desc1 desc2))) desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted + ;; Make an image out of the description if that is so wanted (when (and descp (org-file-image-p - desc org-export-html-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props + desc org-export-html-inline-image-extensions)) + (save-match-data + (if (string-match "^file:" desc) + (setq desc (substring desc (match-end 0))))) + (setq desc (org-add-props (concat "<img src=\"" desc "\"/>") '(org-protected t)))) (cond ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl + (let + ((frag-0 + (if (= (string-to-char path) ?#) + (substring path 1) + path))) + (setq rpl (org-html-make-link - opt-plist - "" - "" - (org-solidify-link-text - (save-match-data (org-link-unescape frag-0)) - nil) - desc attr nil)))) + opt-plist + "" + "" + (org-solidify-link-text + (save-match-data (org-link-unescape frag-0)) + nil) + desc attr nil)))) ((and (equal type "id") (setq id-file (org-id-find-id-file path))) ;; This is an id: link to another file (if it was the same file, ;; it would have become an internal link...) (save-match-data (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-html-make-link opt-plist - "file" id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc - attr - nil)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image + id-file + (file-name-directory org-current-export-file))) (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - (org-html-should-inline-p path descp)))) + (org-html-make-link opt-plist + "file" id-file + (concat (if (org-uuidgen-p path) "ID-") path) + desc + attr + nil)))) + ((member type '("http" "https")) + ;; standard URL, can inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + (org-html-should-inline-p path descp)))) ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - nil))) + ;; standard URL, can't inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + nil))) ((string= type "coderef") - (let* - ((coderef-str (format "coderef-%s" path)) - (attr-1 - (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" + (let* + ((coderef-str (format "coderef-%s" path)) + (attr-1 + (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" coderef-str coderef-str))) - (setq rpl + (setq rpl (org-html-make-link opt-plist - type "" coderef-str - (format - (org-export-get-coderef-format - path - (and descp desc)) - (cdr (assoc path org-export-code-refs))) - attr-1 - nil)))) + type "" coderef-str + (format + (org-export-get-coderef-format + path + (and descp desc)) + (cdr (assoc path org-export-code-refs))) + attr-1 + nil)))) ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) ;; The link protocol has a function for format the link @@ -1259,55 +1410,55 @@ (funcall fnc (org-link-unescape path) desc1 'html)))) ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) + ;; FILE link + (save-match-data + (let* + ((components + (if + (string-match "::\\(.*\\)" path) + (list + (replace-match "" t nil path) + (match-string 1 path)) + (list path nil))) - ;;The proper path, without a fragment - (path-1 - (first components)) + ;;The proper path, without a fragment + (path-1 + (first components)) - ;;The raw fragment - (fragment-0 - (second components)) + ;;The raw fragment + (fragment-0 + (second components)) - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) + ;;Check the fragment. If it can't be used as + ;;target fragment we'll pass nil instead. + (fragment-1 + (if + (and fragment-0 + (not (string-match "^[0-9]*$" fragment-0)) + (not (string-match "^\\*" fragment-0)) + (not (string-match "^/.*/$" fragment-0))) + (org-solidify-link-text + (org-link-unescape fragment-0)) + nil)) + (desc-2 + ;;Description minus "file:" and ".org" + (if (string-match "^file:" desc) + (let + ((desc-1 (replace-match "" t t desc))) + (if (string-match "\\.org$" desc-1) + (replace-match "" t t desc-1) + desc-1)) + desc))) - (setq rpl - (if + (setq rpl + (if (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) + (functionp link-validate) + (not (funcall link-validate path-1 current-dir))) desc - (org-html-make-link opt-plist - "file" path-1 fragment-1 desc-2 attr - (org-html-should-inline-p path-1 descp))))))) + (org-html-make-link opt-plist + "file" path-1 fragment-1 desc-2 attr + (org-html-should-inline-p path-1 descp))))))) (t ;; just publish the path, as default @@ -1364,14 +1515,6 @@ (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) (setq head-count (+ head-count 1))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) (setq first-heading-pos (or first-heading-pos (point))) (org-html-level-start level txt umax (and org-export-with-toc (<= level umax)) @@ -1383,19 +1526,6 @@ (insert "<pre>") (setq inquote t))) - ((string-match "^[ \t]*- __+[ \t]*$" line) - ;; Explicit list closure - (when local-list-type - (let ((ind (org-get-indentation line))) - (while (and local-list-indent - (<= ind (car local-list-indent))) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) - (pop local-list-indent)) - (or local-list-indent (setq in-local-list nil)))) - (throw 'nextline nil)) - ((and org-export-with-tables (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) (when (not table-open) @@ -1428,66 +1558,57 @@ starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) - initial-number nil + item-number nil item-tag nil) - (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) - (setq initial-number (match-string 1 line) + (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) + (setq item-number (match-string 1 line) line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) line (substring line (match-end 0)))) - (when (and (not (equal item-type "d")) - (not (string-match "[^ \t]" line))) - ;; empty line. Pretend indentation is large. - (setq ind (if org-empty-line-terminates-plain-lists - 0 - (1+ (or (car local-list-indent) 1))))) - (setq didclose nil) - (while (and in-local-list - (or (and (= ind (car local-list-indent)) - (not starter)) - (< ind (car local-list-indent)))) - (setq didclose t) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) (cond ((and starter (or (not in-local-list) (> ind (car local-list-indent)))) - ;; check for a specified start number ;; Start new (level of) list (org-close-par-maybe) (insert (cond ((equal item-type "u") "<ul>\n<li>\n") - ((equal item-type "o") - (if initial-number - (format "<ol start=%s>\n<li>\n" initial-number) - "<ol>\n<li>\n")) + ((and (equal item-type "o") item-number) + (format "<ol>\n<li value=\"%s\">\n" item-number)) + ((equal item-type "o") "<ol>\n<li>\n") ((equal item-type "d") (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) (push item-type local-list-type) (push ind local-list-indent) (setq in-local-list t)) + ;; Continue list (starter - ;; continue current list + ;; terminate any previous sublist but first ensure + ;; list is not ill-formed. + (let ((min-ind (apply 'min local-list-indent))) + (when (< ind min-ind) (setq ind min-ind))) + (while (< ind (car local-list-indent)) + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + ;; insert new item (org-close-li (car local-list-type)) (insert (cond ((equal (car local-list-type) "d") (format "<dt>%s</dt><dd>\n" (or item-tag "???"))) - (t "<li>\n")))) - (didclose - ;; we did close a list, normal text follows: need <p> - (org-open-par))) + ((and (equal item-type "o") item-number) + (format "<li value=\"%s\">\n" item-number)) + (t "<li>\n"))))) (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) (setq line (replace-match (if (equal (match-string 1 line) "X") "<b>[X]</b>" "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") - t t line)))) + t t line)))) ;; Horizontal line (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) @@ -1542,14 +1663,7 @@ (when inquote (insert "</pre>\n") (org-open-par)) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) + (org-html-level-start 1 nil umax (and org-export-with-toc (<= level umax)) head-count) @@ -1630,8 +1744,6 @@ (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) (replace-match "")) (goto-char (point-min)) - (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t) - (replace-match "")) ;; Convert whitespace place holders (goto-char (point-min)) (let (beg end n) @@ -1726,13 +1838,14 @@ nil)))) (defvar org-table-number-regexp) ; defined in org-table.el -(defun org-format-table-html (lines olines) - "Find out which HTML converter to use and return the HTML code." +(defun org-format-table-html (lines olines &optional no-css) + "Find out which HTML converter to use and return the HTML code. +NO-CSS is passed to the exporter." (if (stringp lines) (setq lines (org-split-string lines "\n"))) (if (string-match "^[ \t]*|" (car lines)) ;; A normal org table - (org-format-org-table-html lines) + (org-format-org-table-html lines nil no-css) ;; Table made by table.el - test for spanning (let* ((hlines (delq nil (mapcar (lambda (x) @@ -1753,8 +1866,12 @@ (org-format-table-table-html-using-table-generate-source olines))))) (defvar org-table-number-fraction) ; defined in org-table.el -(defun org-format-org-table-html (lines &optional splice) - "Format a table into HTML." +(defun org-format-org-table-html (lines &optional splice no-css) + "Format a table into HTML. +LINES is a list of lines. Optional argument SPLICE means, do not +insert header and surrounding <table> tags, just format the lines. +Optional argument NO-CSS means use XHTML attributes instead of CSS +for formatting. This is required for the DocBook exporter." (require 'org-table) ;; Get rid of hlines at beginning and end (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) @@ -1768,6 +1885,8 @@ (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) (label (org-find-text-property-in-string 'org-label (car lines))) + (forced-aligns (org-find-text-property-in-string 'org-forced-aligns + (car lines))) (attributes (org-find-text-property-in-string 'org-attributes (car lines))) (html-table-tag (org-export-splice-attributes @@ -1776,10 +1895,13 @@ (delq nil (mapcar (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) - - (nline 0) fnum nfields i - tbopen line fields html gr colgropen rowstart rowend) + (nline 0) fnum nfields i (cnt 0) + tbopen line fields html gr colgropen rowstart rowend + ali align aligns n) (setq caption (and caption (org-html-do-expand caption))) + (when (and forced-aligns org-table-clean-did-remove-column) + (setq forced-aligns + (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns))) (if splice (setq head nil)) (unless splice (push (if head "<thead>" "<tbody>") html)) (setq tbopen t) @@ -1803,23 +1925,26 @@ (push (concat rowstart (mapconcat (lambda (x) - (setq i (1+ i)) + (setq i (1+ i) ali (format "@@class%03d@@" i)) (if (and (< i nfields) ; make sure no rogue line causes an error here (string-match org-table-number-regexp x)) (incf (aref fnum i))) (cond (head (concat - (format (car org-export-table-header-tags) "col") + (format (car org-export-table-header-tags) + "col" ali) x (cdr org-export-table-header-tags))) ((and (= i 0) org-export-html-table-use-header-tags-for-first-column) (concat - (format (car org-export-table-header-tags) "row") + (format (car org-export-table-header-tags) + "row" ali) x (cdr org-export-table-header-tags))) (t - (concat (car org-export-table-data-tags) x + (concat (format (car org-export-table-data-tags) ali) + x (cdr org-export-table-data-tags))))) fields "") rowend) @@ -1832,23 +1957,38 @@ (unless (car org-table-colgroup-info) (setq org-table-colgroup-info (cons :start (cdr org-table-colgroup-info)))) + (setq i 0) (push (mapconcat (lambda (x) - (setq gr (pop org-table-colgroup-info)) - (format "%s<col align=\"%s\" />%s" + (setq gr (pop org-table-colgroup-info) + i (1+ i) + align (if (assoc i forced-aligns) + (cdr (assoc (cdr (assoc i forced-aligns)) + '(("l" . "left") ("r" . "right") + ("c" . "center")))) + (if (> (/ (float x) nline) + org-table-number-fraction) + "right" "left"))) + (push align aligns) + (format (if no-css + "%s<col align=\"%s\" />%s" + "%s<col class=\"%s\" />%s") (if (memq gr '(:start :startend)) (prog1 - (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") + (if colgropen + "</colgroup>\n<colgroup>" + "<colgroup>") (setq colgropen t)) "") - (if (> (/ (float x) nline) org-table-number-fraction) - "right" "left") + align (if (memq gr '(:end :startend)) (progn (setq colgropen nil) "</colgroup>") ""))) fnum "") html) - (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) + (setq aligns (nreverse aligns)) + (if colgropen (setq html (cons (car html) + (cons "</colgroup>" (cdr html))))) ;; Since the output of HTML table formatter can also be used in ;; DocBook document, we want to always include the caption to make ;; DocBook XML file valid. @@ -1856,6 +1996,18 @@ (when label (push (format "<a name=\"%s\" id=\"%s\"></a>" label label) html)) (push html-table-tag html)) + (setq html (mapcar + (lambda (x) + (replace-regexp-in-string + "@@class\\([0-9]+\\)@@" + (lambda (txt) + (if (not org-export-html-table-align-individual-fields) + "" + (setq n (string-to-number (match-string 1 txt))) + (format (if no-css " align=\"%s\"" " class=\"%s\"") + (or (nth n aligns) "left")))) + x)) + html)) (concat (mapconcat 'identity html "\n") "\n"))) (defun org-export-splice-attributes (tag attributes) @@ -1900,10 +2052,10 @@ (if (equal x "") (setq x empty)) (if head (concat - (format (car org-export-table-header-tags) "col") + (format (car org-export-table-header-tags) "col" "") x (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x + (concat (format (car org-export-table-data-tags) "") x (cdr org-export-table-data-tags)))) field-buffer "\n") "</tr>\n")) @@ -2042,7 +2194,7 @@ "Prepare STRING for HTML export. Apply all active conversions. If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) m s l res) (if (string-match "^[ \t]*\\+-[-+]*\\+[ \t]*$" string) string @@ -2152,28 +2304,6 @@ (defvar in-local-list) (defvar local-list-indent) (defvar local-list-type) -(defun org-export-html-close-lists-maybe (line) - "Close local lists based on the original indentation of the line." - (let* ((rawhtml (and in-local-list - (get-text-property 0 'org-protected line) - (not (get-text-property 0 'org-example line)))) - ;; rawhtml means: This was between #+begin_html..#+end_html - ;; originally, thus it excludes stuff that was a source code example - ;; Actually, this code seems wrong, I don't know why it works, but - ;; it seems to work.... So keep it like this for now. - (ind (if rawhtml - (org-get-indentation line) - (get-text-property 0 'original-indentation line))) - didclose) - (when ind - (while (and in-local-list - (<= ind (car local-list-indent))) - (setq didclose t) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - (and didclose (org-open-par))))) (defvar body-only) ; dynamically scoped into this. (defun org-html-level-start (level title umax with-toc head-count) @@ -2206,7 +2336,7 @@ (when title ;; If title is nil, this means this function is called to close ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match (if org-export-with-tags (save-match-data
--- a/lisp/org/org-icalendar.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-icalendar.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -47,13 +47,24 @@ :group 'org-export-icalendar :type 'file) +(defcustom org-icalendar-alarm-time 0 + "Number of minutes for triggering an alarm for exported timed events. +A zero value (the default) turns off the definition of an alarm trigger +for timed events. If non-zero, alarms are created. + +- a single alarm per entry is defined +- The alarm will go off N minutes before the event +- only a DISPLAY action is defined." + :group 'org-export-icalendar + :type 'integer) + (defcustom org-icalendar-combined-name "OrgMode" "Calendar name for the combined iCalendar representing all agenda files." :group 'org-export-icalendar :type 'string) (defcustom org-icalendar-combined-description nil - "Calendar description for the combined iCalendar representing all agenda files." + "Calendar description for the combined iCalendar (all agenda files)." :group 'org-export-icalendar :type 'string) @@ -183,6 +194,13 @@ (const :tag "Unspecified" nil) (string :tag "Time zone"))) +(defcustom org-icalendar-use-UTC-date-time () + "Non-nil force the use of the universal time for iCalendar DATE-TIME. +The iCalendar DATE-TIME can be expressed with local time or universal Time, +universal time could be more compatible with some external tools." + :group 'org-export-icalendar + :type 'boolean) + ;;; iCalendar export ;;;###autoload @@ -282,7 +300,7 @@ "DTSTART")) hd ts ts2 state status (inc t) pos b sexp rrule scheduledp deadlinep todo prefix due start - tmp pri categories location summary desc uid + tmp pri categories location summary desc uid alarm (sexp-buffer (get-buffer-create "*ical-tmp*"))) (org-refresh-category-properties) (save-excursion @@ -300,7 +318,7 @@ inc t hd (condition-case nil (org-icalendar-cleanup-string - (org-get-heading)) + (org-get-heading t)) (error (throw :skip nil))) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) @@ -314,6 +332,7 @@ (org-id-get-create) (or (org-id-get) (org-id-new))) categories (org-export-get-categories) + alarm "" deadlinep nil scheduledp nil) (if (looking-at re2) (progn @@ -362,6 +381,17 @@ ";INTERVAL=" (match-string 1 ts))) (setq rrule "")) (setq summary (or summary hd)) + ;; create an alarm entry if the entry is timed. this is not very general in that: + ;; (a) only one alarm per entry is defined, + ;; (b) only minutes are allowed for the trigger period ahead of the start time, and + ;; (c) only a DISPLAY action is defined. + ;; [ESF] + (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) + (if (and (> org-icalendar-alarm-time 0) + (car t1) (nth 1 t1) (nth 2 t1)) + (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0D0H%dM0S\nEND:VALARM" summary org-icalendar-alarm-time)) + (setq alarm "")) + ) (if (string-match org-bracket-link-regexp summary) (setq summary (replace-match (if (match-end 3) @@ -378,7 +408,7 @@ %s %s%s SUMMARY:%s%s%s -CATEGORIES:%s +CATEGORIES:%s%s END:VEVENT\n" (concat prefix uid) (org-ical-ts-to-string ts "DTSTART") @@ -388,7 +418,8 @@ (concat "\nDESCRIPTION: " desc) "") (if (and location (string-match "\\S-" location)) (concat "\nLOCATION: " location) "") - categories))))) + categories + alarm))))) (when (and org-icalendar-include-sexps (condition-case nil (require 'icalendar) (error nil)) (fboundp 'icalendar-export-region)) @@ -415,7 +446,7 @@ (when org-icalendar-include-todo (setq prefix "TODO-") (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) + (while (re-search-forward org-complex-heading-regexp nil t) (catch :skip (org-agenda-skip) (when org-icalendar-verify-function @@ -447,7 +478,7 @@ ((eq org-icalendar-include-todo t) ;; include everything that is not done (member state org-not-done-keywords)))) - (setq hd (match-string 3) + (setq hd (match-string 4) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) desc (org-icalendar-cleanup-string @@ -610,8 +641,13 @@ (setq h (+ 2 h))) (setq d (1+ d)))) (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time))))) + (setq fmt (if have-time (if org-icalendar-use-UTC-date-time + ":%Y%m%dT%H%M%SZ" + ":%Y%m%dT%H%M%S") + ";VALUE=DATE:%Y%m%d")) + (concat keyword (format-time-string fmt time + (and org-icalendar-use-UTC-date-time + have-time)))))) (provide 'org-icalendar)
--- a/lisp/org/org-id.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-id.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -596,6 +596,7 @@ ;; Calling the following function is hard-coded into `org-store-link', ;; so we do have to add it to `org-store-link-functions'. +;;;###autoload (defun org-id-store-link () "Store a link to the current entry, using its ID." (interactive)
--- a/lisp/org/org-indent.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-indent.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -135,11 +135,11 @@ ((org-bound-and-true-p org-inhibit-startup) (setq org-indent-mode nil)) ((and org-indent-mode (featurep 'xemacs)) - (message "org-indent-mode does not work in XEmacs - refused to turn it on") + (message "org-indent-mode does not work in XEmacs - refusing to turn it on") (setq org-indent-mode nil)) ((and org-indent-mode (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) - (message "org-indent-mode is can crash Emacs 23.1 - refused to turn it on!") + (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") (ding) (sit-for 1) (setq org-indent-mode nil)) @@ -203,8 +203,9 @@ (defun org-indent-remove-properties (beg end) "Remove indentations between BEG and END." - (org-unmodified - (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + (let ((inhibit-modification-hooks t)) + (with-silent-modifications + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))) (defun org-indent-remove-properties-from-string (string) "Remove indentations between BEG and END." @@ -219,8 +220,9 @@ "Add indentation properties between BEG and END. Assumes that BEG is at the beginning of a line." (when (or t org-indent-mode) - (let (ov b e n level exit nstars) - (org-unmodified + (let ((inhibit-modification-hooks t) + ov b e n level exit nstars) + (with-silent-modifications (save-excursion (goto-char beg) (while (not exit)
--- a/lisp/org/org-info.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-info.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-inlinetask.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-inlinetask.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -90,7 +90,9 @@ not set, it will be assumed to be one less than the value of smaller than the value of this variable." :group 'org-inlinetask - :type 'boolean) + :type '(choice + (const :tag "Off" nil) + (integer))) (defcustom org-inlinetask-export t "Non-nil means export inline tasks. @@ -104,7 +106,7 @@ (defvar org-complex-heading-regexp) (defvar org-property-end-re) -(defcustom org-inlinetask-defaut-state nil +(defcustom org-inlinetask-default-state nil "Non-nil means make inline tasks have a TODO keyword initially. This should be the state `org-inlinetask-insert-task' should use by default, or nil of no state should be assigned." @@ -115,20 +117,36 @@ (defun org-inlinetask-insert-task (&optional no-state) "Insert an inline task. -If prefix arg NO-STATE is set, ignore `org-inlinetask-defaut-state'." +If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'." (interactive "P") (or (bolp) (newline)) (let ((indent org-inlinetask-min-level)) (if org-odd-levels-only (setq indent (- (* 2 indent) 1))) (insert (make-string indent ?*) - (if (or no-state (not org-inlinetask-defaut-state)) + (if (or no-state (not org-inlinetask-default-state)) " \n" - (concat " " org-inlinetask-defaut-state " \n")) + (concat " " org-inlinetask-default-state " \n")) (make-string indent ?*) " END\n")) (end-of-line -1)) (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) +(defun org-inlinetask-in-task-p () + "Return true if point is inside an inline task." + (save-excursion + (let* ((nstars (if org-odd-levels-only + (1- (* 2 (or org-inlinetask-min-level 200))) + (or org-inlinetask-min-level 200))) + (stars-re (concat "^\\(?:\\*\\{" + (format "%d" (- nstars 1)) + ",\\}\\)[ \t]+")) + (task-beg-re (concat stars-re "\\(?:.*\\)")) + (task-end-re (concat stars-re "\\(?:END\\|end\\)"))) + (beginning-of-line) + (or (looking-at task-beg-re) + (and (re-search-forward "^\\*+[ \t]+" nil t) + (progn (beginning-of-line) (looking-at task-end-re))))))) + (defvar htmlp) ; dynamically scoped into the next function (defvar latexp) ; dynamically scoped into the next function (defun org-inlinetask-export-handler ()
--- a/lisp/org/org-irc.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-irc.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-jsinfo.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-jsinfo.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-latex.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-latex.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-latex.el -;; Version: 7.01 +;; Version: 7.3 ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -280,6 +280,11 @@ (string :tag "Keyword") (string :tag "Markup"))))) +(defcustom org-export-latex-tag-markup "\\textbf{%s}" + "Markup for tags, as a printf format." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-timestamp-markup "\\textit{%s}" "A printf format string to be applied to time stamps." :group 'org-export-latex @@ -371,12 +376,30 @@ (require 'org-latex) (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\")) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))" + (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\")) + +Alternatively, + + (setq org-export-latex-listings 'minted) + +causes source code to be exported using the minted package as +opposed to listings. If you want to use minted, you need to add +the minted package to `org-export-latex-packages-alist', for +example using customize, or with + + (require 'org-latex) + (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\")) + +In addition, it is neccessary to install +pygments (http://pygments.org), and to configure +`org-latex-to-pdf-process' so that the -shell-escape option is +passed to pdflatex. +" :group 'org-export-latex :type 'boolean) (defcustom org-export-latex-listings-langs - '((emacs-lisp "Lisp") (lisp "Lisp") + '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") (c "C") (cc "C++") (fortran "fortran") (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") @@ -398,6 +421,44 @@ (symbol :tag "Major mode ") (string :tag "Listings language")))) +(defcustom org-export-latex-listings-w-names t + "Non-nil means export names of named code blocks. +Code blocks exported with the listings package (controlled by the +`org-export-latex-listings' variable) can be named in the style +of noweb." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-export-latex-minted-langs + '((emacs-lisp "common-lisp") + (cc "c++") + (cperl "perl") + (shell-script "bash") + (caml "ocaml")) + "Alist mapping languages to their minted language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language parameter +for the minted package. If the mode name and the listings name are +the same, the language does not need an entry in this list - but it does not +hurt if it is present. + +Note that minted uses all lower case for language identifiers, +and that the full list of language identifiers can be obtained +with: +pygmentize -L lexers +" + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + +(defcustom org-export-latex-minted-with-line-numbers nil + "Should source code line numbers be included when exporting +with the latex minted package?" + :group 'org-export-latex + :type 'boolean) + (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) "A plist of keywords to remove from headlines. OBSOLETE. @@ -443,24 +504,53 @@ :group 'org-export) (defcustom org-latex-to-pdf-process - '("pdflatex -interaction nonstopmode %s" - "pdflatex -interaction nonstopmode %s") + '("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f") "Commands to process a LaTeX file to a PDF file. This is a list of strings, each of them will be given to the shell -as a command. %s in the command will be replaced by the full file name, %b -by the file base name (i.e. without extension). +as a command. %f in the command will be replaced by the full file name, %b +by the file base name (i.e. without extension) and %o by the base directory +of the file. + The reason why this is a list is that it usually takes several runs of -pdflatex, maybe mixed with a call to bibtex. Org does not have a clever +`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever mechanism to detect which of these commands have to be run to get to a stable result, and it also does not do any error checking. +By default, Org uses 3 runs of `pdflatex' to do the processing. If you +have texi2dvi on your system and if that does not cause the infamous +egrep/locale bug: + + http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html + +then `texi2dvi' is the superior choice. Org does offer it as one +of the customize options. + Alternatively, this may be a Lisp function that does the processing, so you could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode. This function should accept the file name as its single argument." :group 'org-export-pdf - :type '(choice (repeat :tag "Shell command sequence" + :type '(choice + (repeat :tag "Shell command sequence" (string :tag "Shell command")) - (function))) + (const :tag "2 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "pdflatex,bibtex,pdflatex,pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "texi2dvi" + ("texi2dvi -p -b -c -V %f")) + (const :tag "rubber" + ("rubber -d --into %o %f")) + (function))) (defcustom org-export-pdf-logfiles '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") @@ -832,9 +922,10 @@ (save-excursion (goto-char (point-min)) (re-search-forward "\\\\bibliography{" nil t)))) - cmd) + cmd output-dir errors) (with-current-buffer outbuf (erase-buffer)) - (message "Processing LaTeX file...") + (message (concat "Processing LaTeX file " file "...")) + (setq output-dir (file-name-directory file)) (if (and cmds (symbolp cmds)) (funcall cmds (shell-quote-argument file)) (while cmds @@ -844,23 +935,52 @@ (save-match-data (shell-quote-argument base)) t t cmd))) - (while (string-match "%s" cmd) + (while (string-match "%f" cmd) (setq cmd (replace-match (save-match-data (shell-quote-argument file)) t t cmd))) - (shell-command cmd outbuf outbuf))) - (message "Processing LaTeX file...done") + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf))) + (message (concat "Processing LaTeX file " file "...done")) + (setq errors (org-export-latex-get-error outbuf)) (if (not (file-exists-p pdffile)) - (error "PDF file was not produced") + (error (concat "PDF file " pdffile " was not produced" + (if errors (concat ":" errors "") ""))) (set-window-configuration wconfig) (when org-export-pdf-remove-logfiles (dolist (ext org-export-pdf-logfiles) (setq file (concat base "." ext)) (and (file-exists-p file) (delete-file file)))) - (message "Exporting to PDF...done") + (message (concat + "Exporting to PDF...done" + (if errors + (concat ", with some errors:" errors) + ""))) pdffile))) +(defun org-export-latex-get-error (buf) + "Collect the kinds of errors that remain in pdflatex processing." + (with-current-buffer buf + (save-excursion + (goto-char (point-max)) + (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t) + ;; OK, we are at the location of the final run + (let ((pos (point)) (errors "") (case-fold-search t)) + (if (re-search-forward "Reference.*?undefined" nil t) + (setq errors (concat errors " [undefined reference]"))) + (goto-char pos) + (if (re-search-forward "Citation.*?undefined" nil t) + (setq errors (concat errors " [undefined citation]"))) + (goto-char pos) + (if (re-search-forward "Undefined control sequence" nil t) + (setq errors (concat errors " [undefined control sequence]"))) + (and (org-string-nw-p errors) errors)))))) + ;;;###autoload (defun org-export-as-pdf-and-open (arg) "Export as LaTeX, then process through to PDF, and open." @@ -1158,7 +1278,7 @@ (plist-get opt-plist :latex-header-extra))) ;; append another special variable (org-export-apply-macros-in-string org-export-latex-append-header) - ;; define align if not yet defined + ;; define alert if not yet defined "\n\\providecommand{\\alert}[1]{\\textbf{#1}}" ;; insert the title (format @@ -1227,9 +1347,13 @@ '(:org-license-to-kill t)) (save-excursion (goto-char pt) - (while (re-search-forward "^[ \t]*#+.*\n?" limit t) - (remove-text-properties (match-beginning 0) (match-end 0) - '(:org-license-to-kill t)))))))))) + (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t) + (let ((case-fold-search t)) + (unless (org-string-match-p + "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)" + (match-string 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(:org-license-to-kill t)))))))))))) (defvar org-export-latex-header-defs nil @@ -1310,13 +1434,13 @@ (replace-match "") (replace-match (format "\\textbf{%s}" (match-string 0)) t t))) ;; convert tags - (when (re-search-forward "\\(:[a-zA-Z0-9_@]+\\)+:" nil t) + (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t) (if (or (not org-export-with-tags) (plist-get remove-list :tags)) (replace-match "") (replace-match (org-export-latex-protect-string - (format "\\textbf{%s}" + (format org-export-latex-tag-markup (save-match-data (replace-regexp-in-string "_" "\\\\_" (match-string 0))))) @@ -1589,7 +1713,7 @@ (org-table-last-column-widths (copy-sequence org-table-last-column-widths)) fnum fields line lines olines gr colgropen line-fmt align - caption shortn label attr floatp longtblp) + caption shortn label attr floatp placement longtblp) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table "\\end{verbatim}\n"))) @@ -1609,7 +1733,12 @@ align (and attr (stringp attr) (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (match-string 1 attr)) - floatp (or caption label)) + floatp (or caption label) + placement (if (and attr + (stringp attr) + (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr)) + (match-string 1 attr) + "[htb]")) (setq caption (and caption (org-export-latex-fontify-headline caption))) (setq lines (org-split-string raw-table "\n")) (apply 'delete-region (list beg end)) @@ -1664,12 +1793,13 @@ (concat (if longtblp (concat "\\begin{longtable}{" align "}\n") - (if floatp "\\begin{table}[htb]\n")) + (if floatp (format "\\begin{table}%s\n" placement))) (if floatp (format - "\\caption%s{%s}" + "\\caption%s{%s} %s" (if shortn (concat "[" shortn "]") "") - (or caption ""))) + (or caption "") + (if label (format "\\label{%s}" label) ""))) (if (and longtblp caption) "\\\\\n" "\n") (if (and org-export-latex-tables-centered (not longtblp)) "\\begin{center}\n") @@ -1741,7 +1871,7 @@ (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) (when floatp (setq tbl (concat "\\begin{table}\n" - (format "\\caption%s{%s%s}\n" + (format "\\caption%s{%s}%s\n" (if shortn (format "[%s]" shortn) "") (if label (format "\\label{%s}" label) "") (or caption "")) @@ -2213,11 +2343,11 @@ "Convert plain text lists in current buffer into LaTeX lists." (let (res) (goto-char (point-min)) - (while (org-re-search-forward-unprotected org-list-beginning-re nil t) + (while (org-search-forward-unenclosed org-item-beginning-re nil t) (beginning-of-line) (setq res (org-list-to-latex (org-list-parse-list t) org-export-latex-list-parameters)) - (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" + (while (string-match "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]" res) (setq res (replace-match (concat (format "\\setcounter{enumi}{%d}"
--- a/lisp/org/org-list.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-list.el Wed Nov 17 13:09:08 2010 +0900 @@ -7,7 +7,7 @@ ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -40,21 +40,31 @@ (defvar org-M-RET-may-split-line) (defvar org-complex-heading-regexp) (defvar org-odd-levels-only) +(defvar org-outline-regexp) +(defvar org-ts-regexp) +(defvar org-ts-regexp-both) (declare-function org-invisible-p "org" ()) (declare-function org-on-heading-p "org" (&optional invisible-ok)) (declare-function outline-next-heading "outline" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-back-over-empty-lines "org" ()) -(declare-function org-skip-whitespace "org" ()) (declare-function org-trim "org" (s)) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-timer-item "org-timer" (&optional arg)) +(declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-combine-plists "org" (&rest plists)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-subtree "org" ()) +(declare-function org-in-regexps-block-p "org" + (start-re end-re &optional bound)) +(declare-function org-level-increment "org" ()) +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function outline-previous-heading "outline" ()) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-time-string-to-seconds "org" (s)) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." @@ -63,7 +73,6 @@ (defcustom org-cycle-include-plain-lists t "When t, make TAB cycle visibility on plain list items. - Cycling plain lists works only when the cursor is on a plain list item. When the cursor is on an outline heading, plain lists are treated as text. This is the most stable way of handling this, @@ -140,38 +149,88 @@ (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. When nil, no bullet will have two spaces after them. -When a string, it will be used as a regular expression. When the bullet -type of a list is changed, the new bullet type will be matched against this -regexp. If it matches, there will be two spaces instead of one after -the bullet in each item of he list." +When a string, it will be used as a regular expression. When the +bullet type of a list is changed, the new bullet type will be +matched against this regexp. If it matches, there will be two +spaces instead of one after the bullet in each item of the list." :group 'org-plain-lists :type '(choice (const :tag "never" nil) (regexp))) +(defcustom org-list-ending-method 'both + "Determine where plain lists should end. +Valid values are: `regexp', `indent' or `both'. + +When set to `regexp', Org will look into two variables, +`org-empty-line-terminates-plain-lists' and the more general +`org-list-end-regexp', to determine what will end lists. This is +the fastest method. + +When set to `indent', a list will end whenever a line following +an item, but not starting one, is less or equally indented than +it. + +When set to `both', each of the preceding methods is applied to +determine lists endings. This is the default method." + :group 'org-plain-lists + :type '(choice + (const :tag "With a regexp defining ending" regexp) + (const :tag "With indentation of regular (no bullet) text" indent) + (const :tag "With both methods" both))) + (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. -This is currently effective only during export. It should also have -an effect for indentation and plain list folding, but it does not. -When nil, empty lines are part of the preceding item." +This variable only makes sense if `org-list-ending-method' is set +to `regexp' or `both'. This is then equivalent to set +`org-list-end-regexp' to \"^[ \\t]*$\"." :group 'org-plain-lists :type 'boolean) -(defcustom org-auto-renumber-ordered-lists t - "Non-nil means automatically renumber ordered plain lists. -Renumbering happens when the sequence have been changed with -\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, -use \\[org-ctrl-c-ctrl-c] to trigger renumbering." +(defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n" + "Regexp matching the end of all plain list levels. +It must start with \"^\" and end with \"\\n\". It defaults to 2 +blank lines. `org-empty-line-terminates-plain-lists' has +precedence over it." :group 'org-plain-lists - :type 'boolean) + :type 'string) + +(defcustom org-list-automatic-rules '((bullet . t) + (checkbox . t) + (indent . t) + (insert . t)) + "Non-nil means apply set of rules when acting on lists. +By default, automatic actions are taken when using + \\[org-meta-return], \\[org-metaright], \\[org-metaleft], + \\[org-shiftmetaright], \\[org-shiftmetaleft], + \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or + \\[org-insert-todo-heading]. You can disable individually these + rules by setting them to nil. Valid rules are: -(defcustom org-provide-checkbox-statistics t - "Non-nil means update checkbox statistics after insert and toggle. -When this is set, checkbox statistics is updated each time you -either insert a new checkbox with \\[org-insert-todo-heading] or -toggle a checkbox with \\[org-ctrl-c-ctrl-c]." - :group 'org-plain-lists - :type 'boolean) +bullet when non-nil, cycling bullet do not allow lists at + column 0 to have * as a bullet and descriptions lists + to be numbered. +checkbox when non-nil, checkbox statistics is updated each time + you either insert a new checkbox or toggle a checkbox. + It also prevents from inserting a checkbox in a + description item. +indent when non-nil, indenting or outdenting list top-item + with its subtree will move the whole list and + outdenting a list whose bullet is * to column 0 will + change that bullet to - +insert when non-nil, trying to insert an item inside a block + will insert it right before the block instead of + throwing an error." + :group 'org-plain-lists + :type '(alist :tag "Sets of rules" + :key-type + (choice + (const :tag "Bullet" bullet) + (const :tag "Checkbox" checkbox) + (const :tag "Indent" indent) + (const :tag "Insert" insert)) + :value-type + (boolean :tag "Activate" :value t))) (defcustom org-hierarchical-checkbox-statistics t "Non-nil means checkbox statistics counts only the state of direct children. @@ -188,9 +247,6 @@ :group 'org-plain-lists :type 'integer) -(defvar org-list-beginning-re - "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$") - (defcustom org-list-radio-list-templates '((latex-mode "% BEGIN RECEIVE ORGLST %n % END RECEIVE ORGLST %n @@ -218,9 +274,14 @@ (list (symbol :tag "Major mode") (string :tag "Format")))) -;;;; Plain list items, including checkboxes +;;; Internal functions -;;; Plain list items +(defun org-list-end-re () + "Return the regex corresponding to the end of a list. +It depends on `org-empty-line-terminates-plain-lists'." + (if org-empty-line-terminates-plain-lists + "^[ \t]*\n" + org-list-end-regexp)) (defun org-item-re (&optional general) "Return the correct regular expression for plain lists. @@ -228,19 +289,526 @@ of `org-plain-list-ordered-item-terminator'." (cond ((or general (eq org-plain-list-ordered-item-terminator t)) - "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") ((= org-plain-list-ordered-item-terminator ?.) - "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") ((= org-plain-list-ordered-item-terminator ?\)) - "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) +(defconst org-item-beginning-re (concat "^" (org-item-re)) + "Regexp matching the beginning of a plain list item.") + +(defun org-list-ending-between (min max &optional firstp) + "Find the position of a list ending between MIN and MAX, or nil. +This function looks for `org-list-end-re' outside a block. + +If FIRSTP in non-nil, return the point at the beginning of the +nearest valid terminator from MIN. Otherwise, return the point at +the end of the nearest terminator from MAX." + (save-excursion + (let* ((start (if firstp min max)) + (end (if firstp max min)) + (search-fun (if firstp + #'org-search-forward-unenclosed + #'org-search-backward-unenclosed)) + (list-end-p (progn + (goto-char start) + (funcall search-fun (org-list-end-re) end t)))) + ;; Is there a valid list ending somewhere ? + (and list-end-p + ;; we want to be on the first line of the list ender + (match-beginning 0))))) + +(defun org-list-maybe-skip-block (search limit) + "Return non-nil value if point is in a block, skipping it on the way. +It looks for the boundary of the block in SEARCH direction, +stopping at LIMIT." + (save-match-data + (let ((case-fold-search t) + (boundary (if (eq search 're-search-forward) 3 5))) + (when (save-excursion + (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t) + (= (length (match-string 1)) boundary))) + ;; We're in a block: get out of it + (goto-char (match-beginning 0)))))) + +(defun org-list-search-unenclosed-generic (search re bound noerr) + "Search a string outside blocks and protected places. +Arguments SEARCH, RE, BOUND and NOERR are similar to those in +`search-forward', `search-backward', `re-search-forward' and +`re-search-backward'." + (catch 'exit + (let ((origin (point))) + (while t + ;; 1. No match: return to origin or bound, depending on NOERR. + (unless (funcall search re bound noerr) + (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) + nil))) + ;; 2. Match not in block or protected: return point. Else + ;; skip the block and carry on. + (unless (or (get-text-property (match-beginning 0) 'org-protected) + (org-list-maybe-skip-block search bound)) + (throw 'exit (point))))))) + +(defun org-search-backward-unenclosed (regexp &optional bound noerror) + "Like `re-search-backward' but don't stop inside blocks or protected places. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-backward'." + (org-list-search-unenclosed-generic + #'re-search-backward regexp (or bound (point-min)) noerror)) + +(defun org-search-forward-unenclosed (regexp &optional bound noerror) + "Like `re-search-forward' but don't stop inside blocks or protected places. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-forward'." + (org-list-search-unenclosed-generic + #'re-search-forward regexp (or bound (point-max)) noerror)) + +(defun org-list-in-item-p-with-indent (limit) + "Is the cursor inside a plain list? +Plain lists are considered ending when a non-blank line is less +indented than the previous item within LIMIT." + (save-excursion + (beginning-of-line) + (cond + ;; do not start searching inside a block... + ((org-list-maybe-skip-block #'re-search-backward limit)) + ;; ... or at a blank line + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line))) + (beginning-of-line) + (or (org-at-item-p) + (let* ((case-fold-search t) + (ind-ref (org-get-indentation)) + ;; Ensure there is at least an item above + (up-item-p (save-excursion + (org-search-backward-unenclosed + org-item-beginning-re limit t)))) + (and up-item-p + (catch 'exit + (while t + (cond + ((org-at-item-p) + (throw 'exit (< (org-get-indentation) ind-ref))) + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + (t + (setq ind-ref (min (org-get-indentation) ind-ref)) + (forward-line -1)))))))))) + +(defun org-list-in-item-p-with-regexp (limit) + "Is the cursor inside a plain list? +Plain lists end when `org-list-end-regexp' is matched, or at a +blank line if `org-empty-line-terminates-plain-lists' is true. + +Argument LIMIT specifies the upper-bound of the search." + (save-excursion + (let* ((actual-pos (goto-char (point-at-eol))) + ;; Moved to eol so current line can be matched by + ;; `org-item-re'. + (last-item-start (save-excursion + (org-search-backward-unenclosed + org-item-beginning-re limit t))) + (list-ender (org-list-ending-between + last-item-start actual-pos))) + ;; We are in a list when we are on an item line or when we can + ;; find an item before point and there is no valid list ender + ;; between it and the point. + (and last-item-start (not list-ender))))) + +(defun org-list-top-point-with-regexp (limit) + "Return point at the top level item in a list. +Argument LIMIT specifies the upper-bound of the search. + +List ending is determined by regexp. See +`org-list-ending-method'. for more information." + (save-excursion + (let ((pos (point-at-eol))) + ;; Is there some list above this one ? If so, go to its ending. + ;; Otherwise, go back to the heading above or bob. + (goto-char (or (org-list-ending-between limit pos) limit)) + ;; From there, search down our list. + (org-search-forward-unenclosed org-item-beginning-re pos t) + (point-at-bol)))) + +(defun org-list-bottom-point-with-regexp (limit) + "Return point just before list ending. +Argument LIMIT specifies the lower-bound of the search. + +List ending is determined by regexp. See +`org-list-ending-method'. for more information." + (save-excursion + (let ((pos (org-get-item-beginning))) + ;; The list ending is either first point matching + ;; `org-list-end-re', point at first white-line before next + ;; heading, or eob. + (or (org-list-ending-between (min pos limit) limit t) limit)))) + +(defun org-list-top-point-with-indent (limit) + "Return point at the top level in a list. +Argument LIMIT specifies the upper-bound of the search. + +List ending is determined by indentation of text. See +`org-list-ending-method'. for more information." + (save-excursion + (let ((case-fold-search t)) + (let ((item-ref (goto-char (org-get-item-beginning))) + (ind-ref 10000)) + (forward-line -1) + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((looking-at "^[ \t]*:END:") + (throw 'exit item-ref)) + ((<= (point) limit) + (throw 'exit + (if (and (org-at-item-p) (< ind ind-ref)) + (point-at-bol) + item-ref))) + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + ((not (org-at-item-p)) + (setq ind-ref (min ind ind-ref)) + (forward-line -1)) + ((>= ind ind-ref) + (throw 'exit item-ref)) + (t + (setq item-ref (point-at-bol) ind-ref 10000) + (forward-line -1)))))))))) + +(defun org-list-bottom-point-with-indent (limit) + "Return point just before list ending or nil if not in a list. +Argument LIMIT specifies the lower-bound of the search. + +List ending is determined by the indentation of text. See +`org-list-ending-method' for more information." + (save-excursion + (let ((ind-ref (progn + (goto-char (org-get-item-beginning)) + (org-get-indentation))) + (case-fold-search t)) + ;; do not start inside a block + (org-list-maybe-skip-block #'re-search-forward limit) + (beginning-of-line) + (catch 'exit + (while t + (skip-chars-forward " \t") + (let ((ind (org-get-indentation))) + (cond + ((or (>= (point) limit) + (looking-at ":END:")) + (throw 'exit (progn + ;; Ensure bottom is just after a + ;; non-blank line. + (skip-chars-backward " \r\t\n") + (min (point-max) (1+ (point-at-eol)))))) + ((= (point) (point-at-eol)) + (skip-chars-forward " \r\t\n") + (beginning-of-line)) + ((org-at-item-p) + (setq ind-ref ind) + (forward-line 1)) + ((<= ind ind-ref) + (throw 'exit (point-at-bol))) + ((looking-at "#\\+begin_") + (re-search-forward "[ \t]*#\\+end_") + (forward-line 1)) + (t (forward-line 1))))))))) + +(defun org-list-at-regexp-after-bullet-p (regexp) + "Is point at a list item with REGEXP after bullet?" + (and (org-at-item-p) + (save-excursion + (goto-char (match-end 0)) + ;; Ignore counter if any + (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") + (goto-char (match-end 0))) + (looking-at regexp)))) + +(defun org-list-get-item-same-level (search-fun pos limit pre-move) + "Return point at the beginning of next item at the same level. +Search items using function SEARCH-FUN, from POS to LIMIT. It +uses PRE-MOVE before search. Return nil if no item was found." + (save-excursion + (goto-char pos) + (let* ((start (org-get-item-beginning)) + (ind (progn (goto-char start) (org-get-indentation)))) + ;; We don't want to match the current line. + (funcall pre-move) + ;; Skip any sublist on the way + (while (and (funcall search-fun org-item-beginning-re limit t) + (> (org-get-indentation) ind))) + (when (and (/= (point-at-bol) start) ; Have we moved ? + (= (org-get-indentation) ind)) + (point-at-bol))))) + +(defun org-list-separating-blank-lines-number (pos top bottom) + "Return number of blank lines that should separate items in list. +POS is the position of point to be considered. + +TOP and BOTTOM are respectively position of list beginning and +list ending. + +Assume point is at item's beginning. If the item is alone, apply +some heuristics to guess the result." + (save-excursion + (let ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry))) + usr-blank) + (cond + ;; Trivial cases where there should be none. + ((or (and (not (eq org-list-ending-method 'indent)) + org-empty-line-terminates-plain-lists) + (not insert-blank-p)) 0) + ;; When `org-blank-before-new-entry' says so, it is 1. + ((eq insert-blank-p t) 1) + ;; plain-list-item is 'auto. Count blank lines separating + ;; neighbours items in list. + (t (let ((next-p (org-get-next-item (point) bottom))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (org-back-over-empty-lines)) + ;; Is there a previous item? + ((org-get-previous-item (point) top) + (org-back-over-empty-lines)) + ;; User inserted blank lines, trust him + ((and (> pos (org-end-of-item-before-blank bottom)) + (> (save-excursion + (goto-char pos) + (skip-chars-backward " \t") + (setq usr-blank (org-back-over-empty-lines))) 0)) + usr-blank) + ;; Are there blank lines inside the item ? + ((save-excursion + (org-search-forward-unenclosed + "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1) + ;; No parent: no blank line. + (t 0)))))))) + +(defun org-list-insert-item-generic (pos &optional checkbox after-bullet) + "Insert a new list item at POS. +If POS is before first character after bullet of the item, the +new item will be created before the current one. + +Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET +after the bullet. Cursor will be after this text once the +function ends." + (goto-char pos) + ;; Is point in a special block? + (when (org-in-regexps-block-p + "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) + (if (not (cdr (assq 'insert org-list-automatic-rules))) + ;; Rule in `org-list-automatic-rules' forbids insertion. + (error "Cannot insert item inside a block") + ;; Else, move before it prior to add a new item. + (end-of-line) + (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) + (end-of-line 0))) + (let* ((true-pos (point)) + (top (org-list-top-point)) + (bottom (copy-marker (org-list-bottom-point))) + (bullet (and (goto-char (org-get-item-beginning)) + (org-list-bullet-string (org-get-bullet)))) + (ind (org-get-indentation)) + (before-p (progn + ;; Description item: text starts after colons. + (or (org-at-item-description-p) + ;; At a checkbox: text starts after it. + (org-at-item-checkbox-p) + ;; Otherwise, text starts after bullet. + (org-at-item-p)) + (<= true-pos (match-end 0)))) + (blank-lines-nb (org-list-separating-blank-lines-number + true-pos top bottom)) + (insert-fun + (lambda (text) + ;; insert bullet above item in order to avoid bothering + ;; with possible blank lines ending last item. + (goto-char (org-get-item-beginning)) + (indent-to-column ind) + (insert (concat bullet (when checkbox "[ ] ") after-bullet)) + ;; Stay between after-bullet and before text. + (save-excursion + (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) + (unless before-p + ;; store bottom: exchanging items doesn't change list + ;; bottom point but will modify marker anyway + (setq bottom (marker-position bottom)) + (let ((col (current-column))) + (org-list-exchange-items + (org-get-item-beginning) (org-get-next-item (point) bottom) + bottom) + ;; recompute next-item: last sexp modified list + (goto-char (org-get-next-item (point) bottom)) + (org-move-to-column col))) + ;; checkbox update might modify bottom point, so use a + ;; marker here + (setq bottom (copy-marker bottom)) + (when checkbox (org-update-checkbox-count-maybe)) + (org-list-repair nil top bottom)))) + (goto-char true-pos) + (cond + (before-p (funcall insert-fun nil) t) + ;; Can't split item: insert bullet at the end of item. + ((not (org-get-alist-option org-M-RET-may-split-line 'item)) + (funcall insert-fun nil) t) + ;; else, insert a new bullet along with everything from point + ;; down to last non-blank line of item. + (t + (delete-horizontal-space) + ;; Get pos again in case previous command modified line. + (let* ((pos (point)) + (end-before-blank (org-end-of-item-before-blank bottom)) + (after-text + (when (< pos end-before-blank) + (prog1 + (delete-and-extract-region pos end-before-blank) + ;; delete any blank line at and before point. + (beginning-of-line) + (while (looking-at "^[ \t]*$") + (delete-region (point-at-bol) (1+ (point-at-eol))) + (beginning-of-line 0)))))) + (funcall insert-fun after-text) t))))) + +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) + +(defun org-list-indent-item-generic (arg no-subtree top bottom) + "Indent a local list item including its children. +When number ARG is a negative, item will be outdented, otherwise +it will be indented. + +If a region is active, all items inside will be moved. + +If NO-SUBTREE is non-nil, only indent the item itself, not its +children. + +TOP and BOTTOM are respectively position at item beginning and at +item ending. + +Return t if successful." + (let* ((regionp (org-region-active-p)) + (rbeg (and regionp (region-beginning))) + (rend (and regionp (region-end)))) + (cond + ((and regionp + (goto-char rbeg) + (not (org-search-forward-unenclosed org-item-beginning-re rend t))) + (error "No item in region")) + ((not (org-at-item-p)) + (error "Not on an item")) + (t + ;; Are we going to move the whole list? + (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree) + (= top (point-at-bol))))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, ensure we keep them on subsequent moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if regionp + (progn + (set-marker org-last-indent-begin-marker rbeg) + (set-marker org-last-indent-end-marker rend)) + (set-marker org-last-indent-begin-marker (point-at-bol)) + (set-marker org-last-indent-end-marker + (save-excursion + (cond + (specialp bottom) + (no-subtree (org-end-of-item-or-at-child bottom)) + (t (org-get-end-of-item bottom))))))) + ;; Get everything ready + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker)) + (struct (org-list-struct + beg end top (if specialp end bottom) (< arg 0))) + (origins (org-list-struct-origins struct)) + (beg-item (assq beg struct))) + (cond + ;; Special case: moving top-item with indent rule + (specialp + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (nth 1 beg-item))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) + (org-list-bullet-string "-")))) + ;; Shift ancestor + (let ((anc (car struct))) + (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (org-list-struct-fix-struct struct origins) + (org-list-struct-apply-struct struct end)))) + ;; Forbidden move + ((and (< arg 0) + (or (and no-subtree + (not regionp) + (org-list-struct-get-child beg-item struct)) + (let ((last-item (save-excursion + (goto-char end) + (skip-chars-backward " \r\t\n") + (goto-char (org-get-item-beginning)) + (org-list-struct-assoc-at-point)))) + (org-list-struct-get-child last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((shifted-ori (if (< arg 0) + (org-list-struct-outdent beg end origins) + (org-list-struct-indent beg end origins struct)))) + (org-list-struct-fix-struct struct shifted-ori) + (org-list-struct-apply-struct struct bottom)))))))))) + +;;; Predicates + +(defun org-in-item-p () + "Is the cursor inside a plain list? +This checks `org-list-ending-method'." + (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) + (let* ((prev-head (save-excursion (outline-previous-heading))) + (bound (if prev-head + (or (save-excursion + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*:END:" prev-head t))) + prev-head) + (point-min)))) + (cond + ((eq org-list-ending-method 'regexp) + (org-list-in-item-p-with-regexp bound)) + ((eq org-list-ending-method 'indent) + (org-list-in-item-p-with-indent bound)) + (t (and (org-list-in-item-p-with-regexp bound) + (org-list-in-item-p-with-indent bound))))))) + +(defun org-list-first-item-p (top) + "Is this item the first item in a plain list? +Assume point is at an item. + +TOP is the position of list's top-item." + (save-excursion + (beginning-of-line) + (let ((ind (org-get-indentation))) + (or (not (org-search-backward-unenclosed org-item-beginning-re top t)) + (< (org-get-indentation) ind))))) + (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (save-excursion - (goto-char (point-at-bol)) - (looking-at (org-item-re)))) + (beginning-of-line) (looking-at org-item-beginning-re))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -248,170 +816,18 @@ (not (member (char-after) '(?\ ?\t))) (< (point) (match-end 0)))) -(defun org-in-item-p () - "Is the cursor inside a plain list item. -Does not have to be the first line." - (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - t) - (error nil)))) +(defun org-at-item-timer-p () + "Is point at a line starting a plain list item with a timer?" + (org-list-at-regexp-after-bullet-p + "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -Return t when things worked, nil when we are not in an item." - (when (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - (if (org-invisible-p) (error "Invisible item")) - t) - (error nil))) - (let* ((bul (match-string 0)) - (descp (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line 1) - (save-match-data - (and (looking-at "[ \t]*\\(.*?\\) ::") - (match-string 1))))) - (empty-line-p (save-excursion - (goto-char (match-beginning 0)) - (and (not (bobp)) - (or (beginning-of-line 0) t) - (save-match-data - (looking-at "[ \t]*$"))))) - (timerp (and descp - (save-match-data - (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$" - descp)))) - (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") - (match-end 0))) - (blank-a (if org-empty-line-terminates-plain-lists - nil - (cdr (assq 'plain-list-item org-blank-before-new-entry)))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos) - (if descp (setq checkbox nil)) - (if timerp - (progn (org-timer-item) t) - (cond - ((and (org-at-item-p) (<= (point) eow)) - ;; before the bullet - (beginning-of-line 1) - (open-line (if blank 2 1))) - ((<= (point) eow) - (beginning-of-line 1)) - (t - (unless (org-get-alist-option org-M-RET-may-split-line 'item) - (end-of-line 1) - (delete-horizontal-space)) - (newline (if blank 2 1)))) - (insert bul - (if checkbox "[ ]" "") - (if descp (concat (if checkbox " " "") - (read-string "Term: ") " :: ") "")) - (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) - (org-maybe-renumber-ordered-list) - (and checkbox (org-update-checkbox-count-maybe)) - t))) - -;;; Checkboxes +(defun org-at-item-description-p () + "Is point at a description list item?" + (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+")) (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (looking-at "\\[[- X]\\]")))) - -(defun org-toggle-checkbox (&optional toggle-presence) - "Toggle the checkbox in the current line. -With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. -With double prefix, set checkbox to [-]. -When there is an active region, toggle status or presence of the checkbox -in the first line, and make every item in the region have the same -status or presence, respectively. -If the cursor is in a headline, apply this to all checkbox items in the -text below the heading." - (interactive "P") - (catch 'exit - (let (beg end status first-present first-status blocked) - (cond - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - ((org-on-heading-p) - (setq beg (point) end (save-excursion (outline-next-heading) (point)))) - ((org-at-item-checkbox-p) - (save-excursion - (if (equal toggle-presence '(4)) - (progn - (replace-match "") - (goto-char (match-beginning 0)) - (just-one-space)) - (when (setq blocked (org-checkbox-blocked-p)) - (error "Checkbox blocked because of unchecked box in line %d" - blocked)) - (replace-match - (cond ((equal toggle-presence '(16)) "[-]") - ((member (match-string 0) '("[ ]" "[-]")) "[X]") - (t "[ ]")) - t t))) - (throw 'exit t)) - ((org-at-item-p) - ;; add a checkbox - (save-excursion - (goto-char (match-end 0)) - (insert "[ ] ")) - (throw 'exit t)) - (t (error "Not at a checkbox or heading, and no active region"))) - (setq end (move-marker (make-marker) end)) - (save-excursion - (goto-char beg) - (setq first-present (org-at-item-checkbox-p) - first-status - (save-excursion - (and (re-search-forward "[ \t]\\(\\[[ X]\\]\\)" end t) - (equal (match-string 1) "[X]")))) - (while (< (point) end) - (if toggle-presence - (cond - ((and first-present (org-at-item-checkbox-p)) - (save-excursion - (replace-match "") - (goto-char (match-beginning 0)) - (just-one-space))) - ((and (not first-present) (not (org-at-item-checkbox-p)) - (org-at-item-p)) - (save-excursion - (goto-char (match-end 0)) - (insert "[ ] ")))) - (when (org-at-item-checkbox-p) - (setq status (equal (match-string 0) "[X]")) - (replace-match - (if first-status "[ ]" "[X]") t t))) - (beginning-of-line 2))))) - (org-update-checkbox-count-maybe)) - -(defun org-reset-checkbox-state-subtree () - "Reset all checkboxes in an entry subtree." - (interactive "*") - (save-restriction - (save-excursion - (org-narrow-to-subtree) - (org-show-subtree) - (goto-char (point-min)) - (let ((end (point-max))) - (while (< (point) end) - (when (org-at-item-checkbox-p) - (replace-match "[ ]" t t)) - (beginning-of-line 2)))) - (org-update-checkbox-count-maybe))) + (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) (defun org-checkbox-blocked-p () "Is the current checkbox blocked from for being checked now? @@ -424,417 +840,621 @@ (save-match-data (save-excursion (unless (org-at-item-checkbox-p) (throw 'exit nil)) - (when (equal (match-string 0) "[X]") + (when (equal (match-string 1) "[X]") ;; the box is already checked! (throw 'exit nil)) (let ((end (point-at-bol))) (condition-case nil (org-back-to-heading t) (error (throw 'exit nil))) (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) - (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) - (org-current-line) - nil)))))) + (when (org-search-forward-unenclosed + "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) + (org-current-line))))))) + +;;; Navigate -(defvar org-checkbox-statistics-hook nil - "Hook that is run whenever Org thinks checkbox statistics should be updated. -This hook runs even if `org-provide-checkbox-statistics' is nil, to it can -be used to implement alternative ways of collecting statistics information.") +;; Every interactive navigation function is derived from a +;; non-interactive one, which doesn't move point, assumes point is +;; already in a list and doesn't compute list boundaries. -(defun org-update-checkbox-count-maybe () - "Update checkbox statistics unless turned off by user." - (when org-provide-checkbox-statistics - (org-update-checkbox-count)) - (run-hooks 'org-checkbox-statistics-hook)) +;; If you plan to use more than one org-list function is some code, +;; you should therefore first check if point is in a list with +;; `org-in-item-p' or `org-at-item-p', then compute list boundaries +;; with `org-list-top-point' and `org-list-bottom-point', and make use +;; of non-interactive forms. -(defun org-update-checkbox-count (&optional all) - "Update the checkbox statistics in the current section. -This will find all statistic cookies like [57%] and [6/12] and update them -with the current numbers. With optional prefix argument ALL, do this for -the whole buffer." - (interactive "P") - (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (org-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - (re-find (concat re "\\|" re-box)) - beg-cookie end-cookie is-percent c-on c-off lim new - eline curr-ind next-ind continue-from startsearch - (recursive - (or (not org-hierarchical-checkbox-statistics) - (string-match "\\<recursive\\>" - (or (ignore-errors - (org-entry-get nil "COOKIE_DATA")) - "")))) - (cstat 0) - ) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char end) - ;; find each statistics cookie - (while (and (re-search-backward re-find beg t) - (not (save-match-data - (and (org-on-heading-p) - (string-match "\\<todo\\>" - (downcase - (or (org-entry-get - nil "COOKIE_DATA") - ""))))))) - (setq beg-cookie (match-beginning 1) - end-cookie (match-end 1) - cstat (+ cstat (if end-cookie 1 0)) - startsearch (point-at-eol) - continue-from (match-beginning 0) - is-percent (match-beginning 2) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 - c-off 0) - (when lim - ;; find first checkbox for this cookie and gather - ;; statistics from all that are at this indentation level - (goto-char startsearch) - (if (re-search-forward re-box lim t) - (progn - (org-beginning-of-item) - (setq curr-ind (org-get-indentation)) - (setq next-ind curr-ind) - (while (and (bolp) (org-at-item-p) - (if recursive - (<= curr-ind next-ind) - (= curr-ind next-ind))) - (save-excursion (end-of-line) (setq eline (point))) - (if (re-search-forward re-box eline t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) - (if (not recursive) - (org-end-of-item) - (end-of-line) - (when (re-search-forward org-list-beginning-re lim t) - (beginning-of-line))) - (setq next-ind (org-get-indentation))))) - (goto-char continue-from) - ;; update cookie - (when end-cookie - (setq new (if is-percent - (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (goto-char beg-cookie) - (insert new) - (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) - ;; update items checkbox if it has one - (when (org-at-item-p) - (org-beginning-of-item) - (when (and (> (+ c-on c-off) 0) - (re-search-forward re-box (point-at-eol) t)) - (setq beg-cookie (match-beginning 2) - end-cookie (match-end 2)) - (delete-region beg-cookie end-cookie) - (goto-char beg-cookie) - (cond ((= c-off 0) (insert "[X]")) - ((= c-on 0) (insert "[ ]")) - (t (insert "[-]"))) - ))) - (goto-char continue-from)) - (when (interactive-p) - (message "Checkbox statistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) +(defun org-list-top-point () + "Return point at the top level in a list. +Assume point is in a list." + (let* ((prev-head (save-excursion (outline-previous-heading))) + (bound (if prev-head + (or (save-excursion + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*:END:" prev-head t))) + prev-head) + (point-min)))) + (cond + ((eq org-list-ending-method 'regexp) + (org-list-top-point-with-regexp bound)) + ((eq org-list-ending-method 'indent) + (org-list-top-point-with-indent bound)) + (t (let ((top-re (org-list-top-point-with-regexp bound))) + (org-list-top-point-with-indent (or top-re bound))))))) -(defun org-get-checkbox-statistics-face () - "Select the face for checkbox statistics. -The face will be `org-done' when all relevant boxes are checked. Otherwise -it will be `org-todo'." - (if (match-end 1) - (if (equal (match-string 1) "100%") - 'org-checkbox-statistics-done - 'org-checkbox-statistics-todo) - (if (and (> (match-end 2) (match-beginning 2)) - (equal (match-string 2) (match-string 3))) - 'org-checkbox-statistics-done - 'org-checkbox-statistics-todo))) +(defun org-list-bottom-point () + "Return point just before list ending. +Assume point is in a list." + (let* ((next-head (save-excursion + (and (let ((outline-regexp org-outline-regexp)) + ;; Use default regexp because folding + ;; changes OUTLINE-REGEXP. + (outline-next-heading))))) + (limit (or (save-excursion + (and (re-search-forward "^[ \t]*:END:" next-head t) + (point-at-bol))) + next-head + (point-max)))) + (cond + ((eq org-list-ending-method 'regexp) + (org-list-bottom-point-with-regexp limit)) + ((eq org-list-ending-method 'indent) + (org-list-bottom-point-with-indent limit)) + (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) + (org-list-bottom-point-with-indent (or bottom-re limit))))))) + +(defun org-get-item-beginning () + "Return position of current item beginning." + (save-excursion + ;; possibly match current line + (end-of-line) + (org-search-backward-unenclosed org-item-beginning-re nil t) + (point-at-bol))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. If the cursor is not in an item, throw an error." (interactive) - (let ((pos (point)) - (limit (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (beginning-of-line 2) (point)) - (error (point-min))))) - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - ind ind1) - (if (org-at-item-p) - (beginning-of-line 1) - (beginning-of-line 1) - (skip-chars-forward " \t") - (setq ind (current-column)) - (if (catch 'exit - (while t - (beginning-of-line 0) - (if (or (bobp) (< (point) limit)) (throw 'exit nil)) + (if (org-in-item-p) + (goto-char (org-get-item-beginning)) + (error "Not in an item"))) + +(defun org-get-beginning-of-list (top) + "Return position of the first item of the current list or sublist. +TOP is the position at list beginning." + (save-excursion + (let (prev-p) + (while (setq prev-p (org-get-previous-item (point) top)) + (goto-char prev-p)) + (point-at-bol)))) + +(defun org-beginning-of-item-list () + "Go to the beginning item of the current list or sublist. +Return an error if not in a list." + (interactive) + (if (org-in-item-p) + (goto-char (org-get-beginning-of-list (org-list-top-point))) + (error "Not in an item"))) - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (< ind1 ind) - (progn (beginning-of-line 1) (throw 'exit (org-at-item-p)))))) - nil - (goto-char pos) - (error "Not in an item"))))) +(defun org-get-end-of-list (bottom) + "Return position at the end of the current list or sublist. +BOTTOM is the position at list ending." + (save-excursion + (goto-char (org-get-item-beginning)) + (let ((ind (org-get-indentation))) + (while (and (/= (point) bottom) + (>= (org-get-indentation) ind)) + (org-search-forward-unenclosed org-item-beginning-re bottom 'move)) + (if (= (point) bottom) bottom (point-at-bol))))) + +(defun org-end-of-item-list () + "Go to the end of the current list or sublist. +If the cursor in not in an item, throw an error." + (interactive) + (if (org-in-item-p) + (goto-char (org-get-end-of-list (org-list-bottom-point))) + (error "Not in an item"))) + +(defun org-get-end-of-item (bottom) + "Return position at the end of the current item. +BOTTOM is the position at list ending." + (or (org-get-next-item (point) bottom) + (org-get-end-of-list bottom))) (defun org-end-of-item () "Go to the end of the current hand-formatted item. If the cursor is not in an item, throw an error." (interactive) - (let* ((pos (point)) - ind1 - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - (limit (save-excursion (outline-next-heading) (point))) - (ind (save-excursion - (org-beginning-of-item) - (skip-chars-forward " \t") - (current-column))) - (end (catch 'exit - (while t - (beginning-of-line 2) - (if (eobp) (throw 'exit (point))) - (if (>= (point) limit) (throw 'exit (point-at-bol))) - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (<= ind1 ind) - (throw 'exit (point-at-bol))))))) - (if end - (goto-char end) - (goto-char pos) - (error "Not in an item")))) + (if (org-in-item-p) + (goto-char (org-get-end-of-item (org-list-bottom-point))) + (error "Not in an item"))) + +(defun org-end-of-item-or-at-child (bottom) + "Move to the end of the item, stops before the first child if any. +BOTTOM is the position at list ending." + (end-of-line) + (goto-char + (if (org-search-forward-unenclosed org-item-beginning-re bottom t) + (point-at-bol) + (org-get-end-of-item bottom)))) + +(defun org-end-of-item-before-blank (bottom) + "Return point at end of item, before any blank line. +Point returned is at eol. -(defun org-end-of-item-text-before-children () - "Move to the end of the item text, stops before the first child if any. -Assumes that the cursor is in the first line of an item." - (goto-char - (min (save-excursion (org-end-of-item) (point)) - (save-excursion - (goto-char (point-at-eol)) - (if (re-search-forward (concat "^" (org-item-re t)) nil 'move) - (match-beginning 0) - (point-max)))))) +BOTTOM is the position at list ending." + (save-excursion + (goto-char (org-get-end-of-item bottom)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + +(defun org-get-previous-item (pos limit) + "Return point of the previous item at the same level as POS. +Stop searching at LIMIT. Return nil if no item is found." + (org-list-get-item-same-level + #'org-search-backward-unenclosed pos limit #'beginning-of-line)) + +(defun org-previous-item () + "Move to the beginning of the previous item. +Item is at the same level in the current plain list. Error if not +in a plain list, or if this is the first item in the list." + (interactive) + (if (not (org-in-item-p)) + (error "Not in an item") + (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) + (if prev-p (goto-char prev-p) (error "On first item"))))) + +(defun org-get-next-item (pos limit) + "Return point of the next item at the same level as POS. +Stop searching at LIMIT. Return nil if no item is found." + (org-list-get-item-same-level + #'org-search-forward-unenclosed pos limit #'end-of-line)) (defun org-next-item () - "Move to the beginning of the next item in the current plain list. -Error if not at a plain list, or if this is the last item in the list." - (interactive) - (let (ind ind1 (pos (point))) - (org-beginning-of-item) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq ind1 (org-get-indentation)) - (unless (and (org-at-item-p) (= ind ind1)) - (goto-char pos) - (error "On last item")))) - -(defun org-previous-item () - "Move to the beginning of the previous item in the current plain list. -Error if not at a plain list, or if this is the first item in the list." + "Move to the beginning of the next item. +Item is at the same level in the current plain list. Error if not +in a plain list, or if this is the last item in the list." (interactive) - (let (beg ind ind1 (pos (point))) - (org-beginning-of-item) - (setq beg (point)) - (setq ind (org-get-indentation)) - (goto-char beg) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - nil - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))) - (if (bobp) (throw 'exit t)))) - (condition-case nil - (if (or (not (org-at-item-p)) - (< ind1 (1- ind))) - (error "") - (org-beginning-of-item)) - (error (goto-char pos) - (error "On first item"))))) + (if (not (org-in-item-p)) + (error "Not in an item") + (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (if next-p (goto-char next-p) (error "On last item"))))) + +;;; Manipulate + +(defun org-list-exchange-items (beg-A beg-B bottom) + "Swap item starting at BEG-A with item starting at BEG-B. +Blank lines at the end of items are left in place. Assume BEG-A +is lesser than BEG-B. -(defun org-first-list-item-p () - "Is this heading the first item in a plain list?" - (unless (org-at-item-p) - (error "Not at a plain list item")) +BOTTOM is the position at list ending." (save-excursion - (org-beginning-of-item) - (= (point) (save-excursion (org-beginning-of-item-list))))) + (let* ((end-of-item-no-blank + (lambda (pos) + (goto-char pos) + (goto-char (org-end-of-item-before-blank bottom)))) + (end-A-no-blank (funcall end-of-item-no-blank beg-A)) + (end-B-no-blank (funcall end-of-item-no-blank beg-B)) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))) + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A))))) (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) - (let ((col (current-column)) - (pos (point)) - beg beg0 end end0 ind ind1 txt ne-end ne-beg) - (org-beginning-of-item) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq end0 (point)) - (setq ind1 (org-get-indentation)) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (org-first-list-item-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - (goto-char end0) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (org-end-of-item) - (org-back-over-empty-lines) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (goto-char pos) (org-skip-whitespace) - (org-maybe-renumber-ordered-list) - (move-to-column col)) - (goto-char pos) - (move-to-column col) - (error "Cannot move this item further down")))) + (if (not (org-at-item-p)) + (error "Not at an item") + (let* ((pos (point)) + (col (current-column)) + (bottom (org-list-bottom-point)) + (actual-item (goto-char (org-get-item-beginning))) + (next-item (org-get-next-item (point) bottom))) + (if (not next-item) + (progn + (goto-char pos) + (error "Cannot move this item further down")) + (org-list-exchange-items actual-item next-item bottom) + (org-list-repair nil nil bottom) + (goto-char (org-get-next-item (point) bottom)) + (move-to-column col))))) -(defun org-move-item-up (arg) +(defun org-move-item-up () "Move the plain list item at point up, i.e. swap with previous item. Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." - (interactive "p") - (let ((col (current-column)) (pos (point)) - beg beg0 end ind ind1 txt - ne-beg ne-ins ins-end) - (org-beginning-of-item) - (setq beg0 (point)) - (setq ind (org-get-indentation)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (org-end-of-item) - (org-back-over-empty-lines) - (setq end (point)) - (goto-char beg0) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (if org-empty-line-terminates-plain-lists - (progn - (goto-char pos) - (error "Cannot move this item further up")) - nil) - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (org-beginning-of-item) - (error (goto-char beg0) - (move-to-column col) - (error "Cannot move this item further up"))) - (setq ind1 (org-get-indentation)) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (setq ne-ins (org-back-over-empty-lines)) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (setq ins-end (point)) - (goto-char pos) (org-skip-whitespace) + (interactive) + (if (not (org-at-item-p)) + (error "Not at an item") + (let* ((pos (point)) + (col (current-column)) + (top (org-list-top-point)) + (bottom (org-list-bottom-point)) + (actual-item (goto-char (org-get-item-beginning))) + (prev-item (org-get-previous-item (point) top))) + (if (not prev-item) + (progn + (goto-char pos) + (error "Cannot move this item further up")) + (org-list-exchange-items prev-item actual-item bottom) + (org-list-repair nil top bottom) + (move-to-column col))))) + +(defun org-insert-item (&optional checkbox) + "Insert a new item at the current level. +If cursor is before first character after bullet of the item, the +new item will be created before the current one. + +If CHECKBOX is non-nil, add a checkbox next to the bullet. + +Return t when things worked, nil when we are not in an item, or +item is invisible." + (unless (or (not (org-in-item-p)) + (save-excursion + (goto-char (org-get-item-beginning)) + (org-invisible-p))) + (if (save-excursion + (goto-char (org-get-item-beginning)) + (org-at-item-timer-p)) + ;; Timer list: delegate to `org-timer-item'. + (progn (org-timer-item) t) + ;; if we're in a description list, ask for the new term. + (let ((desc-text (when (save-excursion + (and (goto-char (org-get-item-beginning)) + (org-at-item-description-p))) + (concat (read-string "Term: ") " :: ")))) + ;; Don't insert a checkbox if checkbox rule is applied and it + ;; is a description item. + (org-list-insert-item-generic + (point) (and checkbox + (or (not desc-text) + (not (cdr (assq 'checkbox org-list-automatic-rules))))) + desc-text))))) + +;;; Structures + +;; The idea behind structures is to avoid moving back and forth in the +;; buffer on costly operations like indenting or fixing bullets. + +;; It achieves this by taking a snapshot of an interesting part of the +;; list, in the shape of an alist, using `org-list-struct'. + +;; It then proceeds to changes directly on the alist, with the help of +;; and `org-list-struct-origins'. When those are done, +;; `org-list-struct-apply-struct' applies the changes to the buffer. + +(defun org-list-struct-assoc-at-point () + "Return the structure association at point. +It is a cons-cell whose key is point and values are indentation, +bullet string and bullet counter, if any." + (save-excursion + (beginning-of-line) + (list (point-at-bol) + (org-get-indentation) + (progn + (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)") + (match-string 1)) + (progn + (goto-char (match-end 0)) + (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") + (match-string 1)))))) + +(defun org-list-struct (begin end top bottom &optional outdent) + "Return the structure containing the list between BEGIN and END. +A structure is an alist where key is point of item and values +are, in that order, indentation, bullet string and value of +counter, if any. A structure contains every list and sublist that +has items between BEGIN and END along with their common ancestor. +If no such ancestor can be found, the function will add a virtual +ancestor at position 0. + +TOP and BOTTOM are respectively the position of list beginning +and list ending. - (when (and (org-first-list-item-p) (> ne-ins ne-beg)) - ;; Move whitespace back to beginning - (save-excursion - (goto-char ins-end) - (let ((kill-whole-line t)) - (kill-line (- ne-ins ne-beg)) (point))) - (insert (make-string (- ne-ins ne-beg) ?\n))) +If OUTDENT is non-nil, it will also grab all of the parent list +and the grand-parent. Setting OUTDENT to t is mandatory when next +change is an outdent." + (save-excursion + (let* (struct + (extend + (lambda (struct) + (let* ((ind-min (apply 'min (mapcar 'cadr struct))) + (begin (caar struct)) + (end (caar (last struct))) + pre-list post-list) + (goto-char begin) + ;; Find beginning of most outdented list (min list) + (while (and (org-search-backward-unenclosed + org-item-beginning-re top t) + (>= (org-get-indentation) ind-min)) + (setq pre-list (cons (org-list-struct-assoc-at-point) + pre-list))) + ;; Now get the parent. If none, add a virtual ancestor + (if (< (org-get-indentation) ind-min) + (setq pre-list (cons (org-list-struct-assoc-at-point) + pre-list)) + (setq pre-list (cons (list 0 (org-get-indentation) "" nil) + pre-list))) + ;; Find end of min list + (goto-char end) + (end-of-line) + (while (and (org-search-forward-unenclosed + org-item-beginning-re bottom 'move) + (>= (org-get-indentation) ind-min)) + (setq post-list (cons (org-list-struct-assoc-at-point) + post-list))) + ;; Is list is malformed? If some items are less + ;; indented that top-item, add them anyhow. + (when (and (= (caar pre-list) 0) (< (point) bottom)) + (beginning-of-line) + (while (org-search-forward-unenclosed + org-item-beginning-re bottom t) + (setq post-list (cons (org-list-struct-assoc-at-point) + post-list)))) + (append pre-list struct (reverse post-list)))))) + ;; Here we start: first get the core zone... + (goto-char end) + (while (org-search-backward-unenclosed org-item-beginning-re begin t) + (setq struct (cons (org-list-struct-assoc-at-point) struct))) + ;; ... then, extend it to make it a structure... + (let ((extended (funcall extend struct))) + ;; ... twice when OUTDENT is non-nil and struct still can be + ;; extended + (if (and outdent (> (caar extended) 0)) + (funcall extend extended) + extended))))) + +(defun org-list-struct-origins (struct) + "Return an alist where key is item's position and value parent's. +STRUCT is the list's structure looked up." + (let* ((struct-rev (reverse struct)) + (acc (list (cons (nth 1 (car struct)) 0))) + (prev-item (lambda (item) + (car (nth 1 (member (assq item struct) struct-rev))))) + (get-origins + (lambda (item) + (let* ((item-pos (car item)) + (ind (nth 1 item)) + (prev-ind (caar acc))) + (cond + ;; List closing. + ((> prev-ind ind) + (let ((current-origin (or (member (assq ind acc) acc) + ;; needed if top-point is + ;; not the most outdented + (last acc)))) + (setq acc current-origin) + (cons item-pos (cdar acc)))) + ;; New list + ((< prev-ind ind) + (let ((origin (funcall prev-item item-pos))) + (setq acc (cons (cons ind origin) acc)) + (cons item-pos origin))) + ;; Current list going on + (t (cons item-pos (cdar acc)))))))) + (cons '(0 . 0) (mapcar get-origins (cdr struct))))) + +(defun org-list-struct-get-parent (item struct origins) + "Return parent association of ITEM in STRUCT or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (let* ((parent-pos (cdr (assq (car item) origins)))) + (when (> parent-pos 0) (assq parent-pos struct)))) + +(defun org-list-struct-get-child (item struct) + "Return child association of ITEM in STRUCT or nil." + (let ((ind (nth 1 item)) + (next-item (cadr (member item struct)))) + (when (and next-item (> (nth 1 next-item) ind)) next-item))) + +(defun org-list-struct-fix-bul (struct origins) + "Verify and correct bullets for every association in STRUCT. +ORIGINS is the alist of parents. See `org-list-struct-origins'. - (org-maybe-renumber-ordered-list) - (move-to-column col)) - (goto-char pos) - (move-to-column col) - (error "Cannot move this item further up")))) +This function modifies STRUCT." + (let* (acc + (init-bul (lambda (item) + (let ((counter (nth 3 item)) + (bullet (org-list-bullet-string (nth 2 item)))) + (cond + ((and (string-match "[0-9]+" bullet) counter) + (replace-match counter nil nil bullet)) + ((string-match "[0-9]+" bullet) + (replace-match "1" nil nil bullet)) + (t bullet))))) + (set-bul (lambda (item bullet) + (setcdr item (list (nth 1 item) bullet (nth 3 item))))) + (get-bul (lambda (item bullet) + (let* ((counter (nth 3 item))) + (if (and counter (string-match "[0-9]+" bullet)) + (replace-match counter nil nil bullet) + bullet)))) + (fix-bul + (lambda (item) struct + (let* ((parent (cdr (assq (car item) origins))) + (orig-ref (assq parent acc))) + (if orig-ref + ;; Continuing previous list + (let* ((prev-bul (cdr orig-ref)) + (new-bul (funcall get-bul item prev-bul))) + (setcdr orig-ref (org-list-inc-bullet-maybe new-bul)) + (funcall set-bul item new-bul)) + ;; A new list is starting + (let ((new-bul (funcall init-bul item))) + (funcall set-bul item new-bul) + (setq acc (cons (cons parent + (org-list-inc-bullet-maybe new-bul)) + acc)))))))) + (mapc fix-bul (cdr struct)))) + +(defun org-list-struct-fix-ind (struct origins) + "Verify and correct indentation for every association in STRUCT. +ORIGINS is the alist of parents. See `org-list-struct-origins'. -(defun org-maybe-renumber-ordered-list () - "Renumber the ordered list at point if setup allows it. -This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering." - (interactive) - (when (and org-auto-renumber-ordered-lists - (org-at-item-p)) - (if (match-beginning 3) - (org-renumber-ordered-list 1) - (org-fix-bullet-type)))) +This function modifies STRUCT." + (let* ((headless (cdr struct)) + (ancestor (car struct)) + (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor)))) + (new-ind + (lambda (item) + (let* ((parent (org-list-struct-get-parent item headless origins))) + (if parent + ;; Indent like parent + length of parent's bullet + (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) + (cddr item))) + ;; If no parent, indent like top-point + (setcdr item (cons top-ind (cddr item)))))))) + (mapc new-ind headless))) + +(defun org-list-struct-fix-struct (struct origins) + "Return STRUCT with correct bullets and indentation. +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +Only elements of STRUCT that have changed are returned." + (let ((old (copy-alist struct))) + (org-list-struct-fix-bul struct origins) + (org-list-struct-fix-ind struct origins) + (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct)))) -(defun org-maybe-renumber-ordered-list-safe () - (condition-case nil - (save-excursion - (org-maybe-renumber-ordered-list)) - (error nil))) +(defun org-list-struct-outdent (start end origins) + "Outdent items in a structure. +Items are indented when their key is between START, included, and +END, excluded. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. -(defun org-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: +STRUCT is the concerned structure." + (let* (acc + (out (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association + ((< item start) cell) + ;; Item out of zone: follow associations in acc + ((>= item end) + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + ;; Item has no parent: error + ((<= parent 0) + (error "Cannot outdent top-level items")) + ;; Parent is outdented: keep association + ((>= parent start) + (setq acc (cons (cons parent item) acc)) cell) + (t + ;; Parent isn't outdented: reparent to grand-parent + (let ((grand-parent (cdr (assq parent origins)))) + (setq acc (cons (cons parent item) acc)) + (cons item grand-parent)))))))) + (mapcar out origins))) - `-' -> `+' -> `*' -> `1.' -> `1)' +(defun org-list-struct-indent (start end origins struct) + "Indent items in a structure. +Items are indented when their key is between START, included, and +END, excluded. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. -If WHICH is a string, use that as the new bullet. If WHICH is an integer, -0 means `-', 1 means `+' etc." - (interactive "P") - (org-preserve-lc - (org-beginning-of-item-list) - (org-at-item-p) - (beginning-of-line 1) - (let ((current (match-string 0)) - (prevp (eq which 'previous)) - new old) - (setq new (cond - ((and (numberp which) - (nth (1- which) '("-" "+" "*" "1." "1)")))) - ((string-match "-" current) (if prevp "1)" "+")) - ((string-match "\\+" current) - (if prevp "-" (if (looking-at "\\S-") "1." "*"))) - ((string-match "\\*" current) (if prevp "+" "1.")) - ((string-match "\\." current) - (if prevp (if (looking-at "\\S-") "+" "*") "1)")) - ((string-match ")" current) (if prevp "1." "-")) - (t (error "This should not happen")))) - (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)") - (setq old (match-string 2)) - (replace-match (concat "\\1" new))) - (org-shift-item-indentation (- (length new) (length old))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list)))) +STRUCT is the concerned structure. It may be modified if +`org-list-demote-modify-bullet' matches bullets between START and +END." + (let* (acc + (orig-rev (reverse origins)) + (get-prev-item + (lambda (cell parent) + (car (rassq parent (cdr (memq cell orig-rev)))))) + (set-assoc + (lambda (cell) + (setq acc (cons cell acc)) cell)) + (change-bullet-maybe + (lambda (item) + (let* ((full-item (assq item struct)) + (item-bul (org-trim (nth 2 full-item))) + (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet)))) + (when new-bul-p + ;; new bullet is stored without space to ensure item + ;; will be modified + (setcdr full-item + (list (nth 1 full-item) + new-bul-p + (nth 3 full-item))))))) + (ind + (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association + ((< item start) cell) + ((>= item end) + ;; Item out of zone: follow associations in acc + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + (t + ;; Item is in zone... + (let ((prev (funcall get-prev-item cell parent))) + ;; Check if bullet needs to be changed + (funcall change-bullet-maybe item) + (cond + ;; First item indented but not parent: error + ((and (or (not prev) (= prev 0)) (< parent start)) + (error "Cannot indent the first item of a list")) + ;; First item and parent indented: keep same parent + ((or (not prev) (= prev 0)) + (funcall set-assoc cell)) + ;; Previous item not indented: reparent to it + ((< prev start) + (funcall set-assoc (cons item prev))) + ;; Previous item indented: reparent like it + (t + (funcall set-assoc (cons item + (cdr (assq prev acc))))))))))))) + (mapcar ind origins))) + +(defun org-list-struct-apply-struct (struct bottom) + "Apply modifications to list so it mirrors STRUCT. +BOTTOM is position at list ending. + +Initial position is restored after the changes." + (let* ((pos (copy-marker (point))) + (ancestor (caar struct)) + (modify + (lambda (item) + (goto-char (car item)) + (let* ((new-ind (nth 1 item)) + (new-bul (org-list-bullet-string (nth 2 item))) + (old-ind (org-get-indentation)) + (old-bul (progn + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (match-string 1))) + (old-body-ind (+ (length old-bul) old-ind)) + (new-body-ind (+ (length new-bul) new-ind))) + ;; 1. Shift item's body + (unless (= old-body-ind new-body-ind) + (org-shift-item-indentation + (- new-body-ind old-body-ind) bottom)) + ;; 2. Replace bullet + (unless (equal new-bul old-bul) + (save-excursion + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (replace-match new-bul nil nil nil 1))) + ;; 3. Indent item to appropriate column + (unless (= new-ind old-ind) + (delete-region (point-at-bol) + (progn + (skip-chars-forward " \t") + (point))) + (indent-to new-ind))))) + ;; Remove ancestor if it is left. + (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) + (cdr struct) + struct))) + ;; Apply changes from bottom to top + (mapc modify (nreverse struct-to-apply)) + (goto-char pos))) + +;;; Indentation (defun org-get-string-indentation (s) "What indentation has S due to SPACE and TAB at the beginning of the string?" @@ -847,299 +1467,555 @@ (t (throw 'exit t))))) i)) -(defun org-renumber-ordered-list (arg) - "Renumber an ordered plain list. -Cursor needs to be in the first line of an item, the line that starts -with something like \"1.\" or \"2)\"." - (interactive "p") - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (org-get-string-indentation - (buffer-substring (point-at-bol) (match-beginning 3)))) - ;; (term (substring (match-string 3) -1)) - ind1 (n (1- arg)) - fmt bobp old new delta) - ;; find where this list begins - (org-beginning-of-item-list) - (setq bobp (bobp)) - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (setq fmt (concat "%d" (or (match-string 1) "."))) - (save-excursion - (goto-char (match-end 0)) - (if (looking-at "[ \t]*\\[@start:\\([0-9]+\\)") - (setq n (1- (string-to-number (match-string 1)))))) - (beginning-of-line 0) - ;; walk forward and replace these numbers - (catch 'exit - (while t - (catch 'next - (if bobp (setq bobp nil) (beginning-of-line 2)) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (setq old (match-string 2)) - (delete-region (match-beginning 2) (match-end 2)) - (goto-char (match-beginning 2)) - (insert (setq new (format fmt (setq n (1+ n))))) - (setq delta (- (length new) (length old))) - (org-shift-item-indentation delta) - (if (= (org-current-line) line) (setq col (+ col delta)))))) - (org-goto-line line) - (org-move-to-column col))) +(defun org-shift-item-indentation (delta bottom) + "Shift the indentation in current item by DELTA. +Sub-items are not moved. + +BOTTOM is position at list ending." + (save-excursion + (let ((beg (point-at-bol)) + (end (org-end-of-item-or-at-child bottom))) + (beginning-of-line (unless (eolp) 0)) + (while (> (point) beg) + (when (looking-at "[ \t]*\\S-") + ;; this is not an empty line + (let ((i (org-get-indentation))) + (when (and (> i 0) (> (+ i delta) 0)) + (indent-line-to (+ i delta))))) + (beginning-of-line 0))))) + +(defun org-outdent-item () + "Outdent a local list item, but not its children. +If a region is active, all items inside will be moved." + (interactive) + (org-list-indent-item-generic + -1 t (org-list-top-point) (org-list-bottom-point))) + +(defun org-indent-item () + "Indent a local list item, but not its children. +If a region is active, all items inside will be moved." + (interactive) + (org-list-indent-item-generic + 1 t (org-list-top-point) (org-list-bottom-point))) + +(defun org-outdent-item-tree () + "Outdent a local list item including its children. +If a region is active, all items inside will be moved." + (interactive) + (org-list-indent-item-generic + -1 nil (org-list-top-point) (org-list-bottom-point))) + +(defun org-indent-item-tree () + "Indent a local list item including its children. +If a region is active, all items inside will be moved." + (interactive) + (org-list-indent-item-generic + 1 nil (org-list-top-point) (org-list-bottom-point))) + +(defvar org-tab-ind-state) +(defun org-cycle-item-indentation () + "Cycle levels of indentation of an empty item. +The first run indent the item, if applicable. Subsequents runs +outdent it at meaningful levels in the list. When done, item is +put back at its original position with its original bullet. -(defvar org-suppress-item-indentation) ; dynamically scoped parameter -(defun org-fix-bullet-type (&optional force-bullet) - "Make sure all items in this list have the same bullet as the first item. -Also, fix the indentation." +Return t at each successful move." + (let ((org-adapt-indentation nil) + (ind (org-get-indentation)) + (bottom (and (org-at-item-p) (org-list-bottom-point)))) + (when (and (or (org-at-item-description-p) + (org-at-item-checkbox-p) + (org-at-item-p)) + ;; Check that item is really empty + (>= (match-end 0) (save-excursion + (org-end-of-item-or-at-child bottom) + (skip-chars-backward " \r\t\n") + (point)))) + (setq this-command 'org-cycle-item-indentation) + (let ((top (org-list-top-point))) + ;; When in the middle of the cycle, try to outdent first. If it + ;; fails, and point is still at initial position, indent. Else, + ;; go back to original position. + (if (eq last-command 'org-cycle-item-indentation) + (cond + ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) + ((and (= (org-get-indentation) (car org-tab-ind-state)) + (ignore-errors + (org-list-indent-item-generic 1 t top bottom)))) + (t (back-to-indentation) + (indent-to-column (car org-tab-ind-state)) + (end-of-line) + (org-list-repair (cdr org-tab-ind-state)) + ;; Break cycle + (setq this-command 'identity))) + ;; If a cycle is starting, remember indentation and bullet, + ;; then try to indent. If it fails, try to outdent. + (setq org-tab-ind-state (cons ind (org-get-bullet))) + (cond + ((ignore-errors (org-list-indent-item-generic 1 t top bottom))) + ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) + (t (error "Cannot move item"))))) + t))) + +;;; Bullets + +(defun org-get-bullet () + "Return the bullet of the item at point. +Assume cursor is at an item." + (save-excursion + (beginning-of-line) + (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))) + +(defun org-list-bullet-string (bullet) + "Return BULLET with the correct number of whitespaces. +It determines the number of whitespaces to append by looking at +`org-list-two-spaces-after-bullet-regexp'." + (save-match-data + (string-match "\\S-+\\([ \t]*\\)" bullet) + (replace-match + (save-match-data + (concat + " " + ;; Do we need to concat another white space ? + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp bullet)) + " "))) + nil nil bullet 1))) + +(defun org-list-inc-bullet-maybe (bullet) + "Increment BULLET if applicable." + (if (string-match "[0-9]+" bullet) + (replace-match + (number-to-string (1+ (string-to-number (match-string 0 bullet)))) + nil nil bullet) + bullet)) + +(defun org-list-repair (&optional force-bullet top bottom) + "Make sure all items are correctly indented, with the right bullet. +This function scans the list at point, along with any sublist. + +If FORCE-BULLET is a string, ensure all items in list share this +bullet, or a logical successor in the case of an ordered list. + +When non-nil, TOP and BOTTOM specify respectively position of +list beginning and list ending. + +Item's body is not indented, only shifted with the bullet." (interactive) (unless (org-at-item-p) (error "This is not a list")) - (let ((line (org-current-line)) - (chars-from-eol (- (point-at-eol) (point))) - (ind (current-indentation)) - ind1 bullet oldbullet) - ;; find where this list begins - (org-beginning-of-item-list) - (beginning-of-line 1) - ;; find out what the bullet type is - (looking-at "[ \t]*\\(\\S-+\\)") - (setq bullet (concat (or force-bullet (match-string 1)) " ")) - (if (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) - (setq bullet (concat bullet " "))) - ;; walk forward and replace these numbers - (beginning-of-line 0) - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (skip-chars-forward " \t") - (looking-at "\\S-+ *") - (setq oldbullet (match-string 0)) - (unless (equal bullet oldbullet) (replace-match bullet)) - (org-shift-item-indentation (- (length bullet) - (length oldbullet)))))) - (org-goto-line line) - (goto-char (max (point-at-bol) (- (point-at-eol) chars-from-eol))) - (if (string-match "[0-9]" bullet) - (org-renumber-ordered-list 1)))) + (let* ((bottom (or bottom (org-list-bottom-point))) + (struct (org-list-struct + (point-at-bol) (point-at-eol) + (or top (org-list-top-point)) bottom)) + (origins (org-list-struct-origins struct)) + fixed-struct) + (if (stringp force-bullet) + (let ((begin (nth 1 struct))) + (setcdr begin (list (nth 1 begin) + (org-list-bullet-string force-bullet) + (nth 3 begin))) + (setq fixed-struct + (cons begin (org-list-struct-fix-struct struct origins)))) + (setq fixed-struct (org-list-struct-fix-struct struct origins))) + (org-list-struct-apply-struct fixed-struct bottom))) + +(defun org-cycle-list-bullet (&optional which) + "Cycle through the different itemize/enumerate bullets. +This cycle the entire list level through the sequence: + + `-' -> `+' -> `*' -> `1.' -> `1)' -(defun org-shift-item-indentation (delta) - "Shift the indentation in current item by DELTA." - (unless (org-bound-and-true-p org-suppress-item-indentation) - (save-excursion - (let ((beg (point-at-bol)) - (end (progn (org-end-of-item) (point))) - i) - (goto-char end) - (beginning-of-line 0) - (while (> (point) beg) - (when (looking-at "[ \t]*\\S-") - ;; this is not an empty line - (setq i (org-get-indentation)) - (if (and (> i 0) (> (setq i (+ i delta)) 0)) - (indent-line-to i))) - (beginning-of-line 0)))))) +If WHICH is a valid string, use that as the new bullet. If WHICH +is an integer, 0 means `-', 1 means `+' etc. If WHICH is +'previous, cycle backwards." + (interactive "P") + (let* ((top (org-list-top-point)) + (bullet (save-excursion + (goto-char (org-get-beginning-of-list top)) + (org-get-bullet))) + (current (cond + ((string-match "\\." bullet) "1.") + ((string-match ")" bullet) "1)") + (t bullet))) + (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) + (bullet-list (append '("-" "+" ) + ;; *-bullets are not allowed at column 0 + (unless (and bullet-rule-p + (looking-at "\\S-")) '("*")) + ;; Description items cannot be numbered + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?\)) + (org-at-item-description-p))) '("1.")) + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?.) + (org-at-item-description-p))) '("1)")))) + (len (length bullet-list)) + (item-index (- len (length (member current bullet-list)))) + (get-value (lambda (index) (nth (mod index len) bullet-list))) + (new (cond + ((member which bullet-list) which) + ((numberp which) (funcall get-value which)) + ((eq 'previous which) (funcall get-value (1- item-index))) + (t (funcall get-value (1+ item-index)))))) + (org-list-repair new top))) + +;;; Checkboxes + +(defun org-toggle-checkbox (&optional toggle-presence) + "Toggle the checkbox in the current line. +With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With +double prefix, set checkbox to [-]. + +When there is an active region, toggle status or presence of the +first checkbox there, and make every item inside have the +same status or presence, respectively. -(defun org-beginning-of-item-list () - "Go to the beginning of the current item list. -I.e. to the first item in this list." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (throw (if (bobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (and (= (point-at-bol) (point-min)) - (setq pos (point-min)))) - (throw 'exit t) - (when (org-at-item-p) (setq pos (point-at-bol))))))) - (goto-char pos))) +If the cursor is in a headline, apply this to all checkbox items +in the text below the heading, taking as reference the first item +in subtree, ignoring drawers." + (interactive "P") + ;; Bounds is a list of type (beg end single-p) where single-p is t + ;; when `org-toggle-checkbox' is applied to a single item. Only + ;; toggles on single items will return errors. + (let* ((bounds + (cond + ((org-region-active-p) + (let ((rbeg (region-beginning)) + (rend (region-end))) + (save-excursion + (goto-char rbeg) + (if (org-search-forward-unenclosed org-item-beginning-re rend 'move) + (list (point-at-bol) rend nil) + (error "No item in region"))))) + ((org-on-heading-p) + ;; In this case, reference line is the first item in + ;; subtree outside drawers + (let ((pos (point)) + (limit (save-excursion (outline-next-heading) (point)))) + (save-excursion + (goto-char limit) + (org-search-backward-unenclosed ":END:" pos 'move) + (org-search-forward-unenclosed + org-item-beginning-re limit 'move) + (list (point) limit nil)))) + ((org-at-item-p) + (list (point-at-bol) (1+ (point-at-eol)) t)) + (t (error "Not at an item or heading, and no active region")))) + (beg (car bounds)) + ;; marker is needed because deleting or inserting checkboxes + ;; will change bottom point + (end (copy-marker (nth 1 bounds))) + (single-p (nth 2 bounds)) + (ref-presence (save-excursion + (goto-char beg) + (org-at-item-checkbox-p))) + (ref-status (equal (match-string 1) "[X]")) + (act-on-item + (lambda (ref-pres ref-stat) + (if (equal toggle-presence '(4)) + (cond + ((and ref-pres (org-at-item-checkbox-p)) + (replace-match "")) + ((and (not ref-pres) + (not (org-at-item-checkbox-p)) + (org-at-item-p)) + (goto-char (match-end 0)) + ;; Ignore counter, if any + (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") + (goto-char (match-end 0))) + (let ((desc-p (and (org-at-item-description-p) + (cdr (assq 'checkbox org-list-automatic-rules))))) + (cond + ((and single-p desc-p) + (error "Cannot add a checkbox in a description list")) + ((not desc-p) (insert "[ ] ")))))) + (let ((blocked (org-checkbox-blocked-p))) + (cond + ((and blocked single-p) + (error "Checkbox blocked because of unchecked box in line %d" blocked)) + (blocked nil) + ((org-at-item-checkbox-p) + (replace-match + (cond ((equal toggle-presence '(16)) "[-]") + (ref-stat "[ ]") + (t "[X]")) + t t nil 1)))))))) + (save-excursion + (goto-char beg) + (while (< (point) end) + (funcall act-on-item ref-presence ref-status) + (org-search-forward-unenclosed org-item-beginning-re end 'move))) + (org-update-checkbox-count-maybe))) -(defun org-end-of-item-list () - "Go to the end of the current item list. -I.e. to the text after the last item." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (looking-at "[ \t]*$") - (if (eobp) - (progn (setq pos (point)) (throw 'exit t)) - (throw 'next t))) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (eobp)) - (progn - (setq pos (point-at-bol)) - (throw 'exit t)))))) - (goto-char pos))) +(defun org-reset-checkbox-state-subtree () + "Reset all checkboxes in an entry subtree." + (interactive "*") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-show-subtree) + (goto-char (point-min)) + (let ((end (point-max))) + (while (< (point) end) + (when (org-at-item-checkbox-p) + (replace-match "[ ]" t t nil 1)) + (beginning-of-line 2)))) + (org-update-checkbox-count-maybe))) - -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) +(defvar org-checkbox-statistics-hook nil + "Hook that is run whenever Org thinks checkbox statistics should be updated. +This hook runs even if checkbox rule in +`org-list-automatic-rules' does not apply, so it can be used to +implement alternative ways of collecting statistics +information.") -(defun org-outdent-item (arg) - "Outdent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree (- arg) 'no-subtree)) - -(defun org-indent-item (arg) - "Indent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree arg 'no-subtree)) +(defun org-update-checkbox-count-maybe () + "Update checkbox statistics unless turned off by user." + (when (cdr (assq 'checkbox org-list-automatic-rules)) + (org-update-checkbox-count)) + (run-hooks 'org-checkbox-statistics-hook)) -(defun org-outdent-item-tree (arg &optional no-subtree) - "Outdent a local list item including its children. -If NO-SUBTREE is set, only outdent the item itself, not its children." - (interactive "p") - (org-indent-item-tree (- arg) no-subtree)) +(defun org-update-checkbox-count (&optional all) + "Update the checkbox statistics in the current section. +This will find all statistic cookies like [57%] and [6/12] and update them +with the current numbers. With optional prefix argument ALL, do this for +the whole buffer." + (interactive "P") + (save-excursion + (let ((cstat 0)) + (catch 'exit + (while t + (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 + (beg (condition-case nil + (progn (org-back-to-heading) (point)) + (error (point-min)))) + (end (copy-marker (save-excursion + (outline-next-heading) (point)))) + (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + beg-cookie end-cookie is-percent c-on c-off lim new + curr-ind next-ind continue-from startsearch list-beg list-end + (recursive + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\<recursive\\>" + (or (ignore-errors + (org-entry-get nil "COOKIE_DATA")) + ""))))) + (goto-char end) + ;; find each statistics cookie + (while (and (org-search-backward-unenclosed re-cookie beg 'move) + (not (save-match-data + (and (org-on-heading-p) + (string-match "\\<todo\\>" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))))) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1) + cstat (+ cstat (if end-cookie 1 0)) + startsearch (point-at-eol) + continue-from (match-beginning 0) + is-percent (match-beginning 2) + lim (cond + ((org-on-heading-p) (outline-next-heading) (point)) + ;; Ensure many cookies in the same list won't imply + ;; computing list boundaries as many times. + ((org-at-item-p) + (unless (and list-beg (>= (point) list-beg)) + (setq list-beg (org-list-top-point) + list-end (copy-marker + (org-list-bottom-point)))) + (org-get-end-of-item list-end)) + (t nil)) + c-on 0 + c-off 0) + (when lim + ;; find first checkbox for this cookie and gather + ;; statistics from all that are at this indentation level + (goto-char startsearch) + (if (org-search-forward-unenclosed re-box lim t) + (progn + (beginning-of-line) + (setq curr-ind (org-get-indentation)) + (setq next-ind curr-ind) + (while (and (bolp) (org-at-item-p) + (if recursive + (<= curr-ind next-ind) + (= curr-ind next-ind))) + (when (org-at-item-checkbox-p) + (if (member (match-string 1) '("[ ]" "[-]")) + (setq c-off (1+ c-off)) + (setq c-on (1+ c-on)))) + (if (not recursive) + ;; org-get-next-item goes through list-enders + ;; with proper limit. + (goto-char (or (org-get-next-item (point) lim) lim)) + (end-of-line) + (when (org-search-forward-unenclosed + org-item-beginning-re lim t) + (beginning-of-line))) + (setq next-ind (org-get-indentation))))) + (goto-char continue-from) + ;; update cookie + (when end-cookie + (setq new (if is-percent + (format "[%d%%]" (/ (* 100 c-on) + (max 1 (+ c-on c-off)))) + (format "[%d/%d]" c-on (+ c-on c-off)))) + (goto-char beg-cookie) + (insert new) + (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) + ;; update items checkbox if it has one + (when (and (org-at-item-checkbox-p) + (> (+ c-on c-off) 0)) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1)) + (delete-region beg-cookie end-cookie) + (goto-char beg-cookie) + (cond ((= c-off 0) (insert "[X]")) + ((= c-on 0) (insert "[ ]")) + (t (insert "[-]"))))) + (goto-char continue-from))) + (unless (and all (outline-next-heading)) (throw 'exit nil)))) + (when (interactive-p) + (message "Checkbox statistics updated %s (%d places)" + (if all "in entire file" "in current outline entry") cstat))))) -(defun org-indent-item-tree (arg &optional no-subtree) - "Indent a local list item including its children. -If NO-SUBTREE is set, only indent the item itself, not its children." - (interactive "p") - (and (org-region-active-p) (org-cursor-to-region-beginning)) - (unless (org-at-item-p) - (error "Not on an item")) - (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp) - (setq firstp (org-first-list-item-p)) - (save-excursion - (setq end (and (org-region-active-p) (region-end))) - (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (if no-subtree - (org-end-of-item-text-before-children) - (org-end-of-item)) - (setq end (move-marker org-last-indent-end-marker (or end (point))))) - (goto-char beg) - (setq ind-bul (org-item-indent-positions) - ind (caar ind-bul) - ind-down (car (nth 2 ind-bul)) - ind-up (car (nth 1 ind-bul)) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) - (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (org-indent-to-column (+ ind1 delta))) - (beginning-of-line 2))) - (org-fix-bullet-type - (and (> arg 0) - (not firstp) - (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet)))) - (org-maybe-renumber-ordered-list-safe) - (save-excursion - (beginning-of-line 0) - (condition-case nil (org-beginning-of-item) (error nil)) - (org-maybe-renumber-ordered-list-safe)))) +(defun org-get-checkbox-statistics-face () + "Select the face for checkbox statistics. +The face will be `org-done' when all relevant boxes are checked. +Otherwise it will be `org-todo'." + (if (match-end 1) + (if (equal (match-string 1) "100%") + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo) + (if (and (> (match-end 2) (match-beginning 2)) + (equal (match-string 2) (match-string 3))) + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo))) -(defun org-item-indent-positions () - "Return indentation for plain list items. -This returns a list with three values: The current indentation, the -parent indentation and the indentation a child should have. -Assumes cursor in item line." - (let* ((bolpos (point-at-bol)) - (ind (org-get-indentation)) - (bullet (org-get-bullet)) - ind-down ind-up bullet-up bullet-down pos) - (save-excursion - (org-beginning-of-item-list) - (skip-chars-backward "\n\r \t") - (when (org-in-item-p) - (org-beginning-of-item) - (setq ind-up (org-get-indentation)) - (setq bullet-up (org-get-bullet)))) - (setq pos (point)) - (save-excursion - (cond - ((and (condition-case nil (progn (org-previous-item) t) - (error nil)) - (or (forward-char 1) t) - (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) - (setq ind-down (org-get-indentation) - bullet-down (org-get-bullet))) - ((and (goto-char pos) - (org-at-item-p)) - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind-down (current-column) - bullet-down (org-get-bullet))))) - (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down)) - (setq bullet-down (concat "1" (match-string 1 bullet-down)))) - (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up)) - (setq bullet-up (concat "1" (match-string 1 bullet-up)))) - (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet)) - (setq bullet (concat "1" (match-string 1 bullet)))) - (list (cons ind bullet) - (cons ind-up bullet-up) - (cons ind-down bullet-down)))) +;;; Misc Tools + +(defun org-apply-on-list (function init-value &rest args) + "Call FUNCTION on each item of the list at point. +FUNCTION must be called with at least one argument: INIT-VALUE, +that will contain the value returned by the function at the +previous item, plus ARGS extra arguments. + +As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) +will return the number of items in the current list. + +Sublists of the list are skipped. Cursor is always at the +beginning of the item." + (let* ((pos (copy-marker (point))) + (end (copy-marker (org-list-bottom-point))) + (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point)))) + (value init-value)) + (while (< next-p end) + (goto-char next-p) + (set-marker next-p (or (org-get-next-item (point) end) end)) + (setq value (apply function value args))) + (goto-char pos) + value)) + +(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) + "Sort plain list items. +The cursor may be at any item of the list that should be sorted. +Sublists are not sorted. Checkboxes, if any, are ignored. + +Sorting can be alphabetically, numerically, by date/time as given by +a time stamp, by a property or by priority. + +Comparing entries ignores case by default. However, with an +optional argument WITH-CASE, the sorting considers case as well. + +The command prompts for the sorting type unless it has been given +to the function through the SORTING-TYPE argument, which needs to +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise +meaning of each character: + +n Numerically, by converting the beginning of the item to a number. +a Alphabetically. Only the first line of item is checked. +t By date/time, either the first active time stamp in the entry, if + any, or by the first inactive one. In a timer list, sort the timers. + +Capital letters will reverse the sort order. -(defvar org-tab-ind-state) ; defined in org.el -(defun org-cycle-item-indentation () - (let ((org-suppress-item-indentation t) - (org-adapt-indentation nil)) - (cond - ((and (looking-at "[ \t]*$") - (org-looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+")) - (setq this-command 'org-cycle-item-indentation) - (if (eq last-command 'org-cycle-item-indentation) - (condition-case nil - (progn (org-outdent-item 1) - (if (equal org-tab-ind-state (org-get-indentation)) - (org-outdent-item 1)) - (end-of-line 1)) - (error - (progn - (while (< (org-get-indentation) org-tab-ind-state) - (progn (org-indent-item 1) (end-of-line 1))) - (setq this-command 'org-cycle)))) - (setq org-tab-ind-state (org-get-indentation)) - (org-indent-item 1)) - t)))) - -(defun org-get-bullet () - (save-excursion - (goto-char (point-at-bol)) - (and (looking-at - "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)") - (or (match-string 2) (match-string 4))))) +If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a +function to be called with point at the beginning of the record. +It must return either a string or a number that should serve as +the sorting key for that record. It will then use COMPARE-FUNC to +compare entries." + (interactive "P") + (let* ((case-func (if with-case 'identity 'downcase)) + (top (org-list-top-point)) + (bottom (org-list-bottom-point)) + (start (org-get-beginning-of-list top)) + (end (org-get-end-of-list bottom)) + (sorting-type + (progn + (message + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") + (read-char-exclusive))) + (getkey-func (and (= (downcase sorting-type) ?f) + (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil) + (intern getkey-func)))) + (message "Sorting items...") + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (let* ((dcst (downcase sorting-type)) + (case-fold-search nil) + (now (current-time)) + (sort-func (cond + ((= dcst ?a) 'string<) + ((= dcst ?f) compare-func) + ((= dcst ?t) '<) + (t nil))) + (begin-record (lambda () + (skip-chars-forward " \r\t\n") + (beginning-of-line))) + (end-record (lambda () + (goto-char (org-end-of-item-before-blank end)))) + (value-to-sort + (lambda () + (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") + (cond + ((= dcst ?n) + (string-to-number (buffer-substring (match-end 0) + (point-at-eol)))) + ((= dcst ?a) + (buffer-substring (match-end 0) (point-at-eol))) + ((= dcst ?t) + (cond + ;; If it is a timer list, convert timer to seconds + ((org-at-item-timer-p) + (org-timer-hms-to-secs (match-string 1))) + ((or (org-search-forward-unenclosed org-ts-regexp + (point-at-eol) t) + (org-search-forward-unenclosed org-ts-regexp-both + (point-at-eol) t)) + (org-time-string-to-seconds (match-string 0))) + (t (org-float-time now)))) + ((= dcst ?f) + (if getkey-func + (let ((value (funcall getkey-func))) + (if (stringp value) + (funcall case-func value) + value)) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type))))))) + (sort-subr (/= dcst sorting-type) + begin-record + end-record + value-to-sort + nil + sort-func) + (org-list-repair nil top bottom) + (run-hooks 'org-after-sorting-entries-or-items-hook) + (message "Sorting items...done"))))) ;;; Send and receive lists @@ -1147,85 +2023,55 @@ "Parse the list at point and maybe DELETE it. Return a list containing first level items as strings and sublevels as a list of strings." - (let* ((item-beginning (org-list-item-beginning)) - (start (car item-beginning)) - (end (save-excursion - (goto-char (org-list-end (cdr item-beginning))) - (org-back-over-empty-lines) - (point))) + (let* ((start (goto-char (org-list-top-point))) + (end (org-list-bottom-point)) output itemsep ltype) - (while (re-search-forward org-list-beginning-re end t) - (goto-char (match-beginning 3)) - (save-match-data - (cond ((string-match "[0-9]" (match-string 2)) - (setq itemsep "[0-9]+\\(?:\\.\\|)\\)" - ltype 'ordered)) - ((string-match "^.*::" (match-string 0)) - (setq itemsep "[-+]" ltype 'descriptive)) - (t (setq itemsep "[-+]" ltype 'unordered)))) - (let* ((indent1 (match-string 1)) - (nextitem (save-excursion - (save-match-data - (or (and (re-search-forward - (concat "^" indent1 itemsep " *?") end t) - (match-beginning 0)) end)))) - (item (buffer-substring - (point) - (or (and (org-re-search-forward-unprotected - org-list-beginning-re end t) - (goto-char (match-beginning 0))) - (goto-char end)))) - (nextindent (match-string 1)) - (item (org-trim item)) - (item (if (string-match "^\\[\\([xX ]\\)\\]" item) + (while (org-search-forward-unenclosed org-item-beginning-re end t) + (save-excursion + (beginning-of-line) + (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered) + ((org-at-item-description-p) 'descriptive) + (t 'unordered)))) + (let* ((indent1 (org-get-indentation)) + (nextitem (or (org-get-next-item (point) end) end)) + (item (org-trim (buffer-substring (point) + (org-end-of-item-or-at-child end)))) + (nextindent (if (= (point) end) 0 (org-get-indentation))) + (item (if (string-match + "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" + item) (replace-match (if (equal (match-string 1 item) " ") - "[CBOFF]" - "[CBON]") - t nil item) + "CBOFF" + "CBON") + t nil item 1) item))) (push item output) - (when (> (length nextindent) - (length indent1)) - (narrow-to-region (point) nextitem) - (push (org-list-parse-list) output) - (widen)))) - (when delete (delete-region start end)) + (when (> nextindent indent1) + (save-restriction + (narrow-to-region (point) nextitem) + (push (org-list-parse-list) output))))) + (when delete + (delete-region start end) + (save-match-data + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (replace-match "\n")))) (setq output (nreverse output)) (push ltype output))) -(defun org-list-item-beginning () - "Find the beginning of the list item. -Return a cons which car is the beginning position of the item and -cdr is the indentation string." - (save-excursion - (if (not (or (looking-at org-list-beginning-re) - (re-search-backward - org-list-beginning-re nil t))) - (progn (goto-char (point-min)) (point)) - (cons (match-beginning 0) (match-string 1))))) - -(defun org-list-goto-true-beginning () - "Go to the beginning of the list at point." - (beginning-of-line 1) - (while (looking-at org-list-beginning-re) - (beginning-of-line 0)) - (progn - (re-search-forward org-list-beginning-re nil t) - (goto-char (match-beginning 0)))) - (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) - (org-list-goto-true-beginning) - (let ((list (org-list-parse-list t)) nstars) - (save-excursion - (if (condition-case nil - (org-back-to-heading) - (error nil)) - (progn (re-search-forward org-complex-heading-regexp nil t) - (setq nstars (length (match-string 1)))) - (setq nstars 0))) - (org-list-make-subtrees list (1+ nstars)))) + (if (not (org-in-item-p)) + (error "Not in a list") + (let ((list (org-list-parse-list t)) nstars) + (save-excursion + (if (ignore-errors + (org-back-to-heading)) + (progn (looking-at org-complex-heading-regexp) + (setq nstars (length (match-string 1)))) + (setq nstars 0))) + (org-list-make-subtrees list (1+ nstars))))) (defun org-list-make-subtrees (list level) "Convert LIST into subtrees starting at LEVEL." @@ -1239,20 +2085,6 @@ (org-list-make-subtrees item (1+ level)))) list))) -(defun org-list-end (indent) - "Return the position of the end of the list. -INDENT is the indentation of the list, as a string." - (save-excursion - (catch 'exit - (while (or (looking-at org-list-beginning-re) - (looking-at (concat "^" indent "[ \t]+\\|^$")) - (> (or (get-text-property (point) 'original-indentation) -1) - (length indent))) - (if (eq (point) (point-max)) - (throw 'exit (point-max))) - (forward-line 1))) - (point))) - (defun org-list-insert-radio-list () "Insert a radio list template appropriate for this major mode." (interactive) @@ -1274,20 +2106,29 @@ this list." (interactive) (catch 'exit - (unless (org-at-item-p) (error "Not at a list")) + (unless (org-at-item-p) (error "Not at a list item")) (save-excursion - (org-list-goto-true-beginning) - (beginning-of-line 0) + (re-search-backward "#\\+ORGLST" nil t) (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) - (item-beginning (org-list-item-beginning)) - (list (save-excursion (org-list-goto-true-beginning) - (org-list-parse-list))) - txt beg) + (bottom-point + (save-excursion + (re-search-forward + "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) + (match-beginning 0))) + (top-point + (progn + (re-search-backward "#\\+ORGLST" nil t) + (re-search-forward org-item-beginning-re bottom-point t) + (match-beginning 0))) + (list (save-restriction + (narrow-to-region top-point bottom-point) + (org-list-parse-list))) + beg txt) (unless (fboundp transform) (error "No such transformation function %s" transform)) (let ((txt (funcall transform list))) @@ -1295,22 +2136,22 @@ (save-excursion (goto-char (point-min)) (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) + (concat "BEGIN RECEIVE ORGLST +" + name + "\\([ \t]\\|$\\)") nil t) (error "Don't know where to insert translated list")) (goto-char (match-beginning 0)) (beginning-of-line 2) (setq beg (point)) (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) + (delete-region beg (point-at-bol)) (goto-char beg) (insert txt "\n"))) (message "List converted and installed at receiver location")))) (defun org-list-to-generic (list params) "Convert a LIST parsed through `org-list-parse-list' to other formats. - Valid parameters PARAMS are :ustart String to start an unordered list @@ -1339,21 +2180,21 @@ (interactive) (let* ((p params) sublist (splicep (plist-get p :splice)) - (ostart (plist-get p :ostart)) - (oend (plist-get p :oend)) - (ustart (plist-get p :ustart)) - (uend (plist-get p :uend)) - (dstart (plist-get p :dstart)) - (dend (plist-get p :dend)) - (dtstart (plist-get p :dtstart)) - (dtend (plist-get p :dtend)) - (ddstart (plist-get p :ddstart)) - (ddend (plist-get p :ddend)) - (istart (plist-get p :istart)) - (iend (plist-get p :iend)) - (isep (plist-get p :isep)) - (lsep (plist-get p :lsep)) - (cbon (plist-get p :cbon)) + (ostart (plist-get p :ostart)) + (oend (plist-get p :oend)) + (ustart (plist-get p :ustart)) + (uend (plist-get p :uend)) + (dstart (plist-get p :dstart)) + (dend (plist-get p :dend)) + (dtstart (plist-get p :dtstart)) + (dtend (plist-get p :dtend)) + (ddstart (plist-get p :ddstart)) + (ddend (plist-get p :ddend)) + (istart (plist-get p :istart)) + (iend (plist-get p :iend)) + (isep (plist-get p :isep)) + (lsep (plist-get p :lsep)) + (cbon (plist-get p :cbon)) (cboff (plist-get p :cboff))) (let ((wrapper (cond ((eq (car list) 'ordered) @@ -1366,22 +2207,24 @@ (while (setq sublist (pop list)) (cond ((symbolp sublist) nil) ((stringp sublist) - (when (string-match "^\\(.*\\) ::" sublist) + (when (string-match "^\\(.*\\)[ \t]+::" sublist) (setq term (org-trim (format (concat dtstart "%s" dtend) (match-string 1 sublist)))) - (setq sublist (substring sublist (1+ (length term))))) + (setq sublist (concat ddstart + (org-trim (substring sublist + (match-end 0))) + ddend))) (if (string-match "\\[CBON\\]" sublist) (setq sublist (replace-match cbon t t sublist))) (if (string-match "\\[CBOFF\\]" sublist) (setq sublist (replace-match cboff t t sublist))) (if (string-match "\\[-\\]" sublist) (setq sublist (replace-match "$\\boxminus$" t t sublist))) - (setq rtn (concat rtn istart term ddstart - sublist ddend iend isep))) - (t (setq rtn (concat rtn ;; previous list - lsep ;; list separator + (setq rtn (concat rtn istart term sublist iend isep))) + (t (setq rtn (concat rtn ;; previous list + lsep ;; list separator (org-list-to-generic sublist p) - lsep ;; list separator + lsep ;; list separator ))))) (format wrapper rtn))))
--- a/lisp/org/org-mac-message.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-mac-message.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Christopher Suckling <suckling at gmail dot com> -;; Version: 7.01 +;; Version: 7.3 ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs.
--- a/lisp/org/org-macs.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-macs.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -38,11 +38,27 @@ (defmacro declare-function (fn file &optional arglist fileonly)))) (declare-function org-add-props "org-compat" (string plist &rest props)) +(declare-function org-string-match-p "org-compat" (&rest args)) + +(defmacro org-called-interactively-p (&optional kind) + `(if (featurep 'xemacs) + (interactive-p) + (if (or (> emacs-major-version 23) + (and (>= emacs-major-version 23) + (>= emacs-minor-version 2))) + (called-interactively-p ,kind) + (interactive-p)))) (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) +(defun org-string-nw-p (s) + "Is S a string with a non-white character?" + (and (stringp s) + (org-string-match-p "\\S-" s) + s)) + (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. Otherwise return nil." @@ -283,63 +299,6 @@ (match-beginning 0) string))) (replace-match newtext fixedcase literal string)) -(defmacro org-with-limited-levels (&rest body) - "Execute BODY with limited number of outline levels." - `(let* ((outline-regexp (org-get-limited-outline-regexp))) - ,@body)) - -(defvar org-odd-levels-only) ; defined in org.el -(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el -(defun org-get-limited-outline-regexp () - "Return outline-regexp with limited number of levels. -The number of levels is controlled by `org-inlinetask-min-level'" - (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) - - outline-regexp - (let* ((limit-level (1- org-inlinetask-min-level)) - (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) - (format "\\*\\{1,%d\\} " nstars)))) - - -;;; Saving and restoring visibility - -(defun org-outline-overlay-data (&optional use-markers) - "Return a list of the locations of all outline overlays. -The are overlays with the `invisible' property value `outline'. -The return values is a list of cons cells, with start and stop -positions for each overlay. -If USE-MARKERS is set, return the positions as markers." - (let (beg end) - (save-excursion - (save-restriction - (widen) - (delq nil - (mapcar (lambda (o) - (when (eq (overlay-get o 'invisible) 'outline) - (setq beg (overlay-start o) - end (overlay-end o)) - (and beg end (> end beg) - (if use-markers - (cons (move-marker (make-marker) beg) - (move-marker (make-marker) end)) - (cons beg end))))) - (overlays-in (point-min) (point-max)))))))) - -(autoload 'show-all "outline" nil t) - -(defun org-set-outline-overlay-data (data) - "Create visibility overlays for all positions in DATA. -DATA should have been made by `org-outline-overlay-data'." - (let (o) - (save-excursion - (save-restriction - (widen) - (show-all) - (mapc (lambda (c) - (setq o (make-overlay (car c) (cdr c))) - (overlay-put o 'invisible 'outline)) - data))))) - (defmacro org-save-outline-visibility (use-markers &rest body) "Save and restore outline visibility around BODY. If USE-MARKERS is non-nil, use markers for the positions. @@ -359,6 +318,22 @@ (and (markerp (cdr c)) (move-marker (cdr c) nil))) data))))) +(defmacro org-with-limited-levels (&rest body) + "Execute BODY with limited number of outline levels." + `(let* ((outline-regexp (org-get-limited-outline-regexp))) + ,@body)) + +(defvar org-odd-levels-only) ; defined in org.el +(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el +(defun org-get-limited-outline-regexp () + "Return outline-regexp with limited number of levels. +The number of levels is controlled by `org-inlinetask-min-level'" + (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) + + outline-regexp + (let* ((limit-level (1- org-inlinetask-min-level)) + (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) + (format "\\*\\{1,%d\\} " nstars)))) (provide 'org-macs)
--- a/lisp/org/org-mew.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-mew.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. @@ -81,7 +81,7 @@ (mew-case-folder (mew-sinfo-get-case) (nth 1 (mew-refile-get msgnum))) (mew-summary-folder-name))) - message-id from to subject desc link) + message-id from to subject desc link date date-ts date-ts-ia) (save-window-excursion (if (fboundp 'mew-summary-set-message-buffer) (mew-summary-set-message-buffer folder-name msgnum) @@ -89,9 +89,19 @@ (setq message-id (mew-header-get-value "Message-Id:")) (setq from (mew-header-get-value "From:")) (setq to (mew-header-get-value "To:")) + (setq date (mew-header-get-value "Date:")) + (setq date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (setq date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) (setq subject (mew-header-get-value "Subject:"))) (org-store-link-props :type "mew" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) (setq link (org-make-link "mew:" folder-name
--- a/lisp/org/org-mhe.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-mhe.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -83,13 +83,22 @@ "Store a link to an MH-E folder or message." (when (or (equal major-mode 'mh-folder-mode) (equal major-mode 'mh-show-mode)) - (let ((from (org-mhe-get-header "From:")) - (to (org-mhe-get-header "To:")) - (message-id (org-mhe-get-header "Message-Id:")) - (subject (org-mhe-get-header "Subject:")) - link desc) + (let* ((from (org-mhe-get-header "From:")) + (to (org-mhe-get-header "To:")) + (message-id (org-mhe-get-header "Message-Id:")) + (subject (org-mhe-get-header "Subject:")) + (date (org-mhe-get-header "Date:")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + link desc) (org-store-link-props :type "mh" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description)) (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" (org-remove-angle-brackets message-id))) @@ -181,7 +190,7 @@ (if (equal major-mode 'mh-folder-mode) (mh-show) (mh-show-show)) - header-field))) + (org-trim header-field)))) (defun org-mhe-follow-link (folder article) "Follow an MH-E link to FOLDER and ARTICLE.
--- a/lisp/org/org-mks.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-mks.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-mobile.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-mobile.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -26,10 +26,11 @@ ;;; Commentary: ;; ;; This file contains the code to interact with Richard Moreland's iPhone -;; application MobileOrg. This code is documented in Appendix B of the -;; Org-mode manual. The code is not specific for the iPhone, however. -;; Any external viewer/flagging/editing application that uses the same -;; conventions could be used. +;; application MobileOrg, as well as with the Android version by Matthew Jones. +;; This code is documented in Appendix B of the Org-mode manual. The code is +;; not specific for the iPhone and Android - any external +;; viewer/flagging/editing application that uses the same conventions could +;; be used. (require 'org) (require 'org-agenda) @@ -90,12 +91,29 @@ This is a single password which is used for AES-256 encryption. The same password must also be set in the MobileOrg application. All Org files, including mobileorg.org will be encrypted using this password. + +SECURITY CONSIDERATIONS: + Note that, when Org runs the encryption commands, the password could -be visible on your system with the `ps' command. So this method is only -intended to keep the files secure on the server, not on your own machine." +be visible briefly on your system with the `ps' command. So this method is +only intended to keep the files secure on the server, not on your own machine. + +Also, if you set this variable in an init file (.emacs or .emacs.d/init.el +or custom.el...) and if that file is stored in a way so that other can read +it, this also limits the security of this approach. You can also leave +this variable empty - Org will then ask for the password once per Emacs +session." :group 'org-mobile :type '(string :tag "Password")) +(defvar org-mobile-encryption-password-session nil) + +(defun org-mobile-encryption-password () + (or (org-string-nw-p org-mobile-encryption-password) + (org-string-nw-p org-mobile-encryption-password-session) + (setq org-mobile-encryption-password-session + (read-passwd "Password for MobileOrg: " t)))) + (defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org" "The file where captured notes and flags will be appended to. During the execution of `org-mobile-pull', the file @@ -133,7 +151,7 @@ (string :tag "Selection Keys")))) (defcustom org-mobile-force-id-on-agenda-items t - "Non-nil means make all agenda items carry and ID." + "Non-nil means make all agenda items carry an ID." :group 'org-mobile :type 'boolean) @@ -331,6 +349,7 @@ (defun org-mobile-check-setup () "Check if org-mobile-directory has been set up." + (org-mobile-cleanup-encryption-tempfile) (unless (and org-directory (stringp org-directory) (string-match "\\S-" org-directory) @@ -356,7 +375,7 @@ (string-match "\\S-" org-mobile-checksum-binary)) (error "No executable found to compute checksums")) (when org-mobile-use-encryption - (unless (string-match "\\S-" org-mobile-encryption-password) + (unless (string-match "\\S-" (org-mobile-encryption-password)) (error "To use encryption, you must set `org-mobile-encryption-password'")) (unless (file-writable-p org-mobile-encryption-tempfile) @@ -371,6 +390,8 @@ (lambda (a b) (string< (cdr a) (cdr b))))) (def-todo (default-value 'org-todo-keywords)) (def-tags (default-value 'org-tag-alist)) + (target-file (expand-file-name org-mobile-index-file + org-mobile-directory)) file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) (org-prepare-agenda-buffers (mapcar 'car files-alist)) @@ -389,7 +410,9 @@ (t nil))) org-tag-alist-for-agenda)))) (with-temp-file - (expand-file-name org-mobile-index-file org-mobile-directory) + (if org-mobile-use-encryption + org-mobile-encryption-tempfile + target-file) (while (setq entry (pop def-todo)) (insert "#+READONLY\n") (setq kwds (mapcar (lambda (x) (if (string-match "(" x) @@ -430,7 +453,11 @@ (insert (format "* [[file:%s][%s]]\n" link-name link-name))) (push (cons org-mobile-index-file (md5 (buffer-string))) - org-mobile-checksum-files)))) + org-mobile-checksum-files)) + (when org-mobile-use-encryption + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile + target-file) + (org-mobile-cleanup-encryption-tempfile)))) (defun org-mobile-copy-agenda-files () "Copy all agenda files to the stage or WebDAV directory." @@ -452,14 +479,20 @@ (when (string-match "[a-fA-F0-9]\\{30,40\\}" check) (push (cons link-name (match-string 0 check)) org-mobile-checksum-files)))) + (setq file (expand-file-name org-mobile-capture-file org-mobile-directory)) (save-excursion (setq buf (find-file file)) - (and (= (point-min) (point-max)) (insert "\n")) - (save-buffer) + (when (and (= (point-min) (point-max))) + (insert "\n") + (save-buffer) + (when org-mobile-use-encryption + (write-file org-mobile-encryption-tempfile) + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile file))) (push (cons org-mobile-capture-file (md5 (buffer-string))) org-mobile-checksum-files)) + (org-mobile-cleanup-encryption-tempfile) (kill-buffer buf))) (defun org-mobile-write-checksums () @@ -606,14 +639,30 @@ (if (org-bound-and-true-p org-mobile-force-id-on-agenda-items) (org-id-get m 'create) - (org-entry-get m "ID"))) + (or (org-entry-get m "ID") + (org-mobile-get-outline-path-link m)))) (insert " :PROPERTIES:\n :ORIGINAL_ID: " id "\n :END:\n"))))) (beginning-of-line 2)) - (push (cons (file-name-nondirectory file) (md5 (buffer-string))) + (push (cons "agendas.org" (md5 (buffer-string))) org-mobile-checksum-files)) (message "Agenda written to Org file %s" file))) +(defun org-mobile-get-outline-path-link (pom) + (org-with-point-at pom + (concat "olp:" + (org-mobile-escape-olp (file-name-nondirectory buffer-file-name)) + "/" + (mapconcat 'org-mobile-escape-olp + (org-get-outline-path) + "/") + "/" + (org-mobile-escape-olp (nth 4 (org-heading-components)))))) + +(defun org-mobile-escape-olp (s) + (let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) + (org-link-escape s table))) + ;;;###autoload (defun org-mobile-create-sumo-agenda () "Create a file that contains all custom agenda views." @@ -632,8 +681,9 @@ (when sumo (org-store-agenda-views)) (when org-mobile-use-encryption - (org-mobile-encrypt-file file1 file) - (delete-file file1)))) + (org-mobile-encrypt-and-move file1 file) + (delete-file file1) + (org-mobile-cleanup-encryption-tempfile)))) (defun org-mobile-encrypt-and-move (infile outfile) "Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE. @@ -649,7 +699,8 @@ "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." (shell-command (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s" - (shell-quote-argument (concat "pass:" org-mobile-encryption-password)) + (shell-quote-argument (concat "pass:" + (org-mobile-encryption-password))) (shell-quote-argument (expand-file-name infile)) (shell-quote-argument (expand-file-name outfile))))) @@ -657,10 +708,17 @@ "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." (shell-command (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s" - (shell-quote-argument (concat "pass:" org-mobile-encryption-password)) + (shell-quote-argument (concat "pass:" + (org-mobile-encryption-password))) (shell-quote-argument (expand-file-name infile)) (shell-quote-argument (expand-file-name outfile))))) +(defun org-mobile-cleanup-encryption-tempfile () + "Remove the encryption tempfile if it exists." + (and (stringp org-mobile-encryption-tempfile) + (file-exists-p org-mobile-encryption-tempfile) + (delete-file org-mobile-encryption-tempfile))) + (defun org-mobile-move-capture () "Move the contents of the capture file to the inbox file. Return a marker to the location where the new content has been added. @@ -673,7 +731,7 @@ (capture-buffer (if (not org-mobile-use-encryption) (find-file-noselect capture-file) - (delete-file org-mobile-encryption-tempfile) + (org-mobile-cleanup-encryption-tempfile) (setq encfile (concat org-mobile-encryption-tempfile "_enc")) (copy-file capture-file encfile) (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile) @@ -698,7 +756,8 @@ (kill-buffer capture-buffer) (when org-mobile-use-encryption (org-mobile-encrypt-and-move org-mobile-encryption-tempfile - capture-file)) + capture-file) + (org-mobile-cleanup-encryption-tempfile)) (if not-empty insertion-point))) (defun org-mobile-update-checksum-for-capture-file (buffer-string)
--- a/lisp/org/org-mouse.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-mouse.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,10 +1,11 @@ ;;; org-mouse.el --- Better mouse support for org-mode -;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -148,6 +149,7 @@ (declare-function org-agenda-change-all-lines "org-agenda" (newhead hdmarker &optional fixface just-this)) (declare-function org-verify-change-for-undo "org-agenda" (l1 l2)) +(declare-function org-apply-on-list "org-list" (function init-value &rest args)) (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " "Regular expression that matches a plain list.") @@ -576,14 +578,11 @@ (goto-char (second contextdata)) (re-search-forward ".*" (third contextdata)))))) -(defun org-mouse-for-each-item (function) - (save-excursion - (ignore-errors - (while t (org-previous-item))) - (ignore-errors - (while t - (funcall function) - (org-next-item))))) +(defun org-mouse-for-each-item (funct) + ;; Functions called by `org-apply-on-list' need an argument + (let ((wrap-fun (lambda (c) (funcall funct)))) + (when (org-in-item-p) + (org-apply-on-list wrap-fun nil)))) (defun org-mouse-bolp () "Return true if there only spaces, tabs, and '*' before point.
--- a/lisp/org/org-plot.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-plot.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-protocol.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-protocol.el Wed Nov 17 13:09:08 2010 +0900 @@ -9,7 +9,7 @@ ;; Author: Ross Patterson <me AT rpatterson DOT net> ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> ;; Keywords: org, emacsclient, wp -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. ;; @@ -260,7 +260,7 @@ :group 'org-protocol :type '(alist)) -(defcustom org-protocol-default-template-key "w" +(defcustom org-protocol-default-template-key nil "The default org-remember-templates key to use." :group 'org-protocol :type 'string)
--- a/lisp/org/org-publish.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-publish.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 7.01 +;; Version: 7.3 ;; This file is part of GNU Emacs. ;; @@ -71,11 +71,14 @@ each element is a string, uniquely identifying the project. The CDR of each element is in one of the following forms: - (:property value :property value ... ) +1. A well-formed property list with an even number of elements, alternating + keys and values, specifying parameters for the publishing process. -OR, + (:property value :property value ... ) - (:components (\"project-1\" \"project-2\" ...)) +2. A meta-project definition, specifying of a list of sub-projects: + + (:components (\"project-1\" \"project-2\" ...)) When the CDR of an element of org-publish-project-alist is in this second form, the elements of the list after :components are @@ -92,7 +95,8 @@ :base-directory Directory containing publishing source files :base-extension Extension (without the dot!) of source files. - This can be a regular expression. + This can be a regular expression. If not given, + \"org\" will be used as default extension. :publishing-directory Directory (possibly remote) where output files will be published @@ -188,7 +192,14 @@ The following properties control the creation of a concept index. - :makeindex Create a concept index." + :makeindex Create a concept index. + +Other properties affecting publication. + + :body-only Set this to 't' to publish only the body of the + documents, excluding everything outside and + including the <body> tags in HTML, or + \begin{document}..\end{document} in LaTeX." :group 'org-publish :type 'alist) @@ -464,13 +475,19 @@ (unless (plist-get (cdr prj) :components) ;; [[info:org:Selecting%20files]] shows how this is supposed to work: (let* ((r (plist-get (cdr prj) :recursive)) - (b (expand-file-name (plist-get (cdr prj) :base-directory))) + (b (expand-file-name (file-name-as-directory + (plist-get (cdr prj) :base-directory)))) (x (or (plist-get (cdr prj) :base-extension) "org")) (e (plist-get (cdr prj) :exclude)) (i (plist-get (cdr prj) :include)) (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) (when (or - (and i (string-match i filename)) + (and + i + (member filename + (mapcar + (lambda (file) (expand-file-name file b)) + i))) (and (not (and e (string-match e filename))) (string-match xm filename))) @@ -507,7 +524,9 @@ (setq export-buf-or-file (funcall (intern (concat "org-export-as-" format)) (plist-get plist :headline-levels) - nil plist nil nil pub-dir)) + nil plist nil + (plist-get plist :body-only) + pub-dir)) (when (and (bufferp export-buf-or-file) (buffer-live-p export-buf-or-file)) (set-buffer export-buf-or-file) @@ -558,14 +577,32 @@ See `org-publish-org-to' to the list of arguments." (org-publish-org-to "org" plist filename pub-dir)) +(defun org-publish-org-to-ascii (plist filename pub-dir) + "Publish an org file to ASCII. +See `org-publish-org-to' to the list of arguments." + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "ascii" plist filename pub-dir))) + +(defun org-publish-org-to-latin1 (plist filename pub-dir) + "Publish an org file to Latin-1. +See `org-publish-org-to' to the list of arguments." + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "latin1" plist filename pub-dir))) + +(defun org-publish-org-to-utf8 (plist filename pub-dir) + "Publish an org file to UTF-8. +See `org-publish-org-to' to the list of arguments." + (org-publish-with-aux-preprocess-maybe + (org-publish-org-to "utf8" plist filename pub-dir))) + (defun org-publish-attachment (plist filename pub-dir) "Publish a file with no transformation of any kind. See `org-publish-org-to' to the list of arguments." ;; make sure eshell/cp code is loaded - (unless (file-directory-p pub-dir) - (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) + (unless (file-directory-p pub-dir) + (make-directory pub-dir t)) + (or (equal (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) (copy-file filename (expand-file-name (file-name-nondirectory filename) pub-dir) t))) @@ -585,14 +622,22 @@ (error "File %s not part of any known project" (abbreviate-file-name filename))))) (project-plist (cdr project)) - (ftname (file-truename filename)) + (ftname (expand-file-name filename)) (publishing-function (or (plist-get project-plist :publishing-function) 'org-publish-org-to-html)) - (base-dir (file-name-as-directory - (file-truename (plist-get project-plist :base-directory)))) - (pub-dir (file-name-as-directory - (file-truename (plist-get project-plist :publishing-directory)))) + (base-dir + (file-name-as-directory + (expand-file-name + (or (plist-get project-plist :base-directory) + (error "Project %s does not have :base-directory defined" + (car project)))))) + (pub-dir + (file-name-as-directory + (file-truename + (or (plist-get project-plist :publishing-directory) + (error "Project %s does not have :publishing-directory defined" + (car project)))))) tmp-pub-dir) (unless no-cache @@ -770,7 +815,6 @@ (interactive "P") (when force (org-publish-remove-all-timestamps)) - ;; (org-publish-initialize-files-alist force) (save-window-excursion (let ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag)))
--- a/lisp/org/org-remember.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-remember.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -157,7 +157,7 @@ Apart from these general escapes, you can access information specific to the link type that is created. For example, calling `remember' in emails or gnus will record the author and the subject of the message, which you can access -with %:author and %:subject, respectively. Here is a complete list of what +with %:fromname and %:subject, respectively. Here is a complete list of what is recorded for each link type. Link type | Available information @@ -167,7 +167,8 @@ | %:from %:fromname %:fromaddress | %:to %:toname %:toaddress | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields +gnus | %:group, for messages also all email fields and + | %:org-date (the Date: header in Org format) w3, w3m | %:type %:url info | %:type %:file %:node calendar | %:type %:date" @@ -574,7 +575,7 @@ 'org-tags-completion-function nil nil nil 'org-tags-history))) (setq ins (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]_@]+")) + (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) ":")) (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":"))
--- a/lisp/org/org-rmail.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-rmail.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -59,10 +59,20 @@ (from (mail-fetch-field "from")) (to (mail-fetch-field "to")) (subject (mail-fetch-field "subject")) + (date (mail-fetch-field "date")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) desc link) (org-store-link-props :type "rmail" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq desc (org-email-link-description)) (setq link (org-make-link "rmail:" folder "#" message-id))
--- a/lisp/org/org-src.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-src.el Wed Nov 17 13:09:08 2010 +0900 @@ -8,7 +8,7 @@ ;; Dan Davison <davison at stats dot ox dot ac dot uk> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -34,6 +34,8 @@ (require 'org-macs) (require 'org-compat) +(require 'ob-keys) +(require 'ob-comint) (eval-when-compile (require 'cl)) @@ -107,6 +109,10 @@ :group 'org-edit-structure :type 'integer) +(defvar org-src-strip-leading-and-trailing-blank-lines nil + "If non-nil, blank lines are removed when exiting the code edit +buffer.") + (defcustom org-edit-src-persistent-message t "Non-nil means show persistent exit help message while editing src examples. The message is shown in the header-line, which will be created in the @@ -147,7 +153,8 @@ (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) - ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)) + ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) + ("calc" . fundamental)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should be inserted as the name of the major mode. For many languages this is @@ -165,6 +172,7 @@ (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) + (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) (defvar org-edit-src-allow-write-back-p t) @@ -181,6 +189,8 @@ immediately; otherwise it will ask whether you want to return to the existing edit buffer.") +(defvar org-src-babel-info nil) + (define-minor-mode org-src-mode "Minor mode for language major mode buffers generated by org. This minor mode is turned on in two situations: @@ -189,26 +199,30 @@ There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") -(defun org-edit-src-code (&optional context code edit-buffer-name) +(defun org-edit-src-code (&optional context code edit-buffer-name quietp) "Edit the source code example at point. -The example is copied to a separate buffer, and that buffer is switched -to the correct language mode. When done, exit with \\[org-edit-src-exit]. -This will remove the original code in the Org buffer, and replace it with -the edited version. Optional argument CONTEXT is used by -\\[org-edit-src-save] when calling this function." +The example is copied to a separate buffer, and that buffer is +switched to the correct language mode. When done, exit with +\\[org-edit-src-exit]. This will remove the original code in the +Org buffer, and replace it with the edited version. Optional +argument CONTEXT is used by \\[org-edit-src-save] when calling +this function. See \\[org-src-window-setup] to configure the +display of windows containing the Org buffer and the code +buffer." (interactive) (unless (eq context 'save) (setq org-edit-src-saved-temp-window-config (current-window-configuration))) - (let ((line (org-current-line)) - (col (current-column)) + (let ((mark (and (org-region-active-p) (mark))) (case-fold-search t) (info (org-edit-src-find-region-and-lang)) + (babel-info (org-babel-get-src-block-info 'light)) (org-mode-p (eq major-mode 'org-mode)) (beg (make-marker)) (end (make-marker)) (preserve-indentation org-src-preserve-indentation) (allow-write-back-p (null code)) - block-nindent total-nindent ovl lang lang-f single lfmt begline buffer msg) + block-nindent total-nindent ovl lang lang-f single lfmt buffer msg + begline markline markcol line col) (if (not info) nil (setq beg (move-marker beg (nth 0 info)) @@ -226,6 +240,10 @@ block-nindent (nth 5 info) lang-f (intern (concat lang "-mode")) begline (save-excursion (goto-char beg) (org-current-line))) + (if (and mark (>= mark beg) (<= mark end)) + (save-excursion (goto-char mark) + (setq markline (org-current-line) + markcol (current-column)))) (if (equal lang-f 'table.el-mode) (setq lang-f (lambda () (text-mode) @@ -235,7 +253,10 @@ (org-set-local 'org-edit-src-content-indentation 0)))) (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) - (org-goto-line line) + (save-excursion + (if (> (point) end) (goto-char end)) + (setq line (org-current-line) + col (current-column))) (if (and (setq buffer (org-edit-src-find-buffer beg end)) (if org-src-ask-before-returning-to-edit-buffer (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t)) @@ -267,11 +288,16 @@ (unless preserve-indentation (setq total-nindent (or (org-do-remove-indentation) 0))) (let ((org-inhibit-startup t)) - (funcall lang-f)) + (condition-case e + (funcall lang-f) + (error + (error "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) (set (make-local-variable 'org-edit-src-force-single-line) single) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p) (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation) + (when babel-info + (set (make-local-variable 'org-src-babel-info) babel-info)) (when lfmt (set (make-local-variable 'org-coderef-label-format) lfmt)) (when org-mode-p @@ -279,6 +305,12 @@ (while (re-search-forward "^," nil t) (if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent))) (replace-match ""))) + (when markline + (org-goto-line (1+ (- markline begline))) + (org-move-to-column + (if preserve-indentation markcol (max 0 (- markcol total-nindent)))) + (push-mark (point) 'no-message t) + (setq deactivate-mark nil)) (org-goto-line (1+ (- line begline))) (org-move-to-column (if preserve-indentation col (max 0 (- col total-nindent)))) @@ -290,7 +322,7 @@ (set-buffer-modified-p nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg))) - (message "%s" msg) + (unless quietp (message "%s" msg)) t))) (defun org-edit-src-continue (e) @@ -321,6 +353,8 @@ (if (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (if (eq context 'exit) (delete-other-windows))) + ('switch-invisibly + (set-buffer buffer)) (t (message "Invalid value %s for org-src-window-setup" (symbol-name org-src-window-setup)) @@ -552,11 +586,12 @@ (delta 0) code line col indent) (when allow-write-back-p (unless preserve-indentation (untabify (point-min) (point-max))) - (save-excursion - (goto-char (point-min)) - (if (looking-at "[ \t\n]*\n") (replace-match "")) - (unless macro - (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))) + (if org-src-strip-leading-and-trailing-blank-lines + (save-excursion + (goto-char (point-min)) + (if (looking-at "[ \t\n]*\n") (replace-match "")) + (unless macro + (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))))) (setq line (if (org-bound-and-true-p org-edit-src-force-single-line) 1 (org-current-line)) @@ -654,6 +689,122 @@ (org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) + +(defun org-src-associate-babel-session (info) + "Associate edit buffer with comint session." + (interactive) + (let ((session (cdr (assoc :session (nth 2 info))))) + (and session (not (string= session "none")) + (org-babel-comint-buffer-livep session) + ((lambda (f) (and (fboundp f) (funcall f session))) + (intern (format "org-babel-%s-associate-session" (nth 0 info))))))) + +(defun org-src-babel-configure-edit-buffer () + (when org-src-babel-info + (org-src-associate-babel-session org-src-babel-info))) + +(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer) +(defmacro org-src-do-at-code-block (&rest body) + "Execute a command from an edit buffer in the Org-mode buffer." + `(let ((beg-marker org-edit-src-beg-marker)) + (if beg-marker + (with-current-buffer (marker-buffer beg-marker) + (goto-char (marker-position beg-marker)) + ,@body)))) + +(defun org-src-do-key-sequence-at-code-block (&optional key) + "Execute key sequence at code block in the source Org buffer. +The command bound to KEY in the Org-babel key map is executed +remotely with point temporarily at the start of the code block in +the Org buffer. + +This command is not bound to a key by default, to avoid conflicts +with language major mode bindings. To bind it to C-c @ in all +language major modes, you could use + + (add-hook 'org-src-mode-hook + (lambda () (define-key org-src-mode-map \"\\C-c@\" + 'org-src-do-key-sequence-at-code-block))) + +In that case, for example, C-c @ t issued in code edit buffers +would tangle the current Org code block, C-c @ e would execute +the block and C-c @ h would display the other available +Org-babel commands." + (interactive "kOrg-babel key: ") + (if (equal key (kbd "C-g")) (keyboard-quit) + (org-edit-src-save) + (org-src-do-at-code-block + (call-interactively + (lookup-key org-babel-map key))))) + +(defcustom org-src-tab-acts-natively nil + "If non-nil, the effect of TAB in a code block is as if it were +issued in the language major mode buffer." + :type 'boolean + :group 'org-babel) + +(defun org-src-native-tab-command-maybe () + "Perform language-specific TAB action. +Alter code block according to effect of TAB in the language major +mode." + (and org-src-tab-acts-natively + (let ((org-src-strip-leading-and-trailing-blank-lines nil)) + (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))) + +(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe) + +(defun org-src-font-lock-fontify-block (lang start end) + "Fontify code block. +This function is called by emacs automatic fontification, as long +as `org-src-fontify-natively' is non-nil. For manual +fontification of code blocks see `org-src-fontify-block' and +`org-src-fontify-buffer'" + (let* ((lang-mode (org-src-get-lang-mode lang)) + (string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (org-buffer (current-buffer)) pos next) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (concat " org-src-fontification:" (symbol-name lang-mode))) + (delete-region (point-min) (point-max)) + (insert string) + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (font-lock-fontify-buffer) + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'face)) + (put-text-property + (+ start (1- pos)) (+ start next) 'face + (get-text-property pos 'face) org-buffer) + (setq pos next))) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified)) + t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified + +(defun org-src-fontify-block () + "Fontify code block at point." + (interactive) + (save-excursion + (let ((org-src-fontify-natively t) + (info (org-edit-src-find-region-and-lang))) + (font-lock-fontify-region (nth 0 info) (nth 1 info))))) + +(defun org-src-fontify-buffer () + "Fontify all code blocks in the current buffer" + (interactive) + (org-babel-map-src-blocks nil + (org-src-fontify-block))) + +(defun org-src-get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (intern + (concat + ((lambda (l) (if (symbolp l) (symbol-name l) l)) + (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode"))) + (provide 'org-src) ;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8
--- a/lisp/org/org-table.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-table.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -342,17 +342,21 @@ (defun org-table-cookie-line-p (line) "Is this a table line with only alignment/width cookies?" - (save-match-data (and (string-match "[<>]\\|&[lg]t;" line) - (or (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" line) - (string-match "\\(\\`[ \t<>lr0-9|gt&;]+\\'\\)" line)) + (or (string-match + "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line) + (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line)) (not (delq nil (mapcar (lambda (s) (not (or (equal s "") - (string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s) - (string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s)))) - (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) + (string-match + "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s) + (string-match + "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" + s)))) + (org-split-string (match-string 1 line) + "[ \t]*|[ \t]*"))))))) (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") @@ -369,8 +373,9 @@ (if (y-or-n-p "Convert table to Org-mode table? ") (org-table-convert))) ((org-at-table-p) - (if (y-or-n-p "Convert table to table.el table? ") - (org-table-convert))) + (when (y-or-n-p "Convert table to table.el table? ") + (org-table-align) + (org-table-convert))) (t (call-interactively 'table-insert)))) (defun org-table-create-or-convert-from-region (arg) @@ -453,7 +458,7 @@ (t 1)))) (goto-char beg) (if (equal separator '(4)) - (while (<= (point) end) + (while (< (point) end) ;; parse the csv stuff (cond ((looking-at "^") (insert "| ")) @@ -656,9 +661,9 @@ (goto-char beg) (setq narrow (and org-table-do-narrow org-format-transports-properties-p - (re-search-forward "<[rl]?[0-9]+>" end t))) + (re-search-forward "<[lrc]?[0-9]+>" end t))) (goto-char beg) - (setq falign (re-search-forward "<[rl][0-9]*>" end t)) + (setq falign (re-search-forward "<[lrc][0-9]*>" end t)) (goto-char beg) ;; Get the rows (setq lines (org-split-string @@ -699,7 +704,7 @@ (setq c column fmax nil falign1 nil) (while c (setq e (pop c)) - (when (and (stringp e) (string-match "^<\\([rl]\\)?\\([0-9]+\\)?>$" e)) + (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e)) (if (match-end 1) (setq falign1 (match-string 1 e))) (if (and org-table-do-narrow (match-end 2)) (setq fmax (string-to-number (match-string 2 e)) c nil)))) @@ -1150,11 +1155,14 @@ (defun org-table-current-column () "Find out which column we are in." + (interactive) + (if (interactive-p) (org-table-check-inside-data-field)) (save-excursion (let ((cnt 0) (pos (point))) (beginning-of-line 1) (while (search-forward "|" pos t) (setq cnt (1+ cnt))) + (if (interactive-p) (message "In table column %d" cnt)) cnt))) (defun org-table-current-dline () @@ -4254,7 +4262,7 @@ (lambda (x) (if (eq x 'hline) "|----+----|" - (concat "| " (mapconcat 'identity x " | ") " |"))) + (concat "| " (mapconcat 'org-html-expand x " | ") " |"))) table) splicep)) (if (string-match "\n+\\'" html)
--- a/lisp/org/org-taskjuggler.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-taskjuggler.el Wed Nov 17 13:09:08 2010 +0900 @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-taskjuggler.el -;; Version: 7.01 +;; Version: 7.3 ;; Author: Christian Egli ;; Maintainer: Christian Egli ;; Keywords: org, taskjuggler, project planning @@ -503,7 +503,7 @@ (parts (split-string headline)) (id (org-taskjuggler-clean-id (downcase (pop parts))))) ; try to add more parts of the headline to make it unique - (while (member id unique-ids) + (while (and (member id unique-ids) (car parts)) (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts)))))) ; if its still not unique add "_" (while (member id unique-ids)
--- a/lisp/org/org-timer.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-timer.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -31,7 +31,7 @@ (require 'org) -(declare-function org-show-notification "org-clock" (parameters)) +(declare-function org-notify "org-clock" (notification &optional play-sound)) (declare-function org-agenda-error "org-agenda" ()) (defvar org-timer-start-time nil @@ -145,25 +145,33 @@ (org-timer-set-mode-line 'off)) ;;;###autoload -(defun org-timer (&optional restart) +(defun org-timer (&optional restart no-insert-p) "Insert a H:MM:SS string from the timer into the buffer. The first time this command is used, the timer is started. When used with a \\[universal-argument] prefix, force restarting the timer. -When used with a double prefix argument \ -\\[universal-argument] \\universal-argument], change all the timer string +When used with a double prefix argument \\[universal-argument], change all the timer string in the region by a fixed amount. This can be used to recalibrate a timer -that was not started at the correct moment." +that was not started at the correct moment. + +If NO-INSERT-P is non-nil, return the string instead of inserting +it in the buffer." (interactive "P") - (if (equal restart '(4)) (org-timer-start)) - (or org-timer-start-time (org-timer-start)) - (insert (org-timer-value-string))) + (when (or (equal restart '(4)) (not org-timer-start-time)) + (org-timer-start)) + (if no-insert-p + (org-timer-value-string) + (insert (org-timer-value-string)))) (defun org-timer-value-string () (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds))))) +(defvar org-timer-timer-is-countdown nil) (defun org-timer-seconds () - (- (org-float-time (or org-timer-pause-time (current-time))) - (org-float-time org-timer-start-time))) + (if org-timer-timer-is-countdown + (- (org-float-time org-timer-start-time) + (org-float-time (current-time))) + (- (org-float-time (or org-timer-pause-time (current-time))) + (org-float-time org-timer-start-time)))) ;;;###autoload (defun org-timer-change-times-in-region (beg end delta) @@ -195,19 +203,22 @@ (defun org-timer-item (&optional arg) "Insert a description-type item with the current timer value." (interactive "P") - (let ((ind 0)) - (save-excursion - (skip-chars-backward " \n\t") - (condition-case nil - (progn - (org-beginning-of-item) - (setq ind (org-get-indentation))) - (error nil))) - (or (bolp) (newline)) - (org-indent-line-to ind) - (insert "- ") - (org-timer (if arg '(4))) - (insert ":: "))) + (cond + ;; In a timer list, insert with `org-list-insert-item-generic'. + ((and (org-in-item-p) + (save-excursion (org-beginning-of-item) (org-at-item-timer-p))) + (org-list-insert-item-generic + (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) + ;; In a list of another type, don't break anything: throw an error. + ((org-in-item-p) + (error "This is not a timer list")) + ;; Else, insert the timer correctly indented at bol. + (t + (beginning-of-line) + (org-indent-line-function) + (insert "- ") + (org-timer (when arg '(4))) + (insert ":: ")))) (defun org-timer-fix-incomplete (hms) "If hms is a H:MM:SS string with missing hour or hour and minute, fix it." @@ -292,7 +303,9 @@ (when (eval org-timer-current-timer) (run-hooks 'org-timer-cancel-hook) (cancel-timer org-timer-current-timer) - (setq org-timer-current-timer nil)) + (setq org-timer-current-timer nil) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off)) (message "Last timer canceled")) (defun org-timer-show-remaining-time () @@ -309,17 +322,13 @@ (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) -(defun bzg-test (&optional test) - (interactive "P") - test) - ;;;###autoload (defun org-timer-set-timer (&optional opt) "Prompt for a duration and set a timer. If `org-timer-default-timer' is not zero, suggest this value as the default duration for the timer. If a timer is already set, -prompt the use if she wants to replace it. +prompt the user if she wants to replace it. Called with a numeric prefix argument, use this numeric value as the duration of the timer. @@ -353,9 +362,11 @@ (widen) (goto-char pos) (org-show-entry) - (org-get-heading)))) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))))) ((eq major-mode 'org-mode) - (org-get-heading)) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))) (t (error "Not in an Org buffer")))) timer-set) (if (or (and org-timer-current-timer @@ -363,6 +374,7 @@ (y-or-n-p "Replace current timer? "))) (not org-timer-current-timer)) (progn + (require 'org-clock) (when org-timer-current-timer (cancel-timer org-timer-current-timer)) (setq org-timer-current-timer @@ -370,8 +382,14 @@ secs nil `(lambda () (setq org-timer-current-timer nil) (org-notify ,(format "%s: time out" hl) t) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off) (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook)) + (run-hooks 'org-timer-set-hook) + (setq org-timer-timer-is-countdown t + org-timer-start-time + (time-add (current-time) (seconds-to-time (* mins 60)))) + (org-timer-set-mode-line 'on)) (message "No timer set")))))) (provide 'org-timer)
--- a/lisp/org/org-vm.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-vm.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -66,9 +66,19 @@ (to (vm-get-header-contents message "To")) (from (vm-get-header-contents message "From")) (message-id (vm-su-message-id message)) + (date (vm-get-header-contents message "Date")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) desc link) (org-store-link-props :type "vm" :from from :to to :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (setq message-id (org-remove-angle-brackets message-id)) (setq folder (abbreviate-file-name folder)) (if (and vm-folder-directory
--- a/lisp/org/org-w3m.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-w3m.el Wed Nov 17 13:09:08 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org-wl.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-wl.el Wed Nov 17 13:09:08 2010 +0900 @@ -7,7 +7,7 @@ ;; David Maus <dmaus at ictsoc dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -84,6 +84,8 @@ (declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t) (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) +(declare-function wl-summary-jump-to-msg "ext:wl-summary" + (&optional number beg end)) (declare-function wl-summary-line-from "ext:wl-summary" ()) (declare-function wl-summary-line-subject "ext:wl-summary" ()) (declare-function wl-summary-message-number "ext:wl-summary" ()) @@ -100,6 +102,7 @@ (defvar wl-summary-buffer-folder-name) (defvar wl-folder-group-regexp) (defvar wl-auto-check-folder-name) +(defvar elmo-nntp-default-server) (defconst org-wl-folder-types '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool) @@ -137,18 +140,19 @@ "Return content of FIELD in ENTITY. FIELD is a symbol of a rfc822 message header field. ENTITY is a message entity." - (let ((content (elmo-message-entity-field entity field))) + (let ((content (elmo-message-entity-field entity field 'string))) (if (listp content) (car content) content))) (defun org-wl-store-link () "Store a link to a WL message or folder." - (cond - ((memq major-mode '(wl-summary-mode mime-view-mode)) - (org-wl-store-link-message)) - ((eq major-mode 'wl-folder-mode) - (org-wl-store-link-folder)) - (t - nil))) + (unless (eobp) + (cond + ((memq major-mode '(wl-summary-mode mime-view-mode)) + (org-wl-store-link-message)) + ((eq major-mode 'wl-folder-mode) + (org-wl-store-link-folder)) + (t + nil)))) (defun org-wl-store-link-folder () "Store a link to a WL folder." @@ -189,10 +193,19 @@ msgnum (wl-summary-buffer-msgdb)))) (message-id (org-wl-message-field 'message-id wl-message-entity)) + (message-id-no-brackets + (org-remove-angle-brackets message-id)) (from (org-wl-message-field 'from wl-message-entity)) (to (org-wl-message-field 'to wl-message-entity)) (xref (org-wl-message-field 'xref wl-message-entity)) (subject (org-wl-message-field 'subject wl-message-entity)) + (date (org-wl-message-field 'date wl-message-entity)) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) desc link) ;; remove text properties of subject string to avoid possible bug @@ -212,6 +225,7 @@ org-wl-shimbun-prefer-web-links xref) (org-store-link-props :type "http" :link xref :description subject :from from :to to :message-id message-id + :message-id-no-brackets message-id-no-brackets :subject subject)) ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) (setq link @@ -222,16 +236,35 @@ (org-fixup-message-id-for-http message-id))) (org-store-link-props :type "http" :link link :description subject :from from :to to :message-id message-id + :message-id-no-brackets message-id-no-brackets :subject subject)) (t (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) + :subject subject :message-id message-id + :message-id-no-brackets message-id-no-brackets) (setq desc (org-email-link-description)) - (setq link (org-make-link "wl:" folder-name "#" message-id)) + (setq link (org-make-link "wl:" folder-name "#" message-id-no-brackets)) (org-add-link-props :link link :description desc))) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) (or link xref))))))) +(defun org-wl-open-nntp (path) + "Follow the nntp: link specified by PATH." + (let* ((spec (split-string path "/")) + (server (split-string (nth 2 spec) "@")) + (group (nth 3 spec)) + (article (nth 4 spec))) + (org-wl-open + (concat "-" group ":" (if (cdr server) + (car (split-string (car server) ":")) + "") + (if (string= elmo-nntp-default-server (nth 2 spec)) + "" + (concat "@" (or (cdr server) (car server)))) + (if article (concat "#" article) ""))))) + (defun org-wl-open (path) "Follow the WL message link specified by PATH. When called with one prefix, open message in namazu search folder @@ -267,8 +300,12 @@ ;; beginning of the current line. So, restore the point ;; in the old buffer. (goto-char old-point)) - (and article (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets - article)) + (when article + (if (org-string-match-p "@" article) + (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets + article)) + (or (wl-summary-jump-to-msg (string-to-number article)) + (error "No such message: %s" article))) (wl-summary-redisplay)))))) (provide 'org-wl)
--- a/lisp/org/org-xoxo.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org-xoxo.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;;
--- a/lisp/org/org.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/org/org.el Wed Nov 17 13:09:08 2010 +0900 @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.01 +;; Version: 7.3 ;; ;; This file is part of GNU Emacs. ;; @@ -86,10 +86,6 @@ (unless (boundp 'diary-fancy-buffer) (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) -;; For XEmacs, noutline is not yet provided by outline.el, so arrange for -;; the file noutline.el being loaded. -(if (featurep 'xemacs) (condition-case nil (require 'noutline))) -;; We require noutline, which might be provided in outline.el (require 'outline) (require 'noutline) ;; Other stuff we need. (require 'time-date) @@ -151,6 +147,7 @@ (const :tag "C" C) (const :tag "R" R) (const :tag "Asymptote" asymptote) + (const :tag "Calc" calc) (const :tag "Clojure" clojure) (const :tag "CSS" css) (const :tag "Ditaa" ditaa) @@ -158,15 +155,20 @@ (const :tag "Emacs Lisp" emacs-lisp) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) + (const :tag "Javascript" js) (const :tag "Latex" latex) + (const :tag "Ledger" ledger) (const :tag "Matlab" matlab) (const :tag "Mscgen" mscgen) (const :tag "Ocaml" ocaml) (const :tag "Octave" octave) + (const :tag "Org" org) (const :tag "Perl" perl) + (const :tag "PlantUML" plantuml) (const :tag "Python" python) (const :tag "Ruby" ruby) (const :tag "Sass" sass) + (const :tag "Scheme" scheme) (const :tag "Screen" screen) (const :tag "Shell Script" sh) (const :tag "Sql" sql) @@ -184,7 +186,7 @@ ;;; Version -(defconst org-version "7.01" +(defconst org-version "7.3" "The version number of the file org.el.") (defun org-version (&optional here) @@ -295,6 +297,7 @@ (const :tag " wl: Links to Wanderlust folders/messages" org-wl) (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) (const :tag " mouse: Additional mouse support" org-mouse) + (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) @@ -328,7 +331,8 @@ (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) (const :tag "C track: Keep up with Org-mode development" org-track) - (const :tag "C TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) + (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) + (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) (defcustom org-support-shift-select nil @@ -468,6 +472,15 @@ :group 'org-startup :type 'boolean) +(defcustom org-startup-with-inline-images nil + "Non-nil means show inline images when loading a new Org file. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: inlineimages + #+STARTUP: noinlineimages" + :group 'org-startup + :type 'boolean) + (defcustom org-insert-mode-line-in-empty-file nil "Non-nil means insert the first line setting Org-mode in empty files. When the function `org-mode' is called interactively in an empty file, this @@ -1064,9 +1077,13 @@ (plain-list-item . auto)) "Should `org-insert-heading' leave a blank line before new heading/item? The value is an alist, with `heading' and `plain-list-item' as car, -and a boolean flag as cdr. For plain lists, if the variable -`org-empty-line-terminates-plain-lists' is set, the setting here -is ignored and no empty line is inserted, to keep the list in tact." +and a boolean flag as cdr. The cdr may lso be the symbol `auto', and then +Org will look at the surrounding headings/items and try to make an +intelligent decision wether to insert a blank line or not. + +For plain lists, if the variable `org-empty-line-terminates-plain-lists' is +set, the setting here is ignored and no empty line is inserted, to avoid +breaking the list structure." :group 'org-edit-structure :type '(list (cons (const heading) @@ -1258,7 +1275,7 @@ be a small gain when turning off unused link types. The types are: bracket The recommended [[link][description]] or [[link]] links with hiding. -angular Links in angular brackets that may contain whitespace like +angle Links in angular brackets that may contain whitespace like <bbdb:Carsten Dominik>. plain Plain links in normal text, no whitespace, like http://google.com. radio Text that is matched by a radio target, see manual for details. @@ -1269,8 +1286,8 @@ Changing this variable requires a restart of Emacs to become effective." :group 'org-link :type '(set :greedy t - (const :tag "Double bracket links (new style)" bracket) - (const :tag "Angular bracket links (old style)" angular) + (const :tag "Double bracket links" bracket) + (const :tag "Angular bracket links" angle) (const :tag "Plain text links" plain) (const :tag "Radio target matches" radio) (const :tag "Tags" tag) @@ -1437,6 +1454,17 @@ :group 'org-link-follow :type 'integer) +(defcustom org-link-search-must-match-exact-headline 'query-to-create + "Non-nil means internal links in Org files must exactly match a headline. +When nil, the link search tries to match a phrase will all words +in the search text." + :group 'org-link-follow + :type '(choice + (const :tag "Use fuzy text search" nil) + (const :tag "Match only exact headline" t) + (const :tag "Match extact headline or query to create it" + query-to-create))) + (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) (gnus . org-gnus-no-new-news) @@ -1797,8 +1825,8 @@ - a specification of the files to be considered, either a list of files, or a symbol whose function or variable value will be used to retrieve a file name or a list of file names. If you use `org-agenda-files' for - that, all agenda files will be scanned for targets. The value nil means - consider headings in the current buffer. + that, all agenda files will be scanned for targets. Nil means consider + headings in the current buffer. - A specification of how to find candidate refile targets. This may be any of: - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. @@ -2568,13 +2596,28 @@ Currently none of this works for ISO week specifications. When this option is nil, the current day, month and year will always be -used as defaults." +used as defaults. + +See also `org-agenda-jump-prefer-future'." :group 'org-time :type '(choice (const :tag "Never" nil) (const :tag "Check month and day" t) (const :tag "Check month, day, and time" time))) +(defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future + "Should the agenda jump command prefer the future for incomplete dates? +The default is to do the same as configured in `org-read-date-prefer-future'. +But you can alse set a deviating value here. +This may t or nil, or the symbol `org-read-date-prefer-future'." + :group 'org-agenda + :group 'org-time + :type '(choice + (const :tag "Use org-aread-date-prefer-future" + org-read-date-prefer-future) + (const :tag "Never" nil) + (const :tag "Always" t))) + (defcustom org-read-date-display-live t "Non-nil means display current interpretation of date prompt live. This display will be in an overlay, in the minibuffer." @@ -3074,15 +3117,15 @@ (defcustom org-format-latex-options '(:foreground default :background default :scale 1.0 - :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 - :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) + :html-foreground "Black" :html-background "Transparent" + :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) "Options for creating images from LaTeX fragments. This is a property list with the following properties: :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". `default' means use the foreground of the default face. :background the background color, or \"Transparent\". `default' means use the background of the default face. -:scale a scaling factor for the size of the images. +:scale a scaling factor for the size of the images, to get more pixels :html-foreground, :html-background, :html-scale the same numbers for HTML export. :matchers a list indicating which matchers should be used to @@ -3162,7 +3205,6 @@ ("" "float" nil) ("" "wrapfig" nil) ("" "soul" t) - ("" "t1enc" t) ("" "textcomp" t) ("" "marvosym" t) ("" "wasysym" t) @@ -3177,7 +3219,7 @@ The packages in this list are needed by one part or another of Org-mode to function properly. -- inputenc, fontenc, t1enc: for basic font and character selection +- inputenc, fontenc: for basic font and character selection - textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used for interpreting the entities in `org-entities'. You can skip some of these packages if you don't use any of the symbols in it. @@ -3311,6 +3353,8 @@ (defvar org-emph-re nil "Regular expression for matching emphasis. After a match, the match groups contain these elements: +0 The match of the full regular expression, including the characters + before and after the proper match 1 The character before the proper match, or empty at beginning of line 2 The proper match, including the leading and trailing markers 3 The leading marker like * or /, indicating the type of highlighting @@ -3510,6 +3554,7 @@ (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" (&optional end)) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (declare-function org-indent-mode "org-indent" (&optional arg)) (declare-function parse-time-string "parse-time" (string)) (declare-function org-attach-reveal "org-attach" (&optional if-exists)) @@ -3701,7 +3746,6 @@ ;; Autoload org-clock.el - (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) (declare-function org-clock-update-mode-line "org-clock" ()) @@ -3991,7 +4035,7 @@ (org-autoload "org-id" '(org-id-get-create org-id-new org-id-copy org-id-get org-id-get-with-outline-path-completion - org-id-get-with-outline-drilling + org-id-get-with-outline-drilling org-id-store-link org-id-goto org-id-find org-id-store-link)) ;; Autoload Plotting Code @@ -4024,7 +4068,11 @@ group 4: True headline group 5: Tags") (make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-complex-heading-regexp-format nil) +(defvar org-complex-heading-regexp-format nil + "Printf format to make regexp to match an exact headline. +This regexp will match the headline of any node which hase the exact +headline text that is put into the format, but may have any TODO state, +priority and tags.") (make-variable-buffer-local 'org-complex-heading-regexp-format) (defvar org-todo-line-tags-regexp nil "Matches a headline and puts TODO state into group 2 if present. @@ -4129,6 +4177,8 @@ ("oddeven" org-odd-levels-only nil) ("align" org-startup-align-all-tables t) ("noalign" org-startup-align-all-tables nil) + ("inlineimages" org-startup-with-inline-images t) + ("noinlineimages" org-startup-with-inline-images nil) ("customtime" org-display-custom-times t) ("logdone" org-log-done time) ("lognotedone" org-log-done note) @@ -4357,7 +4407,7 @@ ((equal e "{") (push '(:startgroup) tgs)) ((equal e "}") (push '(:endgroup) tgs)) ((equal e "\\n") (push '(:newline) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) + ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) (push (cons (match-string 1 e) (string-to-char (match-string 2 e))) tgs)) @@ -4401,7 +4451,7 @@ (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") org-complex-heading-regexp-format (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") @@ -4410,7 +4460,7 @@ "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie "[ \t]*\\(%s\\)" "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?[ \t]*$") org-nl-done-regexp (concat "\n\\*+[ \t]+" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") @@ -4419,7 +4469,7 @@ (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re - "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) + "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:[ \t]*\\)?$\\)")) org-looking-at-done-regexp (concat "^" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" @@ -4699,6 +4749,8 @@ (let ((bmp (buffer-modified-p))) (org-table-map-tables 'org-table-align 'quietly) (set-buffer-modified-p bmp))) + (when org-startup-with-inline-images + (org-display-inline-images)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) @@ -4736,7 +4788,7 @@ (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp" "doi")) + "shell" "elisp" "doi" "message")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil @@ -4837,7 +4889,7 @@ org-plain-link-re (concat "\\<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" - (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) + (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") org-bracket-link-regexp "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" @@ -5003,13 +5055,22 @@ '(display t invisible t intangible t)) t))) +(defcustom org-src-fontify-natively nil + "When non-nil, fontify code in code blocks." + :type 'boolean + :group 'org-appearance + :group 'org-babel) + (defun org-fontify-meta-lines-and-blocks (limit) "Fontify #+ lines and blocks, in the correct ways." (let ((case-fold-search t)) (if (re-search-forward - "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)" + "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" limit t) (let ((beg (match-beginning 0)) + (block-start (match-end 0)) + (block-end nil) + (lang (match-string 7)) (beg1 (line-beginning-position 2)) (dc1 (downcase (match-string 2))) (dc3 (downcase (match-string 3))) @@ -5022,8 +5083,9 @@ '(display t invisible t intangible t)) (add-text-properties (match-beginning 1) (match-end 3) '(font-lock-fontified t face org-meta-line)) - (add-text-properties (match-beginning 6) (match-end 6) + (add-text-properties (match-beginning 6) (+ (match-end 6) 1) '(font-lock-fontified t face org-block)) + ; for backend-specific code t) ((and (match-end 4) (equal dc3 "begin")) ;; Truly a block @@ -5033,6 +5095,7 @@ (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") nil t) ;; on purpose, we look further than LIMIT (setq end (match-end 0) end1 (1- (match-beginning 0))) + (setq block-end (match-beginning 0)) (when quoting (remove-text-properties beg end '(display t invisible t intangible t))) @@ -5040,10 +5103,15 @@ beg end '(font-lock-fontified t font-lock-multiline t)) (add-text-properties beg beg1 '(face org-meta-line)) - (add-text-properties end1 end '(face org-meta-line)) + (add-text-properties end1 (+ end 1) '(face org-meta-line)) + ; for end_src (cond + ((and lang org-src-fontify-natively) + (org-src-font-lock-fontify-block lang block-start block-end)) (quoting - (add-text-properties beg1 end1 '(face org-block))) + (add-text-properties beg1 (+ end1 1) '(face + org-block))) + ; end of source block ((not org-fontify-quote-and-verse-blocks)) ((string= block-type "quote") (add-text-properties beg1 end1 '(face org-quote))) @@ -5329,7 +5397,7 @@ "\\)\\>"))) (defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) + (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t) (progn (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) (add-text-properties (match-beginning 1) (match-end 1) @@ -5360,6 +5428,12 @@ (defvar org-font-lock-hook nil "Functions to be called for special font lock stuff.") +(defvar org-font-lock-set-keywords-hook nil + "Functions that can manipulate `org-font-lock-extra-keywords'. +This is calles after `org-font-lock-extra-keywords' is defined, but before +it is installed to be used by font lock. This can be useful if something +needs to be inserted at a specific position in the font-lock sequence.") + (defun org-font-lock-hook (limit) (run-hook-with-args 'org-font-lock-hook limit)) @@ -5384,7 +5458,7 @@ '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) - '("| *\\(<[lr]?[0-9]*>\\)" (1 'org-formula t)) + '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) ;; Drawers (list org-drawer-regexp '(0 'org-special-keyword t)) (list "^[ \t]*:END:" '(0 'org-special-keyword t)) @@ -5428,13 +5502,13 @@ '(org-do-emphasis-faces (0 nil append)) '(org-do-emphasis-faces))) ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" - 2 'org-checkbox prepend) - (if org-provide-checkbox-statistics + '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" + 1 'org-checkbox prepend) + (if (cdr (assq 'checkbox org-list-automatic-rules)) '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) ;; Description list items - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)" + '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(.*? ::\\)" 2 'bold prepend) ;; ARCHIVEd headings (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") @@ -5454,6 +5528,7 @@ '(org-fontify-meta-lines-and-blocks) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) + (run-hooks 'org-font-lock-set-keywords-hook) ;; Now set the full font-lock-keywords (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) (org-set-local 'font-lock-defaults @@ -5469,7 +5544,7 @@ (message "Entities are displayed as UTF8 characers") (save-restriction (widen) - (decompose-region (point-min) (point-max)) + (org-decompose-region (point-min) (point-max)) (message "Entities are displayed plain")))) (defun org-fontify-entities (limit) @@ -5569,7 +5644,7 @@ (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) - (decompose-region beg end) + (org-decompose-region beg end) (remove-text-properties beg end (if org-indent-mode @@ -5698,7 +5773,8 @@ `org-cycle-emulate-tab' for details. - Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg. + no headline in line 1, this function will act as if called with prefix arg + (C-u TAB, same as S-TAB) also when called without prefix arg. But only if also the variable `org-cycle-global-at-bob' is t." (interactive "P") (org-load-modules-maybe) @@ -5724,7 +5800,7 @@ (if nstars (format "\\{1,%d\\}" nstars) "+") " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)")) (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))) - (bob-special (and org-cycle-global-at-bob (bobp) + (bob-special (and org-cycle-global-at-bob (not arg) (bobp) (not (looking-at outline-regexp)))) (org-cycle-hook (if bob-special @@ -5740,6 +5816,7 @@ (cond ((equal arg '(16)) + (setq last-command 'dummy) (org-set-startup-visibility) (message "Startup visibility, plus VISIBILITY properties")) @@ -5847,7 +5924,6 @@ (defun org-cycle-internal-local () "Do the local cycling action." - (org-back-to-heading) (let ((goal-column 0) eoh eol eos level has-children children-skipped) ;; First, some boundaries (save-excursion @@ -5871,12 +5947,15 @@ (outline-next-heading) (setq has-children (and (org-at-heading-p t) (> (funcall outline-level) level)))) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - ) - (setq eos (if (eobp) (point) (1- (point))))) + ;; if we're in a list, org-end-of-subtree is in fact org-end-of-item. + (if (org-at-item-p) + (setq eos (if (and (org-end-of-item) (bolp)) + (1- (point)) + (point))) + (org-end-of-subtree t) + (unless (eobp) + (skip-chars-forward " \t\n")) + (setq eos (if (eobp) (point) (1- (point)))))) ;; Find out what to do next and set `this-command' (cond ((= eos eoh) @@ -5910,14 +5989,14 @@ ;; We just showed the children, or no children are there, ;; now show everything. (run-hook-with-args 'org-pre-cycle-hook 'subtree) - (org-show-subtree) + (outline-flag-region eoh eos nil) (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) (setq org-cycle-subtree-status 'subtree) (run-hook-with-args 'org-cycle-hook 'subtree)) (t ;; Default action: hide the subtree. (run-hook-with-args 'org-pre-cycle-hook 'folded) - (hide-subtree) + (outline-flag-region eoh eos t) (message "FOLDED") (setq org-cycle-subtree-status 'folded) (run-hook-with-args 'org-cycle-hook 'folded))))) @@ -5961,8 +6040,8 @@ (interactive) (let (org-show-entry-below state) (save-excursion - (goto-char (point-min)) - (while (re-search-forward + (goto-char (point-max)) + (while (re-search-backward "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)" nil t) (setq state (match-string 1)) @@ -6190,6 +6269,42 @@ (beginning-of-line) (recenter (prefix-numeric-value N)))) +;;; Saving and restoring visibility + +(defun org-outline-overlay-data (&optional use-markers) + "Return a list of the locations of all outline overlays. +These are overlays with the `invisible' property value `outline'. +The return value is a list of cons cells, with start and stop +positions for each overlay. +If USE-MARKERS is set, return the positions as markers." + (let (beg end) + (save-excursion + (save-restriction + (widen) + (delq nil + (mapcar (lambda (o) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) + (and beg end (> end beg) + (if use-markers + (cons (move-marker (make-marker) beg) + (move-marker (make-marker) end)) + (cons beg end))))) + (overlays-in (point-min) (point-max)))))))) + +(defun org-set-outline-overlay-data (data) + "Create visibility overlays for all positions in DATA. +DATA should have been made by `org-outline-overlay-data'." + (let (o) + (save-excursion + (save-restriction + (widen) + (show-all) + (mapc (lambda (c) + (setq o (make-overlay (car c) (cdr c))) + (overlay-put o 'invisible 'outline)) + data))))) ;;; Folding of blocks @@ -6360,7 +6475,9 @@ (selected-point (if (eq interface 'outline) (car (org-get-location (current-buffer) org-goto-help)) - (nth 3 (org-refile-get-location "Goto: "))))) + (let ((pa (org-refile-get-location "Goto: "))) + (org-refile-check-position pa) + (nth 3 pa))))) (if selected-point (progn (org-mark-ring-push org-goto-start-pos) @@ -6582,22 +6699,40 @@ "Insert a new heading or item with same depth at point. If point is in a plain list and FORCE-HEADING is nil, create a new list item. If point is at the beginning of a headline, insert a sibling before the -current headline. If point is not at the beginning, do not split the line, -but create the new headline after the current line. +current headline. If point is not at the beginning, split the line, +create the new headline with the text in the current line after point +\(but see also the variable `org-M-RET-may-split-line'). + When INVISIBLE-OK is set, stop at invisible headlines when going back. This is important for non-interactive uses of the command." (interactive "P") (if (or (= (buffer-size) 0) - (and (not (save-excursion (and (ignore-errors (org-back-to-heading invisible-ok)) - (org-on-heading-p)))) + (and (not (save-excursion + (and (ignore-errors (org-back-to-heading invisible-ok)) + (org-on-heading-p)))) (not (org-in-item-p)))) - (insert "\n* ") + (progn + (insert "\n* ") + (run-hooks 'org-insert-heading-hook)) (when (or force-heading (not (org-insert-item))) (let* ((empty-line-p nil) + (level nil) + (on-heading (org-on-heading-p)) (head (save-excursion (condition-case nil (progn (org-back-to-heading invisible-ok) + (when (and (not on-heading) + (featurep 'org-inlinetask) + (integerp org-inlinetask-min-level) + (>= (length (match-string 0)) + org-inlinetask-min-level)) + ;; Find a heading level before the inline task + (while (and (setq level (org-up-heading-safe)) + (>= level org-inlinetask-min-level))) + (if (org-on-heading-p) + (org-back-to-heading invisible-ok) + (error "This should not happen"))) (setq empty-line-p (org-previous-line-empty-p)) (match-string 0)) (error "*")))) @@ -6635,6 +6770,12 @@ (cond (org-insert-heading-respect-content (org-end-of-subtree nil t) + (when (featurep 'org-inlinetask) + (while (and (not (eobp)) + (looking-at "\\(\\*+\\)[ \t]+") + (>= (length (match-string 1)) + org-inlinetask-min-level)) + (org-end-of-subtree nil t))) (or (bolp) (newline)) (or (org-previous-line-empty-p) (and blank (newline))) @@ -6643,7 +6784,7 @@ (when hide-previous (show-children) (org-show-entry)) - (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") (setq tags (and (match-end 2) (match-string 2))) (and (match-end 1) (delete-region (match-beginning 1) (match-end 1))) @@ -6679,7 +6820,7 @@ (org-back-to-heading t) (if (looking-at (if no-tags - (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$") + (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$") "\\*+[ \t]+\\([^\r\n]*\\)")) (match-string 1) ""))) @@ -6764,7 +6905,7 @@ (org-insert-heading arg) (cond ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) + ((org-at-item-p) (org-indent-item)))) (defun org-insert-todo-subheading (arg) "Insert a new subheading with TODO keyword or checkbox and demote it. @@ -6773,7 +6914,7 @@ (org-insert-todo-heading arg) (cond ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) + ((org-at-item-p) (org-indent-item)))) ;;; Promotion and Demotion @@ -7449,13 +7590,15 @@ ;;; Outline Sorting (defun org-sort (with-case) - "Call `org-sort-entries-or-items' or `org-table-sort-lines'. + "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. Optional argument WITH-CASE means sort case-sensitively. With a double prefix argument, also remove duplicate entries." (interactive "P") - (if (org-at-table-p) - (org-call-with-arg 'org-table-sort-lines with-case) - (org-call-with-arg 'org-sort-entries-or-items with-case))) + (cond + ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case)) + ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case)) + (t + (org-call-with-arg 'org-sort-entries with-case)))) (defun org-sort-remove-invisible (s) (remove-text-properties 0 (length s) org-rm-props s) @@ -7473,14 +7616,12 @@ hook gets called. When a region or a plain list is sorted, the cursor will be in the first entry of the sorted region/list.") -(defun org-sort-entries-or-items +(defun org-sort-entries (&optional with-case sorting-type getkey-func compare-func property) - "Sort entries on a certain level of an outline tree, or plain list items. + "Sort entries on a certain level of an outline tree. If there is an active region, the entries in the region are sorted. Else, if the cursor is before the first entry, sort the top-level items. Else, the children of the entry at point are sorted. -If the cursor is at the first item in a plain list, the list items will be -sorted. Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. @@ -7494,7 +7635,6 @@ a Alphabetically, ignoring the TODO keyword and the priority, if any. t By date/time, either the first active time stamp in the entry, or, if none exist, by the first inactive one. - In items, only the first line will be checked. s By the scheduled date/time. d By deadline date/time. c By creation time, which is assumed to be the first inactive time stamp @@ -7513,7 +7653,7 @@ (interactive "P") (let ((case-func (if with-case 'identity 'downcase)) start beg end stars re re2 - txt what tmp plain-list-p) + txt what tmp) ;; Find beginning and end of region to sort (cond ((org-region-active-p) @@ -7523,15 +7663,6 @@ (goto-char (region-beginning)) (if (not (org-on-heading-p)) (outline-next-heading)) (setq start (point))) - ((org-at-item-p) - ;; we will sort this plain list - (org-beginning-of-item-list) (setq start (point)) - (org-end-of-item-list) - (or (bolp) (insert "\n")) - (setq end (point)) - (goto-char start) - (setq plain-list-p t - what "plain list")) ((or (org-on-heading-p) (condition-case nil (progn (org-back-to-heading) t) (error nil))) ;; we will sort the children of the current headline @@ -7564,43 +7695,39 @@ (setq beg (point)) (if (>= beg end) (error "Nothing to sort")) - (unless plain-list-p - (looking-at "\\(\\*+\\)") - (setq stars (match-string 1) - re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") - txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry"))) + (looking-at "\\(\\*+\\)") + (setq stars (match-string 1) + re (concat "^" (regexp-quote stars) " +") + re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") + txt (buffer-substring beg end)) + (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) + (if (and (not (equal stars "*")) (string-match re2 txt)) + (error "Region to sort contains a level above the first entry")) (unless sorting-type (message - (if plain-list-p - "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" - "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc + "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc [t]ime [s]cheduled [d]eadline [c]reated - A/N/T/S/D/C/P/O/F means reversed:") + A/N/T/S/D/C/P/O/F means reversed:" what) (setq sorting-type (read-char-exclusive)) (and (= (downcase sorting-type) ?f) (setq getkey-func (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) + obarray 'fboundp t nil nil)) (setq getkey-func (intern getkey-func))) (and (= (downcase sorting-type) ?r) (setq property (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) + (mapcar 'list (org-buffer-property-keys t)) + nil t)))) (message "Sorting entries...") (save-restriction (narrow-to-region start end) - (let ((dcst (downcase sorting-type)) (case-fold-search nil) (now (current-time))) @@ -7608,99 +7735,70 @@ (/= dcst sorting-type) ;; This function moves to the beginning character of the "record" to ;; be sorted. - (if plain-list-p - (lambda nil - (if (org-at-item-p) t (goto-char (point-max)))) - (lambda nil - (if (re-search-forward re nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))))) + (lambda nil + (if (re-search-forward re nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) ;; This function moves to the last character of the "record" being ;; sorted. - (if plain-list-p - 'org-end-of-item - (lambda nil - (save-match-data - (condition-case nil - (outline-forward-same-level 1) - (error - (goto-char (point-max))))))) - + (lambda nil + (save-match-data + (condition-case nil + (outline-forward-same-level 1) + (error + (goto-char (point-max)))))) ;; This function returns the value that gets sorted against. - (if plain-list-p - (lambda nil - (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") - (cond - ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) - ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) - ((= dcst ?t) - (if (or (re-search-forward org-ts-regexp (point-at-eol) t) - (re-search-forward org-ts-regexp-both - (point-at-eol) t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now))) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) - (lambda nil - (cond - ((= dcst ?n) - (if (looking-at org-complex-heading-regexp) - (string-to-number (match-string 4)) - nil)) - ((= dcst ?a) - (if (looking-at org-complex-heading-regexp) - (funcall case-func (match-string 4)) - nil)) - ((= dcst ?t) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (or (re-search-forward org-ts-regexp end t) - (re-search-forward org-ts-regexp-both end t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?c) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward - (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") - end t) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?s) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-scheduled-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?d) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-deadline-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?p) - (if (re-search-forward org-priority-regexp (point-at-eol) t) - (string-to-char (match-string 2)) - org-default-priority)) - ((= dcst ?r) - (or (org-entry-get nil property) "")) - ((= dcst ?o) - (if (looking-at org-complex-heading-regexp) - (- 9999 (length (member (match-string 2) - org-todo-keywords-1))))) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) + (lambda nil + (cond + ((= dcst ?n) + (if (looking-at org-complex-heading-regexp) + (string-to-number (match-string 4)) + nil)) + ((= dcst ?a) + (if (looking-at org-complex-heading-regexp) + (funcall case-func (match-string 4)) + nil)) + ((= dcst ?t) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (or (re-search-forward org-ts-regexp end t) + (re-search-forward org-ts-regexp-both end t)) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?c) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward + (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") + end t) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?s) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-scheduled-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?d) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-deadline-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?p) + (if (re-search-forward org-priority-regexp (point-at-eol) t) + (string-to-char (match-string 2)) + org-default-priority)) + ((= dcst ?r) + (or (org-entry-get nil property) "")) + ((= dcst ?o) + (if (looking-at org-complex-heading-regexp) + (- 9999 (length (member (match-string 2) + org-todo-keywords-1))))) + ((= dcst ?f) + (if getkey-func + (progn + (setq tmp (funcall getkey-func)) + (if (stringp tmp) (setq tmp (funcall case-func tmp))) + tmp) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type)))) nil (cond ((= dcst ?a) 'string<) @@ -8105,11 +8203,13 @@ path the path of the link, the text after the prefix (like \"http:\") desc the description of the link, if any, nil if there was no description - format the export format, a symbol like `html' or `latex'. + format the export format, a symbol like `html' or `latex' or `ascii'.. The function may use the FORMAT information to return different values depending on the format. The return value will be put literally into -the exported file. +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + Org-mode has a built-in default for exporting links. If you are happy with this default, there is no need to define an export function for the link type. For a simple example of an export function, see `org-bbdb.el'." @@ -8134,7 +8234,7 @@ (org-load-modules-maybe) (setq org-store-link-plist nil) ; reset (let ((outline-regexp (org-get-limited-outline-regexp)) - link cpltxt desc description search txt custom-id) + link cpltxt desc description search txt custom-id agenda-link) (cond ((run-hook-with-args-until-success 'org-store-link-functions) @@ -8166,9 +8266,10 @@ (get-text-property (point) 'org-marker)))) (when m (org-with-point-at m - (if (interactive-p) - (call-interactively 'org-store-link) - (org-store-link nil)))))) + (setq agenda-link + (if (interactive-p) + (call-interactively 'org-store-link) + (org-store-link nil))))))) ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) @@ -8216,13 +8317,14 @@ (setq cpltxt (concat "file:" file) link (org-make-link cpltxt)))) - ((and buffer-file-name (org-mode-p)) + ((and (buffer-file-name (buffer-base-buffer)) (org-mode-p)) (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID"))) (cond ((org-in-regexp "<<\\(.*?\\)>>") (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))) "::" (match-string 1)) link (org-make-link cpltxt))) ((and (featurep 'org-id) @@ -8244,11 +8346,13 @@ (error ;; probably before first headline, link to file only (concat "file:" - (abbreviate-file-name buffer-file-name)))))) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))))) (t ;; Just link to current headline (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) ;; Add a context search string (when (org-xor org-context-in-file-links arg) (setq txt (cond @@ -8305,7 +8409,7 @@ "::#" custom-id)) (setq org-stored-links (cons (list link desc) org-stored-links)))) - (and link (org-make-link-string link desc))))) + (or agenda-link (and link (org-make-link-string link desc)))))) (defun org-store-link-props (&rest plist) "Store link properties, extract names and addresses." @@ -8369,7 +8473,7 @@ ;; We are using a headline, clean up garbage in there. (if (string-match org-todo-regexp s) (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) + (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s) (setq s (replace-match "" t t s))) (setq s (org-trim s)) (if (string-match (concat "^\\(" org-quote-string "\\|" @@ -8377,8 +8481,6 @@ (setq s (replace-match "" t t s))) (while (string-match org-ts-regexp s) (setq s (replace-match "" t t s)))) - (while (string-match "[^a-zA-Z_0-9 \t]+" s) - (setq s (replace-match " " t t s))) (or string (setq s (concat "*" s))) ; Add * for headlines (mapconcat 'identity (org-split-string s "[ \t]+") " "))) @@ -8406,7 +8508,11 @@ (when (and (not description) (not (equal link (org-link-escape link)))) (setq description (org-extract-attributes link))) - (concat "[[" (org-link-escape link) "]" + (setq link (if (string-match org-link-types-re link) + (concat (match-string 1 link) + (org-link-escape (substring link (match-end 1)))) + (org-link-escape link))) + (concat "[[" link "]" (if description (concat "[" description "]") "") "]")) @@ -8914,6 +9020,13 @@ org-link-abbrev-alist-local))) (org-open-at-point arg reference-buffer))))) +(defvar org-open-at-point-functions nil + "Hook that is run when following a link at point. + +Functions in this hook must return t if they identify and follow +a link at point. If they don't find anything interesting at point, +they must return nil.") + (defun org-open-at-point (&optional in-emacs reference-buffer) "Open link at or after point. If there is no link at point, this function will search forward up to @@ -8939,6 +9052,7 @@ (not (get-text-property (point) 'org-linked-text))) (or (org-offer-links-in-entry in-emacs) (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) + ((run-hook-with-args-until-success 'org-open-at-point-functions)) ((org-at-timestamp-p t) (org-follow-timestamp-link)) ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) (org-footnote-action)) @@ -8977,7 +9091,7 @@ (setq type (match-string 1) path (match-string 2)) (throw 'match t))) (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) (setq type "tags" path (match-string 1)) (while (string-match ":" path) @@ -9243,6 +9357,7 @@ (set-window-configuration org-window-config-before-follow-link)") +(defvar org-link-search-inhibit-query nil) ;; dynamically scoped (defun org-link-search (s &optional type avoid-pos) "Search for a link search option. If S is surrounded by forward slashes, it is interpreted as a @@ -9260,7 +9375,7 @@ (pre nil) (post nil) words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall) (cond - ;; First check if there are any special + ;; First check if there are any special search functions ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) ;; Now try the builtin stuff ((and (equal (string-to-char s0) ?#) @@ -9305,12 +9420,33 @@ ;;((eq major-mode 'dired-mode) ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) (t (org-do-occur (match-string 1 s))))) + ((and (org-mode-p) org-link-search-must-match-exact-headline) + (and (equal (string-to-char s) ?*) (setq s (substring s 1))) + (goto-char (point-min)) + (cond + ((let (case-fold-search) + (re-search-forward (format org-complex-heading-regexp-format + (regexp-quote s)) + nil t)) + ;; OK, found a match + (setq type 'dedicated) + (goto-char (match-beginning 0))) + ((and (not org-link-search-inhibit-query) + (eq org-link-search-must-match-exact-headline 'query-to-create) + (y-or-n-p "No match - create this as a new heading? ")) + (goto-char (point-max)) + (or (bolp) (newline)) + (insert "* " s "\n") + (beginning-of-line 0)) + (t + (goto-char pos) + (error "No match")))) (t - ;; A normal search strings + ;; A normal search string (when (equal (string-to-char s) ?*) ;; Anchor on headlines, post may include tags. (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" - post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") + post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$") s (substring s 1))) (remove-text-properties 0 (length s) @@ -9351,13 +9487,7 @@ ) (goto-char (match-beginning 1)) (goto-char pos) - (error "No match"))))) - (t - ;; Normal string-search - (goto-char (point-min)) - (if (search-forward s nil t) - (goto-char (match-beginning 0)) - (error "No match")))) + (error "No match")))))) (and (org-mode-p) (org-show-context 'link-search)) type)) @@ -9836,15 +9966,9 @@ (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) txt (org-link-display-format (match-string 4)) - re (concat "^" (regexp-quote - (buffer-substring - (match-beginning 1) - (match-end 4))))) - (if (match-end 5) (setq re (concat - re "[ \t]+" - (regexp-quote - (match-string 5))))) - (setq re (concat re "[ \t]*$")) + txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt) + re (format org-complex-heading-regexp-format + (regexp-quote (match-string 4)))) (when org-refile-use-outline-path (setq txt (mapconcat 'org-protect-slash @@ -10143,6 +10267,7 @@ (setq answ (funcall cfunc prompt tbl nil (not new-nodes) nil 'org-refile-history)) (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) + (org-refile-check-position pa) (if pa (progn (when (or (not org-refile-history) @@ -10169,6 +10294,26 @@ (org-refile-new-child parent-target child))) (error "Invalid target location"))))) +(defun org-refile-check-position (refile-pointer) + "Check if the refile pointer matches the readline to which it points." + (let* ((file (nth 1 refile-pointer)) + (re (nth 2 refile-pointer)) + (pos (nth 3 refile-pointer)) + buffer) + (when (org-string-nw-p re) + (setq buffer (if (markerp pos) + (marker-buffer pos) + (or (find-buffer-visiting file) + (find-file-noselect file)))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (beginning-of-line 1) + (unless (org-looking-at-p re) + (error "Invalid refile position, please rebuild the cache")))))))) + (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." (unless parent-target @@ -10378,7 +10523,7 @@ "BEGIN_VERSE" "END_VERSE" "BEGIN_CENTER" "END_CENTER" "BEGIN_SRC" "END_SRC" - "CATEGORY" "COLUMNS" + "CATEGORY" "COLUMNS" "PROPERTY" "CAPTION" "LABEL" "SETUPFILE" "BIND" @@ -10482,7 +10627,7 @@ (let* ((a nil) (end (point)) (beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]_@")) + (skip-chars-backward (org-re "[:alnum:]_@#%")) (point))) (beg (save-excursion (skip-chars-backward "a-zA-Z0-9_:$") @@ -10497,8 +10642,10 @@ (throw 'exit t))) (tag (and (equal (char-before beg1) ?:) (equal (char-after (point-at-bol)) ?*))) - (prop (and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*)))) + (prop (or (and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*))) + (string-match "^#\\+PROPERTY:.*" + (buffer-substring (point-at-bol) (point))))) (texp (equal (char-before beg) ?\\)) (link (equal (char-before beg) ?\[)) (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) @@ -10575,7 +10722,10 @@ (delete-window (get-buffer-window "*Completions*"))) (if (assoc completion table) (if (eq type :todo) (insert " ") - (if (memq type '(:tag :prop)) (insert ":")))) + (if (and (memq type '(:tag :prop)) + (not (string-match "^#[ \t]*\\+property:" + (org-current-line-string t)))) + (insert ":")))) (if (and (equal type :opt) (assoc completion table)) (message "%s" (substitute-command-keys "Press \\[org-complete] again to insert example settings")))) @@ -10613,27 +10763,6 @@ (defvar org-setting-tags nil) ; dynamically skipped -(defun org-parse-local-options (string var) - "Parse STRING for startup setting relevant for variable VAR." - (let ((rtn (symbol-value var)) - e opts) - (save-match-data - (if (or (not string) (not (string-match "\\S-" string))) - rtn - (setq opts (delq nil (mapcar (lambda (x) - (setq e (assoc x org-startup-options)) - (if (eq (nth 1 e) var) e nil)) - (org-split-string string "[ \t]+")))) - (if (not opts) - rtn - (setq rtn nil) - (while (setq e (pop opts)) - (if (not (nth 3 e)) - (setq rtn (nth 2 e)) - (if (not (listp rtn)) (setq rtn nil)) - (push (nth 2 e) rtn))) - rtn))))) - (defvar org-todo-setup-filter-hook nil "Hook for functions that pre-filter todo specs. Each function takes a todo spec and returns either nil or the spec @@ -11313,7 +11442,6 @@ (msg "Entry repeats: ") (org-log-done nil) (org-todo-log-states nil) - (nshiftmax 10) (nshift 0) re type n what ts time to-state) (when repeat (if (eq org-log-repeat t) (setq org-log-repeat 'state)) @@ -11360,15 +11488,17 @@ (- (time-to-days (current-time)) (time-to-days time)) 'day)) ((equal (match-string 1 ts) "+") - (while (or (= nshift 0) - (<= (time-to-days time) (time-to-days (current-time)))) - (when (= (incf nshift) nshiftmax) - (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) - (error "Abort"))) - (org-timestamp-change n (cdr (assoc what whata))) - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (setq time (save-match-data (org-time-string-to-time ts)))) + (let ((nshiftmax 10) (nshift 0)) + (while (or (= nshift 0) + (<= (time-to-days time) + (time-to-days (current-time)))) + (when (= (incf nshift) nshiftmax) + (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) + (error "Abort"))) + (org-timestamp-change n (cdr (assoc what whata))) + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (setq time (save-match-data (org-time-string-to-time ts))))) (org-timestamp-change (- n) (cdr (assoc what whata))) ;; rematch, so that we have everything in place for the real shift (org-at-timestamp-p t) @@ -11631,7 +11761,7 @@ (defvar org-property-end-re) (defun org-add-log-setup (&optional purpose state prev-state - findpos how &optional extra) + findpos how extra) "Set up the post command hook to take a note. If this is about to TODO state change, the new state is expected in STATE. When FINDPOS is non-nil, find the correct position for the note in @@ -11692,10 +11822,11 @@ (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." (if (looking-at "\n[ \t]*- State") (forward-char 1)) - (while (looking-at "[ \t]*- State") - (condition-case nil - (org-next-item) - (error (org-end-of-item))))) + (when (org-in-item-p) + (let ((limit (org-list-bottom-point))) + (while (looking-at "[ \t]*- State") + (goto-char (or (org-get-next-item (point) limit) + (org-get-end-of-item limit))))))) (defun org-add-log-note (&optional purpose) "Pop up a window for taking a note, and add this note later at point." @@ -11740,7 +11871,7 @@ "Finish taking a log note, and insert it to where it belongs." (let ((txt (buffer-string)) (note (cdr (assq org-log-note-purpose org-log-note-headings))) - lines ind) + lines ind bul) (kill-buffer (current-buffer)) (while (string-match "\\`#.*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) @@ -11780,13 +11911,26 @@ (move-marker org-log-note-marker nil) (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - (insert "- " (pop lines)) - (org-indent-line-function) - (beginning-of-line 1) - (looking-at "[ \t]*") - (setq ind (concat (match-string 0) " ")) - (end-of-line 1) - (while lines (insert "\n" ind (pop lines))) + (setq ind (save-excursion + (if (org-in-item-p) + (progn + (goto-char (org-list-top-point)) + (org-get-indentation)) + (skip-chars-backward " \r\t\n") + (cond + ((and (org-at-heading-p) + org-adapt-indentation) + (1+ (org-current-level))) + ((org-at-heading-p) 0) + (t (org-get-indentation)))))) + (setq bul (org-list-bullet-string "-")) + (org-indent-line-to ind) + (insert bul (pop lines)) + (let ((ind-body (+ (length bul) ind))) + (while lines + (insert "\n") + (org-indent-line-to ind-body) + (insert (pop lines)))) (message "Note stored") (org-back-to-heading t) (org-cycle-hide-drawers 'children))))) @@ -12024,7 +12168,8 @@ (setq new action) (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) - (setq new (read-char-exclusive))) + (save-match-data + (setq new (read-char-exclusive)))) (if (and (= (upcase org-highest-priority) org-highest-priority) (= (upcase org-lowest-priority) org-lowest-priority)) (setq new (upcase new))) @@ -12109,7 +12254,7 @@ (let* ((re (concat "^" outline-regexp " *\\(\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re - "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) + "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) (props (list 'face 'default 'done-face 'org-agenda-done 'undone-face 'default @@ -12309,7 +12454,7 @@ ;; Parse the string and create a lisp form (let ((match0 match) - (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)")) + (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher orterms term orlist re-p str-p level-p level-op time-p @@ -12337,7 +12482,9 @@ (setq rest (substring term (match-end 0)) minus (and (match-end 1) (equal (match-string 1 term) "-")) - tag (match-string 2 term) + tag (save-match-data (replace-regexp-in-string + "\\\\-" "-" + (match-string 2 term))) re-p (equal (string-to-char tag) ?{) level-p (match-end 4) prop-p (match-end 5) @@ -12516,7 +12663,7 @@ (while (not (equal lastpos (point))) (setq lastpos (point)) (when (looking-at - (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) + (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) (setq ltags (org-split-string (org-match-string-no-properties 1) ":")) (when parent @@ -12543,7 +12690,7 @@ (let (res current) (save-excursion (org-back-to-heading t) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") + (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$") (point-at-eol) t) (progn (setq current (match-string 1)) @@ -12573,7 +12720,7 @@ ;; Assumes that this is a headline (let ((pos (point)) (col (current-column)) ncol tags-l p) (beginning-of-line 1) - (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (< pos (match-beginning 2))) (progn (setq tags-l (- (match-end 2) (match-beginning 2))) @@ -12643,6 +12790,7 @@ (org-set-tags t) (message "No headings")))) +(defvar org-indent-indentation-per-level) (defun org-set-tags (&optional arg just-align) "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." @@ -12652,7 +12800,7 @@ (col (current-column)) (org-setting-tags t) table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl) + tags p0 c0 c1 rpl di tc level) (if arg (save-excursion (goto-char (point-min)) @@ -12667,8 +12815,10 @@ (save-excursion (setq table (append org-tag-persistent-alist (or org-tag-alist (org-get-buffer-tags)) - (and org-complete-tags-always-offer-all-agenda-tags - (org-global-tags-completion-table (org-agenda-files)))) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse @@ -12680,19 +12830,24 @@ (delq nil (mapcar 'cdr table)))) (org-fast-tag-selection current-tags inherited-tags table - (if org-fast-tag-selection-include-todo org-todo-key-alist)) + (if org-fast-tag-selection-include-todo + org-todo-key-alist)) (let ((org-add-colon-after-tag-completion t)) (org-trim (org-without-partial-completion - (org-icompleting-read "Tags: " 'org-tags-completion-function + (org-icompleting-read "Tags: " + 'org-tags-completion-function nil nil current 'org-tags-history))))))) (while (string-match "[-+&]+" tags) ;; No boolean logic, just a list (setq tags (replace-match ":" t t tags)))) + (setq tags (replace-regexp-in-string "[ ,]" ":" tags)) + (if org-tags-sort-function (setq tags (mapconcat 'identity - (sort (org-split-string tags (org-re "[^[:alnum:]_@]+")) + (sort (org-split-string + tags (org-re "[^[:alnum:]_@#%]+")) org-tags-sort-function) ":"))) (if (string-match "\\`[\t ]*\\'" tags) @@ -12702,6 +12857,9 @@ ;; Insert new tags at the correct column (beginning-of-line 1) + (setq level (or (and (looking-at org-outline-regexp) + (- (match-end 0) (point) 1)) + 1)) (cond ((and (equal current "") (equal tags ""))) ((re-search-forward @@ -12710,11 +12868,14 @@ (if (equal tags "") (setq rpl "") (goto-char (match-beginning 0)) - (setq c0 (current-column) p0 (if (equal (char-before) ?*) - (1+ (point)) (point)) - c1 (max (1+ c0) (if (> org-tags-column 0) - org-tags-column - (- (- org-tags-column) (length tags)))) + (setq c0 (current-column) + ;; compute offset for the case of org-indent-mode active + di (if org-indent-mode + (* (1- org-indent-indentation-per-level) (1- level)) + 0) + p0 (if (equal (char-before) ?*) (1+ (point)) (point)) + tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) + c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) (replace-match rpl t t) (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) @@ -12766,7 +12927,7 @@ (defun org-tags-completion-function (string predicate &optional flag) (let (s1 s2 rtn (ctable org-last-tags-completion-table) (confirm (lambda (x) (stringp (car x))))) - (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) + (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) (setq s1 (match-string 1 string) s2 (match-string 2 string)) (setq s1 "" s2 string)) @@ -12843,7 +13004,7 @@ (save-excursion (beginning-of-line 1) (if (looking-at - (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") @@ -12993,7 +13154,7 @@ (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward - (org-re "\\[.\\] \\([[:alnum:]_@]+\\)") nil t) + (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) @@ -13014,7 +13175,7 @@ (error "Not on a heading")) (save-excursion (beginning-of-line 1) - (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (org-match-string-no-properties 1) ""))) @@ -13028,7 +13189,7 @@ (save-excursion (goto-char (point-min)) (while (re-search-forward - (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t\r\n]") nil t) + (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t) (when (equal (char-after (point-at-bol 0)) ?*) (mapc (lambda (x) (add-to-list 'tags x)) (org-split-string (org-match-string-no-properties 1) ":"))))) @@ -13899,6 +14060,42 @@ (when (org-on-heading-p) (move-marker (make-marker) (point)))))))) +(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) + "Find node HEADING in BUFFER. +Return a marker to the heading if it was found, or nil if not. +If POS-ONLY is set, return just the position instead of a marker. + +The heading text must match exact, but it may have a TODO keyword, +a priority cookie and tags in the standard locations." + (with-current-buffer (or buffer (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let (case-fold-search) + (if (re-search-forward + (format org-complex-heading-regexp-format + (regexp-quote heading)) nil t) + (if pos-only + (match-beginning 0) + (move-marker (make-marker) (match-beginning 0))))))))) + +(defun org-find-exact-heading-in-directory (heading &optional dir) + "Find Org node headline HEADING in all .org files in directory DIR. +When the target headline is found, return a marker to this location." + (let ((files (directory-files (or dir default-directory) + nil "\\`[^.#].*\\.org\\'")) + file visiting m buffer) + (catch 'found + (while (setq file (pop files)) + (message "trying %s" file) + (setq visiting (org-find-base-buffer-visiting file)) + (setq buffer (or visiting (find-file-noselect file))) + (setq m (org-find-exact-headline-in-buffer + heading buffer)) + (when (and (not m) (not visiting)) (kill-buffer buffer)) + (and m (throw 'found m)))))) + (defun org-find-entry-with-id (ident) "Locate the entry that contains the ID property with exact value IDENT. IDENT can be a string, a symbol or a number, this function will search for @@ -14190,6 +14387,10 @@ (setq org-read-date-overlay nil))))) (setq final (org-read-date-analyze ans def defdecode)) + + ;; One round trip to get rid of 34th of August and stuff like that.... + (setq final (decode-time (apply 'encode-time final))) + (setq org-read-date-final-answer ans) (if to-time @@ -14457,9 +14658,10 @@ (list arg2 arg1 arg3)) ((eq calendar-date-style 'iso) (list arg2 arg3 arg1))) - (if (org-bound-and-true-p european-calendar-style) - (list arg2 arg1 arg3) - (list arg1 arg2 arg3)))) + (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (if (org-bound-and-true-p european-calendar-style) + (list arg2 arg1 arg3) + (list arg1 arg2 arg3))))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. @@ -14498,7 +14700,6 @@ stamp) (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) (insert-before-markers (or pre "")) - (insert-before-markers (setq stamp (format-time-string fmt time))) (when (listp extra) (setq extra (car extra)) (if (and (stringp extra) @@ -14508,9 +14709,8 @@ (string-to-number (match-string 2 extra)))) (setq extra nil))) (when extra - (backward-char 1) - (insert-before-markers extra) - (forward-char 1)) + (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) + (insert-before-markers (setq stamp (format-time-string fmt time))) (insert-before-markers (or post "")) (setq org-last-inserted-timestamp stamp))) @@ -14827,7 +15027,10 @@ (sleep-for 2)))))) (cond ((stringp result) result) ((and (consp result) + (not (consp (cdr result))) (stringp (cdr result))) (cdr result)) + ((and (consp result) + (stringp (car result))) result) (result entry) (t nil)))) @@ -15747,7 +15950,7 @@ (concat "ltxpng/" (file-name-sans-extension (file-name-nondirectory buffer-file-name))) - default-directory 'overlays msg at 'forbuffer) + default-directory 'overlays msg at 'forbuffer 'dvipng) (message msg "done. Use `C-c C-c' to remove images."))))) (defvar org-latex-regexps @@ -15761,8 +15964,9 @@ ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) "Regular expressions for matching embedded LaTeX.") +(defvar org-export-have-math nil) ;; dynamic scoping (defun org-format-latex (prefix &optional dir overlays msg at - forbuffer protect-only) + forbuffer processing-type) "Replace LaTeX fragments with links to an image, and produce images. Some of the options can be changed using the variable `org-format-latex-options'." @@ -15776,7 +15980,7 @@ (org-format-latex-header-extra (plist-get (org-infile-export-plist) :latex-header-extra)) (cnt 0) txt hash link beg end re e checkdir - executables-checked + executables-checked string m n block linkfile movefile ov) ;; Check the different regular expressions (while (setq e (pop re-list)) @@ -15792,9 +15996,26 @@ (not (eq (get-char-property (match-beginning n) 'org-overlay-type) 'org-latex-overlay)))) - (if protect-only + (setq org-export-have-math t) + (cond + ((eq processing-type 'verbatim) + ;; Leave the text verbatim, just protect it + (add-text-properties (match-beginning n) (match-end n) + '(org-protected t))) + ((eq processing-type 'mathjax) + ;; Prepare for MathJax processing + (setq string (match-string n)) + (if (member m '("$" "$1")) + (save-excursion + (delete-region (match-beginning n) (match-end n)) + (goto-char (match-beginning n)) + (insert (org-add-props (concat "\\(" (substring string 1 -1) + "\\)") + '(org-protected t)))) (add-text-properties (match-beginning n) (match-end n) - '(org-protected t)) + '(org-protected t)))) + ((or (eq processing-type 'dvipng) t) + ;; Process to an image (setq txt (match-string n) beg (match-beginning n) end (match-end n) cnt (1+ cnt)) @@ -15813,15 +16034,15 @@ (goto-char beg) (unless checkdir ; make sure the directory exists (setq checkdir t) - (or (file-directory-p todir) (make-directory todir))) - + (or (file-directory-p todir) (make-directory todir t))) + (unless executables-checked (org-check-external-command "latex" "needed to convert LaTeX fragments to images") (org-check-external-command "dvipng" "needed to convert LaTeX fragments to images") (setq executables-checked t)) - + (unless (file-exists-p movefile) (org-create-formula-image txt movefile opt forbuffer)) @@ -15848,7 +16069,8 @@ (delete-region beg end) (insert (org-add-props link (list 'org-latex-src - (replace-regexp-in-string "\"" "" txt)))))))))))) + (replace-regexp-in-string + "\"" "" txt))))))))))))) ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image (string tofile options buffer) @@ -16019,7 +16241,7 @@ (widen) (setq beg (or beg (point-min)) end (or end (point-max))) (goto-char (point-min)) - (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([-+~.:/\\_0-9a-zA-Z ]+" + (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" (substring (org-image-file-name-regexp) 0 -2) "\\)\\]" (if include-linked "" "\\]"))) old file ov img) @@ -16031,7 +16253,7 @@ (when (file-exists-p file) (if (and (car-safe old) refresh) (image-refresh (overlay-get (cdr old) 'display)) - (setq img (create-image file)) + (setq img (save-match-data (create-image file))) (when img (setq ov (make-overlay (match-beginning 0) (match-end 0))) (overlay-put ov 'display img) @@ -16236,10 +16458,12 @@ (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) +(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer) (org-defkey org-mode-map "\C-c\C-x." 'org-timer) (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) +(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop) (org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue) (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) @@ -16300,6 +16524,8 @@ ("Misc") ("o" . org-open-at-point) ("?" . org-speed-command-help) + ("<" . (org-agenda-set-restriction-lock 'subtree)) + (">" . (org-agenda-remove-restriction-lock)) ) "The default speed commands.") @@ -16346,6 +16572,40 @@ (defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-speed-command nil) + +(defun org-speed-command-default-hook (keys) + "Hook for activating single-letter speed commands. +`org-speed-commands-default' specifies a minimal command set. Use +`org-speed-commands-user' for further customization." + (when (or (and (bolp) (looking-at outline-regexp)) + (and (functionp org-use-speed-commands) + (funcall org-use-speed-commands))) + (cdr (assoc keys (append org-speed-commands-user + org-speed-commands-default))))) + +(defun org-babel-speed-command-hook (keys) + "Hook for activating single-letter code block commands." + (when (and (bolp) (looking-at org-babel-src-block-regexp)) + (cdr (assoc keys org-babel-key-bindings)))) + +(defcustom org-speed-command-hook + '(org-speed-command-default-hook org-babel-speed-command-hook) + "Hook for activating speed commands at strategic locations. +Hook functions are called in sequence until a valid handler is +found. + +Each hook takes a single argument, a user-pressed command key +which is also a `self-insert-command' from the global map. + +Within the hook, examine the cursor position and the command key +and return nil or a valid handler as appropriate. Handler could +be one of an interactive command, a function, or a form. + +Set `org-use-speed-commands' to non-nil value to enable this +hook. The default setting is `org-speed-command-default-hook'." + :group 'org-structure + :type 'hook) + (defun org-self-insert-command (N) "Like `self-insert-command', use overwrite-mode for whitespace in tables. If the cursor is in a table looking at whitespace, the whitespace is @@ -16353,13 +16613,9 @@ (interactive "p") (cond ((and org-use-speed-commands - (or (and (bolp) (looking-at outline-regexp)) - (and (functionp org-use-speed-commands) - (funcall org-use-speed-commands))) - (setq - org-speed-command - (or (cdr (assoc (this-command-keys) org-speed-commands-user)) - (cdr (assoc (this-command-keys) org-speed-commands-default))))) + (setq org-speed-command + (run-hook-with-args-until-success + 'org-speed-command-hook (this-command-keys)))) (cond ((commandp org-speed-command) (setq this-command org-speed-command) @@ -16426,9 +16682,11 @@ (noalign (looking-at "[^|\n\r]* |")) (c org-table-may-need-update)) (backward-delete-char N) - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)) + (if (not overwrite-mode) + (progn + (skip-chars-forward "^|") + (insert " ") + (goto-char (1- pos)))) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. (if noalign (setq org-table-may-need-update c))) @@ -17022,13 +17280,10 @@ - If the cursor is a the beginning of a dynamic block, update it. -- If the current buffer is a remember buffer, close note and file - it. A prefix argument of 1 files to the default location - without further interaction. A prefix argument of 2 files to - the currently clocking task. - -- If the cursor is on a <<<target>>>, update radio targets and corresponding - links in this buffer. +- If the current buffer is a capture buffer, close note and file it. + +- If the cursor is on a <<<target>>>, update radio targets and + corresponding links in this buffer. - If the cursor is on a numbered item in a plain list, renumber the ordered list. @@ -17074,12 +17329,12 @@ (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) + (call-interactively 'org-list-repair) (call-interactively 'org-toggle-checkbox) (org-list-send-list 'maybe)) ((org-at-item-p) - (if arg - (call-interactively 'org-toggle-checkbox) - (call-interactively 'org-maybe-renumber-ordered-list)) + (call-interactively 'org-list-repair) + (when arg (call-interactively 'org-toggle-checkbox)) (org-list-send-list 'maybe)) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) ;; Dynamic block @@ -17136,7 +17391,7 @@ (call-interactively 'org-open-at-point)) ((and (org-at-heading-p) (looking-at - (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$"))) + (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) (org-show-entry) (end-of-line 1) (newline)) @@ -17202,21 +17457,21 @@ ;; We already have items, de-itemize (while (< (setq l (1+ l)) l2) (when (org-at-item-p) - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (and (looking-at "[ \t]+") (replace-match ""))) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) (beginning-of-line 2)) (if (org-on-heading-p) ;; Headings, convert to items (while (< (setq l (1+ l)) l2) (if (looking-at org-outline-regexp) - (replace-match "- " t t)) + (replace-match (org-list-bullet-string "-") t t)) (beginning-of-line 2)) ;; normal lines, turn them into items (while (< (setq l (1+ l)) l2) (unless (org-at-item-p) (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match "\\1- \\2"))) + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) (beginning-of-line 2))))))) (defun org-toggle-heading (&optional nstars) @@ -17518,14 +17773,6 @@ (org-inside-LaTeX-fragment-p)] ["Insert citation" org-reftex-citation t] "--" - ["Export LaTeX fragments as images" - (if (featurep 'org-exp) - (setq org-export-with-LaTeX-fragments - (not org-export-with-LaTeX-fragments)) - (require 'org-exp)) - :style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments) - org-export-with-LaTeX-fragments)] - "--" ["Template for BEAMER" org-insert-beamer-options-template t]) "--" ("MobileOrg" @@ -18107,16 +18354,23 @@ (throw 'exit t))) nil)))) -(defun org-in-regexps-block-p (start-re end-re) +(defun org-in-regexps-block-p (start-re end-re &optional bound) "Return t if the current point is between matches of START-RE and END-RE. -This will also return to if point is on one of the two matches." - (interactive) - (let ((p (point))) - (save-excursion - (and (or (org-at-regexp-p start-re) - (re-search-backward start-re nil t)) - (re-search-forward end-re nil t) - (>= (point) p))))) +This will also return t if point is on one of the two matches or +in an unfinished block. END-RE can be a string or a form +returning a string. + +An optional third argument bounds the search for START-RE. It +defaults to previous heading or `point-min'." + (let ((pos (point)) + (limit (or bound (save-excursion (outline-previous-heading))))) + (save-excursion + ;; we're on a block when point is on start-re... + (or (org-at-regexp-p start-re) + ;; ... or start-re can be found above... + (and (re-search-backward start-re limit t) + ;; ... but no end-re between start-re and point. + (not (re-search-forward (eval end-re) pos t))))))) (defun org-occur-in-agenda-files (regexp &optional nlines) "Call `multi-occur' with buffers for all agenda files." @@ -18392,61 +18646,90 @@ (itemp (org-at-item-p)) (case-fold-search t) (org-drawer-regexp (or org-drawer-regexp "\000")) + (inline-task-p (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) column bpos bcol tpos tcol bullet btype bullet-type) ;; Find the previous relevant line (beginning-of-line 1) (cond + ;; Comments ((looking-at "#") (setq column 0)) + ;; Headings ((looking-at "\\*+ ") (setq column 0)) + ;; Drawers ((and (looking-at "[ \t]*:END:") (save-excursion (re-search-backward org-drawer-regexp nil t))) (save-excursion (goto-char (1- (match-beginning 1))) (setq column (current-column)))) - ((and (looking-at "[ \t]+#\\+end_\\([a-z]+\\)") + ;; Special blocks + ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") (save-excursion (re-search-backward (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) (setq column (org-get-indentation (match-string 0)))) + ((and (not (looking-at "[ \t]*#\\+begin_")) + (org-in-regexps-block-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) + (save-excursion + (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) + (setq column + (if (equal (downcase (match-string 1)) "src") + ;; src blocks: let `org-edit-src-exit' handle them + (org-get-indentation) + (org-get-indentation (match-string 0))))) + ;; Lists + ((org-in-item-p) + (org-beginning-of-item) + (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\(:?\\[@\\(:?start:\\)?[0-9]+\\][ \t]*\\)?\\[[- X]\\][ \t]*\\|.*? :: \\)?") + (setq bpos (match-beginning 1) tpos (match-end 0) + bcol (progn (goto-char bpos) (current-column)) + tcol (progn (goto-char tpos) (current-column)) + bullet (match-string 1) + bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) + (if (> tcol (+ bcol org-description-max-indent)) + (setq tcol (+ bcol 5))) + (if (not itemp) + (setq column tcol) + (beginning-of-line 1) + (goto-char pos) + (if (looking-at "\\S-") + (progn + (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") + (setq bullet (match-string 1) + btype (if (string-match "[0-9]" bullet) "n" bullet)) + (setq column (if (equal btype bullet-type) bcol tcol))) + (setq column (org-get-indentation))))) + ;; This line has nothing special, look upside to get a clue about + ;; what to do. (t (beginning-of-line 0) - (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]") - (not (looking-at "[ \t]*:END:")) - (not (looking-at org-drawer-regexp))) - (beginning-of-line 0)) + (while (and (not (bobp)) + ;; skip comments, verbatim, empty lines, tables, + ;; inline tasks + (or (looking-at "[ \t]*[\n:#|]") + (and (org-in-item-p) (goto-char (org-list-top-point))) + (and (not inline-task-p) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + (not (looking-at "[ \t]*:END:")) + (not (looking-at org-drawer-regexp))) + (beginning-of-line 0)) (cond + ;; There was an heading above. ((looking-at "\\*+[ \t]+") (if (not org-adapt-indentation) (setq column 0) (goto-char (match-end 0)) (setq column (current-column)))) + ;; A drawer had started and is unfinished: indent consequently. ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ;; The drawer had ended: indent like its :END: line. ((looking-at "\\([ \t]*\\):END:") - (goto-char (match-end 1)) - (setq column (current-column))) - ((org-in-item-p) - (org-beginning-of-item) - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column)) - bullet (match-string 1) - bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) - (if (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5))) - (if (not itemp) - (setq column tcol) - (goto-char pos) - (beginning-of-line 1) - (if (looking-at "\\S-") - (progn - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (setq bullet (match-string 1) - btype (if (string-match "[0-9]" bullet) "n" bullet)) - (setq column (if (equal btype bullet-type) bcol tcol))) - (setq column (org-get-indentation))))) + (goto-char (match-end 1)) + (setq column (current-column))) + ;; Else, nothing noticeable found: get indentation and go on. (t (setq column (org-get-indentation)))))) (goto-char pos) (if (<= (current-column) (current-indentation)) @@ -18705,7 +18988,7 @@ (t 'end-of-line))) (let ((pos (point))) (beginning-of-line 1) - (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\)?$")) + (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$")) (if (eq special t) (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) @@ -18759,7 +19042,7 @@ (not (y-or-n-p "Kill hidden subtree along with headline? "))) (error "C-k aborted - would kill hidden subtree"))) (call-interactively 'kill-line)) - ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")) + ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) (t (kill-region (point) (point-at-eol))))) @@ -19003,6 +19286,18 @@ (while (org-goto-sibling 'previous) (org-flag-heading nil)))) +(defun org-goto-first-child () + "Goto the first child, even if it is invisible. +Return t when a child was found. Otherwise don't move point and +return nil." + (let (level (pos (point)) (re (concat "^" outline-regexp))) + (when (condition-case nil (org-back-to-heading t) (error nil)) + (setq level (outline-level)) + (forward-char 1) + (if (and (re-search-forward re nil t) (> (outline-level) level)) + (progn (goto-char (match-beginning 0)) t) + (goto-char pos) nil)))) + (defun org-show-hidden-entry () "Show an entry where even the heading is hidden." (save-excursion @@ -19094,7 +19389,9 @@ (defun org-forward-same-level (arg &optional invisible-ok) "Move forward to the arg'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading." +Stop at the first and last subheadings of a superior heading. +Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil +it wil also look at invisible ones." (interactive "p") (org-back-to-heading invisible-ok) (org-on-heading-p) @@ -19311,8 +19608,8 @@ ;; Make flyspell not check words in links, to not mess up our keymap (defun org-mode-flyspell-verify () "Don't let flyspell put overlays at active buttons." - (and (not (get-text-property (point) 'keymap)) - (not (get-text-property (point) 'org-no-flyspell)))) + (and (not (get-text-property (max (1- (point)) (point-min)) 'keymap)) + (not (get-text-property (max (1- (point)) (point-min)) 'org-no-flyspell)))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region."
--- a/lisp/play/gomoku.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/play/gomoku.el Wed Nov 17 13:09:08 2010 +0900 @@ -929,11 +929,7 @@ "Display a message asking for Human's move." (message (if (zerop gomoku-number-of-human-moves) "Your move? (Move to a free square and hit X, RET ...)" - "Your move?")) - ;; This may seem silly, but if one omits the following line (or a similar - ;; one), the cursor may very well go to some place where POINT is not. - ;; FIXME: this can't be right!! --Stef - (save-excursion (set-buffer (other-buffer)))) + "Your move?"))) (defun gomoku-prompt-for-other-game () "Ask for another game, and start it."
--- a/lisp/play/landmark.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/play/landmark.el Wed Nov 17 13:09:08 2010 +0900 @@ -826,11 +826,7 @@ "Display a message asking for Human's move." (message (if (zerop lm-number-of-human-moves) "Your move? (move to a free square and hit X, RET ...)" - "Your move?")) - ;; This may seem silly, but if one omits the following line (or a similar - ;; one), the cursor may very well go to some place where POINT is not. - ;; FIXME: this can't be right!! --Stef - (save-excursion (set-buffer (other-buffer)))) + "Your move?"))) (defun lm-prompt-for-other-game () "Ask for another game, and start it."
--- a/lisp/progmodes/ada-mode.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/ada-mode.el Wed Nov 17 13:09:08 2010 +0900 @@ -2472,8 +2472,7 @@ (if (and ada-indent-is-separate (save-excursion (goto-char (match-end 0)) - (ada-goto-next-non-ws (save-excursion (end-of-line) - (point))) + (ada-goto-next-non-ws (point-at-eol)) (looking-at "\\<abstract\\>\\|\\<separate\\>"))) (save-excursion (ada-goto-stmt-start) @@ -2580,10 +2579,7 @@ (forward-line -1) (beginning-of-line) (while (and (not pos) - (search-forward "--" - (save-excursion - (end-of-line) (point)) - t)) + (search-forward "--" (point-at-eol) t)) (unless (ada-in-string-p) (setq pos (point)))) pos)) @@ -5285,11 +5281,7 @@ (widen) (forward-line 1) (ada-previous-procedure) - - (save-excursion - (beginning-of-line) - (setq end (point))) - + (setq end (point-at-bol)) (ada-move-to-end) (end-of-line) (narrow-to-region end (point))
--- a/lisp/progmodes/ada-xref.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/ada-xref.el Wed Nov 17 13:09:08 2010 +0900 @@ -167,7 +167,7 @@ Otherwise, ask the user for the name of the project file to use." :type 'boolean :group 'ada) -(defconst is-windows (memq system-type (quote (windows-nt))) +(defconst ada-on-ms-windows (memq system-type '(windows-nt)) "True if we are running on Windows.") (defcustom ada-tight-gvd-integration nil @@ -222,7 +222,7 @@ On Windows systems using `cmdproxy.exe' as the shell, we need to use `/d' or the drive is never changed.") -(defvar ada-command-separator (if is-windows " && " "\n") +(defvar ada-command-separator (if ada-on-ms-windows " && " "\n") "Separator to use between multiple commands to `compile' or `start-process'. `cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use \"&&\" for now.") @@ -768,7 +768,7 @@ 'comp_opt ada-prj-default-comp-opt 'cross_prefix "" 'debug_cmd (concat ada-prj-default-debugger - " ${main}" (if is-windows ".exe")) ;; FIXME: don't need .exe? + " ${main}" (if ada-on-ms-windows ".exe")) ;; FIXME: don't need .exe? 'debug_post_cmd (list nil) 'debug_pre_cmd (list (concat ada-cd-command " ${build_dir}")) 'gnatmake_opt ada-prj-default-gnatmake-opt @@ -782,7 +782,7 @@ 'make_cmd (list ada-prj-default-make-cmd) ;; FIXME: should not a list 'obj_dir (list ".") 'remote_machine "" - 'run_cmd (list (concat "./${main}" (if is-windows ".exe"))) + 'run_cmd (list (concat "./${main}" (if ada-on-ms-windows ".exe"))) ;; FIXME: should not a list ;; FIXME: don't need .exe? 'src_dir (list ".") @@ -1016,7 +1016,7 @@ ;; processed (gnatfind \"+\":...). (let* ((quote-entity (if (= (aref entity 0) ?\") - (if is-windows + (if ada-on-ms-windows (concat "\\\"" (substring entity 1 -1) "\\\"") (concat "'\"" (substring entity 1 -1) "\"'")) entity))
--- a/lisp/progmodes/cperl-mode.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/cperl-mode.el Wed Nov 17 13:09:08 2010 +0900 @@ -2984,8 +2984,7 @@ (looking-at "sub\\>"))) (setq p (nth 1 ; start of innermost containing list (parse-partial-sexp - (save-excursion (beginning-of-line) - (point)) + (point-at-bol) (point))))) (progn (goto-char (1+ p)) ; enclosing block on the same line @@ -3804,7 +3803,8 @@ indentable t)) ;; Need to remove face as well... (goto-char min) - (and (eq system-type 'emx) + ;; 'emx not supported by Emacs since at least 21.1. + (and (featurep 'xemacs) (eq system-type 'emx) (eq (point) 1) (let ((case-fold-search t)) (looking-at "extproc[ \t]")) ; Analogue of #! @@ -4048,10 +4048,7 @@ "") tb (match-beginning 0)) (setq argument nil) - (put-text-property (save-excursion - (beginning-of-line) - (point)) - b 'first-format-line 't) + (put-text-property (point-at-bol) b 'first-format-line 't) (if cperl-pod-here-fontify (while (and (eq (forward-line) 0) (not (looking-at "^[.;]$"))) @@ -7042,7 +7039,7 @@ (or topdir (setq topdir default-directory)) (let ((tags-file-name "TAGS") - (case-fold-search (eq system-type 'emx)) + (case-fold-search (and (featurep 'xemacs) (eq system-type 'emx))) xs rel tm) (save-excursion (cond (inbuffer nil) ; Already there
--- a/lisp/progmodes/etags.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/etags.el Wed Nov 17 13:09:08 2010 +0900 @@ -1133,9 +1133,7 @@ ;; Naive match found. Qualify the match. (and (funcall (car order) pattern) ;; Make sure it is not a previous qualified match. - (not (member (set-marker match-marker (save-excursion - (beginning-of-line) - (point))) + (not (member (set-marker match-marker (point-at-bol)) tag-lines-already-matched)) (throw 'qualified-match-found nil)) (if next-line-after-failure-p @@ -1313,13 +1311,11 @@ ;; Find the end of the tag and record the whole tag text. (search-forward "\177") - (setq tag-text (buffer-substring (1- (point)) - (save-excursion (beginning-of-line) - (point)))) + (setq tag-text (buffer-substring (1- (point)) (point-at-bol))) ;; If use-explicit is non nil and explicit tag is present, use it as part of ;; return value. Else just skip it. (setq explicit-start (point)) - (when (and (search-forward "\001" (save-excursion (forward-line 1) (point)) t) + (when (and (search-forward "\001" (point-at-bol 2) t) use-explicit) (setq tag-text (buffer-substring explicit-start (1- (point)))))
--- a/lisp/progmodes/fortran.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/fortran.el Wed Nov 17 13:09:08 2010 +0900 @@ -1315,8 +1315,7 @@ (if i (save-excursion (goto-char i) - (beginning-of-line) - (= (point) p))))) + (= (line-beginning-position) p))))) ;; Used in hs-special-modes-alist. (defun fortran-end-of-block (&optional num) @@ -2207,5 +2206,4 @@ (provide 'fortran) -;; arch-tag: 74935096-21c4-4cab-8ee5-6ef16090dc04 ;;; fortran.el ends here
--- a/lisp/progmodes/idlw-complete-structtag.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/idlw-complete-structtag.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; idlw-complete-structtag.el --- Completion of structure tags. -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Carsten Dominik <dominik@astro.uva.nl> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> @@ -225,9 +225,8 @@ ;; Fake help in the source buffer for structure tags. -;; kwd and name are global-variables here. -(defvar name) -(defvar kwd) +;; idlw-help-kwd is a global-variable (from idlwave-do-mouse-completion-help). +(defvar idlw-help-kwd) (defvar idlwave-help-do-struct-tag) (defun idlwave-complete-structure-tag-help (mode word) (cond @@ -236,13 +235,10 @@ (not (equal idlwave-current-tags-buffer (get-buffer (idlwave-shell-buffer))))) ((eq mode 'set) - (setq kwd word + (setq idlw-help-kwd word idlwave-help-do-struct-tag idlwave-structtag-struct-location)) (t (error "This should not happen")))) (provide 'idlw-complete-structtag) ;;; idlw-complete-structtag.el ends here - - -;; arch-tag: d1f9e55c-e504-4187-9c31-3c3651fa4bfa
--- a/lisp/progmodes/idlw-help.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/idlw-help.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; idlw-help.el --- HTML Help code for IDLWAVE -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; ;; Authors: J.D. Smith <jdsmith@as.arizona.edu> ;; Carsten Dominik <dominik@science.uva.nl> @@ -576,13 +576,13 @@ (let* ((cw (selected-window)) (info idlwave-completion-help-info) ; global passed in (what (nth 0 info)) - (name (nth 1 info)) + (idlw-help-name (nth 1 info)) (type (nth 2 info)) (class (nth 3 info)) (need-class class) - (kwd (nth 4 info)) + (idlw-help-kwd (nth 4 info)) (sclasses (nth 5 info)) - word link) + word idlw-help-link) (mouse-set-point ev) @@ -590,18 +590,18 @@ (setq word (idlwave-this-word)) (if (string= word "") (error "No help item selected")) - (setq link (get-text-property 0 'link word)) + (setq idlw-help-link (get-text-property 0 'link word)) (select-window cw) (cond ;; Routine name ((memq what '(procedure function routine)) - (setq name word) + (setq idlw-help-name word) (if (or (eq class t) (and (stringp class) sclasses)) (let* ((classes (idlwave-all-method-classes - (idlwave-sintern-method name) + (idlwave-sintern-method idlw-help-name) type))) - (setq link t) ; No specific link valid yet + (setq idlw-help-link t) ; No specific link valid yet (if sclasses (setq classes (idlwave-members-only classes (cons class sclasses)))) @@ -611,19 +611,19 @@ ;; XXX is this necessary, given all-method-classes? (if (stringp class) (setq class (idlwave-find-inherited-class - (idlwave-sintern-routine-or-method name class) + (idlwave-sintern-routine-or-method idlw-help-name class) type (idlwave-sintern-class class))))) ;; Keyword ((eq what 'keyword) - (setq kwd word) + (setq idlw-help-kwd word) (if (or (eq class t) (and (stringp class) sclasses)) (let ((classes (idlwave-all-method-keyword-classes - (idlwave-sintern-method name) - (idlwave-sintern-keyword kwd) + (idlwave-sintern-method idlw-help-name) + (idlwave-sintern-keyword idlw-help-kwd) type))) - (setq link t) ; Link can't be correct yet + (setq idlw-help-link t) ; Link can't be correct yet (if sclasses (setq classes (idlwave-members-only classes (cons class sclasses)))) @@ -632,11 +632,12 @@ ;; XXX is this necessary, given all-method-keyword-classes? (if (stringp class) (setq class (idlwave-find-inherited-class - (idlwave-sintern-routine-or-method name class) + (idlwave-sintern-routine-or-method + idlw-help-name class) type (idlwave-sintern-class class))))) - (if (string= (downcase name) "obj_new") + (if (string= (downcase idlw-help-name) "obj_new") (setq class idlwave-current-obj_new-class - name "Init")))) + idlw-help-name "Init")))) ;; Class name ((eq what 'class) @@ -649,9 +650,11 @@ (funcall what 'set word)) (t (error "Cannot help with this item"))) - (if (and need-class (not class) (not (and link (not (eq link t))))) + (if (and need-class (not class) + (not (and idlw-help-link (not (eq idlw-help-link t))))) (error "Cannot help with this item")) - (idlwave-online-help link (or name word) type class kwd))) + (idlwave-online-help idlw-help-link (or idlw-help-name word) + type class idlw-help-kwd))) (defvar idlwave-highlight-help-links-in-completion) (defvar idlwave-completion-help-links) @@ -1383,5 +1386,4 @@ (provide 'idlw-help) (provide 'idlwave-help) -;; arch-tag: d27b5505-59de-497f-ba3f-f199fd4fb911 ;;; idlw-help.el ends here
--- a/lisp/progmodes/idlw-shell.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/idlw-shell.el Wed Nov 17 13:09:08 2010 +0900 @@ -2180,8 +2180,8 @@ ;; Default completion of modules and keywords (idlwave-complete arg))))) -;; Get rid of opaque dynamic variable passing of link? -(defvar link) ;dynamic variable +;; Get rid of opaque dynamic variable passing of idlw-help-link? +(defvar idlw-help-link) ; dynamic variable from idlwave-do-mouse-completion-help (defun idlwave-shell-complete-execcomm-help (mode word) (let ((word (or (nth 1 idlwave-completion-help-info) word)) (entry (assoc-string word idlwave-executive-commands-alist t))) @@ -2189,7 +2189,7 @@ ((eq mode 'test) (and (stringp word) entry (cdr entry))) ((eq mode 'set) - (if entry (setq link (cdr entry)))) ;; setting dynamic variable!!! + (if entry (setq idlw-help-link (cdr entry)))) ; setting dynamic variable! (t (error "This should not happen"))))) (defun idlwave-shell-complete-filename (&optional arg) @@ -2591,9 +2591,7 @@ (list (idlwave-shell-file-name (buffer-file-name)) (save-restriction (widen) - (save-excursion - (beginning-of-line) - (1+ (count-lines 1 (point)))))))) + (1+ (count-lines 1 (point-at-bol))))))) (defun idlwave-shell-current-module () "Return the name of the module for the current file. @@ -3645,7 +3643,7 @@ (while (setq bp (pop bp-list)) (save-excursion (idlwave-shell-goto-frame (car bp)) - (let* ((end (progn (end-of-line 1) (point))) + (let* ((end (point-at-eol)) (beg (progn (beginning-of-line 1) (point))) (condition (idlwave-shell-bp-get bp 'condition)) (count (idlwave-shell-bp-get bp 'count)) @@ -3999,8 +3997,7 @@ (append ;; compiled procedures (progn - (beginning-of-line) - (narrow-to-region cpro (point)) + (narrow-to-region cpro (point-at-bol)) (goto-char (point-min)) (idlwave-shell-sources-grep)) ;; compiled functions
--- a/lisp/progmodes/idlwave.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/idlwave.el Wed Nov 17 13:09:08 2010 +0900 @@ -2097,7 +2097,7 @@ Moves to end of line if there is no comment delimiter. Ignores comment delimiters in strings. Returns point if comment found and nil otherwise." - (let ((eos (progn (end-of-line) (point))) + (let ((eos (point-at-eol)) (data (match-data)) found) ;; Look for first comment delimiter not in a string @@ -3310,10 +3310,7 @@ (setq fill-prefix-reg (concat (setq fill-prefix - (regexp-quote - (buffer-substring (save-excursion - (beginning-of-line) (point)) - (point)))) + (regexp-quote (buffer-substring (point-at-bol) (point)))) "[^;]")) ;; Mark the beginning and end of the paragraph @@ -3668,7 +3665,7 @@ ;; Because single and double quotes can quote each other we must ;; search for the string start from the beginning of line. (let* ((start (point)) - (eol (progn (end-of-line) (point))) + (eol (point-at-eol)) (bq (progn (beginning-of-line) (point))) (endq (point)) (data (match-data)) @@ -7662,7 +7659,7 @@ t)) ; return t to skip other completions (t nil)))) -(defvar link) ;dynamic variables set by help callback +(defvar idlw-help-link) ;dynamic variables set by help callback (defun idlwave-complete-sysvar-help (mode word) (let ((word (or (nth 1 idlwave-completion-help-info) word)) (entry (assoc word idlwave-system-variables-alist))) @@ -7670,7 +7667,8 @@ ((eq mode 'test) (and (stringp word) entry (nth 1 (assq 'link entry)))) ((eq mode 'set) - (if entry (setq link (nth 1 (assq 'link entry))))) ;; setting dynamic!!! + ;; Setting dynamic!!! + (if entry (setq idlw-help-link (nth 1 (assq 'link entry))))) (t (error "This should not happen"))))) (defun idlwave-complete-sysvar-tag-help (mode word) @@ -7684,10 +7682,10 @@ (and (stringp word) entry main)) ((eq mode 'set) (if entry - (setq link + (setq idlw-help-link (if (setq target (cdr (assoc-string word tags t))) - (idlwave-substitute-link-target main target) - main)))) ;; setting dynamic!!! + (idlwave-substitute-link-target main target) + main)))) ;; setting dynamic!!! (t (error "This should not happen"))))) (defun idlwave-split-link-target (link) @@ -7707,9 +7705,10 @@ link))) ;; Fake help in the source buffer for class structure tags. -;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. -(defvar name) -(defvar kwd) +;; IDLW-HELP-LINK AND IDLW-HELP-NAME ARE GLOBAL-VARIABLES HERE. +;; (from idlwave-do-mouse-completion-help) +(defvar idlw-help-name) +(defvar idlw-help-link) (defvar idlwave-help-do-class-struct-tag nil) (defun idlwave-complete-class-structure-tag-help (mode word) (cond @@ -7725,9 +7724,9 @@ idlwave-system-class-info) (error "No help available for system class tags")) (if (setq found-in (idlwave-class-found-in class-with)) - (setq name (cons (concat found-in "__define") class-with)) - (setq name (concat class-with "__define"))))) - (setq kwd word + (setq idlw-help-name (cons (concat found-in "__define") class-with)) + (setq idlw-help-name (concat class-with "__define"))))) + (setq idlw-help-link word idlwave-help-do-class-struct-tag t)) (t (error "This should not happen")))) @@ -8805,7 +8804,7 @@ non-dangerous because many IDL routines are implemented as library routines, and may have been scanned." (let* ((entry (car entries)) - (name (car entry)) ; + (idlwave-twin-name (car entry)) ; (type (nth 1 entry)) ; Must be bound for (idlwave-twin-class (nth 2 entry)) ; idlwave-routine-twin-compare (cnt 0) @@ -8881,7 +8880,7 @@ (defun idlwave-routine-entry-compare-twins (a b) "Compare two routine entries, under the assumption that they are twins. This basically calls `idlwave-routine-twin-compare' with the correct args." - (let* ((name (car a)) + (let* ((idlwave-twin-name (car a)) (type (nth 1 a)) (idlwave-twin-class (nth 2 a)) ; used in idlwave-routine-twin-compare (asrc (nth 3 a)) @@ -8900,6 +8899,7 @@ ;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins. (defvar idlwave-twin-class) +(defvar idlwave-twin-name) (defun idlwave-routine-twin-compare (a b) "Compare two routine twin entries for sorting. @@ -8940,8 +8940,8 @@ (fname-re (if idlwave-twin-class (format "\\`%s__\\(%s\\|define\\)\\.pro\\'" (regexp-quote (downcase idlwave-twin-class)) - (regexp-quote (downcase name))) - (format "\\`%s\\.pro" (regexp-quote (downcase name))))) + (regexp-quote (downcase idlwave-twin-name))) + (format "\\`%s\\.pro" (regexp-quote (downcase idlwave-twin-name))))) ;; Is file name derived from the routine name? ;; Method file or class definition file? (anamep (string-match fname-re aname))
--- a/lisp/progmodes/meta-mode.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/meta-mode.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Ulrik Vieth <vieth@thphy.uni-duesseldorf.de> ;; Version: 1.0 @@ -517,24 +517,24 @@ ;;; Indentation. (defcustom meta-indent-level 2 - "*Indentation of begin-end blocks in Metafont or MetaPost mode." + "Indentation of begin-end blocks in Metafont or MetaPost mode." :type 'integer :group 'meta-font) (defcustom meta-left-comment-regexp "%%+" - "*Regexp matching comments that should be placed on the left margin." + "Regexp matching comments that should be placed on the left margin." :type 'regexp :group 'meta-font) (defcustom meta-right-comment-regexp nil - "*Regexp matching comments that should be placed to the right margin." + "Regexp matching comments that should be placed to the right margin." :type '(choice regexp (const :tag "None" nil)) :group 'meta-font) (defcustom meta-ignore-comment-regexp "%[^%]" - "*Regexp matching comments that whose indentation should not be touched." + "Regexp matching comments that whose indentation should not be touched." :type 'regexp :group 'meta-font) @@ -543,21 +543,21 @@ (concat "\\(begin\\(char\\|fig\\|gr\\(aph\\|oup\\)\\|logochar\\)\\|" "def\\|for\\(\\|ever\\|suffixes\\)\\|if\\|mode_def\\|" "primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)") - "*Regexp matching the beginning of environments to be indented." + "Regexp matching the beginning of environments to be indented." :type 'regexp :group 'meta-font) (defcustom meta-end-environment-regexp (concat "\\(end\\(char\\|def\\|f\\(ig\\|or\\)\\|gr\\(aph\\|oup\\)\\)" "\\|fi\\)") - "*Regexp matching the end of environments to be indented." + "Regexp matching the end of environments to be indented." :type 'regexp :group 'meta-font) (defcustom meta-within-environment-regexp ; (concat "\\(e\\(lse\\(\\|if\\)\\|xit\\(if\\|unless\\)\\)\\)") (concat "\\(else\\(\\|if\\)\\)") - "*Regexp matching keywords within environments not to be indented." + "Regexp matching keywords within environments not to be indented." :type 'regexp :group 'meta-font) @@ -575,12 +575,11 @@ "Indent the line containing point as Metafont or MetaPost source." (interactive) (let ((indent (meta-indent-calculate))) - (save-excursion - (if (/= (current-indentation) indent) - (let ((beg (progn (beginning-of-line) (point))) - (end (progn (back-to-indentation) (point)))) - (delete-region beg end) - (indent-to indent)))) + (if (/= (current-indentation) indent) + (save-excursion + (delete-region (line-beginning-position) + (progn (back-to-indentation) (point))) + (indent-to indent))) (if (< (current-column) indent) (back-to-indentation)))) @@ -744,13 +743,13 @@ (defcustom meta-begin-defun-regexp (concat "\\(begin\\(char\\|fig\\|logochar\\)\\|def\\|mode_def\\|" "primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)") - "*Regexp matching beginning of defuns in Metafont or MetaPost mode." + "Regexp matching beginning of defuns in Metafont or MetaPost mode." :type 'regexp :group 'meta-font) (defcustom meta-end-defun-regexp (concat "\\(end\\(char\\|def\\|fig\\)\\)") - "*Regexp matching the end of defuns in Metafont or MetaPost mode." + "Regexp matching the end of defuns in Metafont or MetaPost mode." :type 'regexp :group 'meta-font) @@ -955,21 +954,21 @@ ;;; Hook variables. (defcustom meta-mode-load-hook nil - "*Hook evaluated when first loading Metafont or MetaPost mode." + "Hook evaluated when first loading Metafont or MetaPost mode." :type 'hook :group 'meta-font) (defcustom meta-common-mode-hook nil - "*Hook evaluated by both `metafont-mode' and `metapost-mode'." + "Hook evaluated by both `metafont-mode' and `metapost-mode'." :type 'hook :group 'meta-font) (defcustom metafont-mode-hook nil - "*Hook evaluated by `metafont-mode' after `meta-common-mode-hook'." + "Hook evaluated by `metafont-mode' after `meta-common-mode-hook'." :type 'hook :group 'meta-font) (defcustom metapost-mode-hook nil - "*Hook evaluated by `metapost-mode' after `meta-common-mode-hook'." + "Hook evaluated by `metapost-mode' after `meta-common-mode-hook'." :type 'hook :group 'meta-font) @@ -1084,5 +1083,4 @@ (provide 'meta-mode) (run-hooks 'meta-mode-load-hook) -;; arch-tag: ec2916b2-3a83-4cf7-962d-d8019370c006 ;;; meta-mode.el ends here
--- a/lisp/progmodes/modula2.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/modula2.el Wed Nov 17 13:09:08 2010 +0900 @@ -22,6 +22,8 @@ ;;; Code: +(require 'smie) + (defgroup modula2 nil "Major mode for editing Modula-2 code." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) @@ -29,7 +31,22 @@ :group 'languages) ;;; Added by Tom Perrine (TEP) -(defvar m2-mode-syntax-table nil +(defvar m2-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?/ ". 12" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\( "()1" table) + (modify-syntax-entry ?\) ")(4" table) + (modify-syntax-entry ?* ". 23nb" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?\' "\"" table) + table) "Syntax table in use in Modula-2 buffers.") (defcustom m2-compile-command "m2c" @@ -52,26 +69,10 @@ :type 'integer :group 'modula2) -(if m2-mode-syntax-table - () - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?\( ". 1" table) - (modify-syntax-entry ?\) ". 4" table) - (modify-syntax-entry ?* ". 23" table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?% "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?\' "\"" table) - (setq m2-mode-syntax-table table))) - ;;; Added by TEP (defvar m2-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\^i" 'm2-tab) + ;; FIXME: Many of those bindings are contrary to coding conventions. (define-key map "\C-cb" 'm2-begin) (define-key map "\C-cc" 'm2-case) (define-key map "\C-cd" 'm2-definition) @@ -94,7 +95,6 @@ (define-key map "\C-cy" 'm2-import) (define-key map "\C-c{" 'm2-begin-comment) (define-key map "\C-c}" 'm2-end-comment) - (define-key map "\C-j" 'm2-newline) (define-key map "\C-c\C-z" 'suspend-emacs) (define-key map "\C-c\C-v" 'm2-visit) (define-key map "\C-c\C-t" 'm2-toggle) @@ -107,9 +107,185 @@ "*This variable gives the indentation in Modula-2-Mode." :type 'integer :group 'modula2) +(put 'm2-indent 'safe-local-variable + (lambda (v) (or (null v) (integerp v)))) + +(defconst m2-smie-grammar + ;; An official definition can be found as "M2R10.pdf". This grammar does + ;; not really follow it, for lots of technical reasons, but it can still be + ;; useful to refer to it. + (smie-prec2->grammar + (smie-merge-prec2s + (smie-bnf->prec2 + '((range) (id) (epsilon) + (fields (fields ";" fields) (ids ":" type)) + (proctype (id ":" type)) + (type ("RECORD" fields "END") + ("POINTER" "TO" type) + ;; The PROCEDURE type is indistinguishable from the beginning + ;; of a PROCEDURE definition, so we need a "PROCEDURE-type" to + ;; prevent SMIE from trying to find the matching END. + ("PROCEDURE-type" proctype) + ;; OF's right hand side should bind tighter than ; for array + ;; types, but should bind less tight than | which itself binds + ;; less tight than ;. So we use two distinct OFs. + ("SET" "OF-type" id) + ("ARRAY" range "OF-type" type)) + (args ("(" fargs ")")) + ;; VAR has lower precedence than ";" in formal args, but not + ;; in declarations. So we use "VAR-arg" for the formal arg case. + (farg (ids ":" type) ("CONST-arg" farg) ("VAR-arg" farg)) + (fargs (fargs ";" fargs) (farg)) + ;; Handling of PROCEDURE in decls is problematic: we'd want + ;; TYPE/CONST/VAR/PROCEDURE's parent to be any previous + ;; CONST/TYPE/VAR/PROCEDURE, but we also want PROCEDURE to be an opener + ;; (so that its END has PROCEDURE as its parent). So instead, we treat + ;; the last ";" in those blocks as a separator (we call it ";-block"). + ;; FIXME: This means that "TYPE \n VAR" is not indented properly + ;; because there's no ";-block" between the two. + (decls (decls ";-block" decls) + ("TYPE" typedecls) ("CONST" constdecls) ("VAR" vardecls) + ;; END is usually a closer, but not quite for PROCEDURE...END. + ;; We could use "END-proc" for the procedure case, but + ;; I preferred to just pretend PROCEDURE's END is the closer. + ("PROCEDURE" decls "BEGIN" insts "END") ;END-proc id + ("PROCEDURE" decls "BEGIN" insts "FINALLY" insts "END") + ("PROCEDURE" decls "FORWARD") + ;; ("IMPLEMENTATION" epsilon "MODULE" decls + ;; "BEGIN" insts "FINALLY" insts "END") + ) + (typedecls (typedecls ";" typedecls) (id "=" type)) + (ids (ids "," ids)) + (vardecls (vardecls ";" vardecls) (ids ":" type)) + (constdecls (constdecls ";" constdecls) (id "=" exp)) + (exp (id "-anchor-" id) ("(" exp ")")) + (caselabel (caselabel ".." caselabel) (caselabel "," caselabel)) + ;; : for types binds tighter than ;, but the : for case labels binds + ;; less tight, so have to use two different :. + (cases (cases "|" cases) (caselabel ":-case" insts)) + (forspec (exp "TO" exp)) + (insts (insts ";" insts) + (id ":=" exp) + ("CASE" exp "OF" cases "END") + ("CASE" exp "OF" cases "ELSE" insts "END") + ("LOOP" insts "END") + ("WITH" exp "DO" insts "END") + ("REPEAT" insts "UNTIL" exp) + ("WHILE" exp "DO" insts "END") + ("FOR" forspec "DO" insts "END") + ("IF" exp "THEN" insts "END") + ("IF" exp "THEN" insts "ELSE" insts "END") + ("IF" exp "THEN" insts + "ELSIF" exp "THEN" insts "ELSE" insts "END") + ("IF" exp "THEN" insts + "ELSIF" exp "THEN" insts + "ELSIF" exp "THEN" insts "ELSE" insts "END")) + ;; This category is not used anywhere, but it adds some constraints that + ;; try to reduce the harm when an OF-type is not properly recognized. + (error-OF ("ARRAY" range "OF" type) ("SET" "OF" id))) + '((assoc ";")) '((assoc ";-block")) '((assoc "|")) + ;; For case labels. + '((assoc ",") (assoc "..")) + ;; '((assoc "TYPE" "CONST" "VAR" "PROCEDURE")) + ) + (smie-precs->prec2 + '((nonassoc "-anchor-" "=") + (nonassoc "<" "<=" ">=" ">" "<>" "#" "IN") + (assoc "OR" "+" "-") + (assoc "AND" "MOD" "DIV" "REM" "*" "/" "&") + (nonassoc "NOT" "~") + (left "." "^") + )) + ))) + +(defun m2-smie-refine-colon () + (let ((res nil)) + (while (not res) + (let ((tok (smie-default-backward-token))) + (cond + ((zerop (length tok)) + (let ((forward-sexp-function nil)) + (condition-case nil + (forward-sexp -1) + (scan-error (setq res ":"))))) + ((member tok '("|" "OF" "..")) (setq res ":-case")) + ((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE")) + (setq res ":"))))) + res)) + +(defun m2-smie-refine-of () + (let ((tok (smie-default-backward-token))) + (when (zerop (length tok)) + (let ((forward-sexp-function nil)) + (condition-case nil + (backward-sexp 1) + (scan-error nil)) + (setq tok (smie-default-backward-token)))) + (if (member tok '("ARRAY" "SET")) + "OF-type" "OF"))) + +(defun m2-smie-refine-semi () + (forward-comment (point-max)) + (if (looking-at (regexp-opt '("PROCEDURE" "TYPE" "VAR" "CONST" "BEGIN"))) + ";-block" ";")) + +;; FIXME: "^." are two tokens, not one. +(defun m2-smie-forward-token () + (pcase (smie-default-forward-token) + (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) + (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) + (`";" (save-excursion (m2-smie-refine-semi))) + (`"OF" (save-excursion (forward-char -2) (m2-smie-refine-of))) + (`":" (save-excursion (forward-char -1) (m2-smie-refine-colon))) + ;; (`"END" (if (and (looking-at "[ \t\n]*\\(\\(?:\\sw\\|\\s_\\)+\\)") + ;; (not (assoc (match-string 1) m2-smie-grammar))) + ;; "END-proc" "END")) + (token token))) + +(defun m2-smie-backward-token () + (pcase (smie-default-backward-token) + (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) + (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) + (`";" (save-excursion (forward-char 1) (m2-smie-refine-semi))) + (`"OF" (save-excursion (m2-smie-refine-of))) + (`":" (save-excursion (m2-smie-refine-colon))) + ;; (`"END" (if (and (looking-at "\\sw+[ \t\n]+\\(\\(?:\\sw\\|\\s_\\)+\\)") + ;; (not (assoc (match-string 1) m2-smie-grammar))) + ;; "END-proc" "END")) + (token token))) + +(defun m2-smie-rules (kind token) + ;; FIXME: Apparently, the usual indentation convention is something like: + ;; + ;; TYPE t1 = bar; + ;; VAR x : INTEGER; + ;; PROCEDURE f (); + ;; TYPE t2 = foo; + ;; PROCEDURE g (); + ;; BEGIN blabla END; + ;; VAR y : type; + ;; BEGIN blibli END + ;; + ;; This is inconsistent with the actual structure of the code in 2 ways: + ;; - The inner VAR/TYPE are indented just like the outer VAR/TYPE. + ;; - The inner PROCEDURE is not aligned with its VAR/TYPE siblings. + (pcase (cons kind token) + (`(:elem . basic) m2-indent) + (`(:after . ":=") (or m2-indent smie-indent-basic)) + (`(:after . ,(or `"CONST" `"VAR" `"TYPE")) + (or m2-indent smie-indent-basic)) + ;; (`(:before . ,(or `"VAR" `"TYPE" `"CONST")) + ;; (if (smie-rule-parent-p "PROCEDURE") 0)) + (`(:after . ";-block") + (if (smie-rule-parent-p "PROCEDURE") + (smie-rule-parent (or m2-indent smie-indent-basic)))) + (`(:before . "|") (smie-rule-separator kind)) + )) ;;;###autoload -(defun modula-2-mode () +(defalias 'modula-2-mode 'm2-mode) +;;;###autoload +(define-derived-mode m2-mode prog-mode "Modula-2" "This is a mode intended to support program development in Modula-2. All control constructs of Modula-2 can be reached by typing C-c followed by the first character of the construct. @@ -132,46 +308,23 @@ `m2-indent' controls the number of spaces for each indentation. `m2-compile-command' holds the command to compile a Modula-2 program. `m2-link-command' holds the command to link a Modula-2 program." - (interactive) - (kill-all-local-variables) - (use-local-map m2-mode-map) - (setq major-mode 'modula-2-mode) - (setq mode-name "Modula-2") - (make-local-variable 'comment-column) - (setq comment-column 41) (make-local-variable 'm2-end-comment-column) - (set-syntax-table m2-mode-syntax-table) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) -; (make-local-variable 'indent-line-function) -; (setq indent-line-function 'c-indent-line) - (make-local-variable 'require-final-newline) - (setq require-final-newline mode-require-final-newline) - (make-local-variable 'comment-start) - (setq comment-start "(* ") - (make-local-variable 'comment-end) - (setq comment-end " *)") - (make-local-variable 'comment-column) - (setq comment-column 41) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "/\\*+ *") - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'c-comment-indent) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults + + (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'paragraph-ignore-fill-prefix) t) + (set (make-local-variable 'comment-start) "(* ") + (set (make-local-variable 'comment-end) " *)") + (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *") + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'font-lock-defaults) '((m3-font-lock-keywords m3-font-lock-keywords-1 m3-font-lock-keywords-2) nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil - ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP. - ;(font-lock-comment-start-regexp . "(\\*") )) - (run-mode-hooks 'm2-mode-hook)) + (smie-setup m2-smie-grammar #'m2-smie-rules + :forward-token #'m2-smie-forward-token + :backward-token #'m2-smie-backward-token)) ;; Regexps written with help from Ron Forrester <ron@orcad.com> ;; and Spencer Allain <sallain@teknowledge.com>. @@ -257,231 +410,131 @@ (defvar m2-font-lock-keywords m2-font-lock-keywords-1 "Default expressions to highlight in Modula-2 modes.") -(defun m2-newline () - "Insert a newline and indent following line like previous line." - (interactive) - (let ((hpos (current-indentation))) - (newline) - (indent-to hpos))) +(define-skeleton m2-begin + "Insert a BEGIN keyword and indent for the next line." + nil + \n "BEGIN" > \n) -(defun m2-tab () - "Indent to next tab stop." - (interactive) - (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent))) - -(defun m2-begin () - "Insert a BEGIN keyword and indent for the next line." - (interactive) - (insert "BEGIN") - (m2-newline) - (m2-tab)) - -(defun m2-case () +(define-skeleton m2-case "Build skeleton CASE statement, prompting for the <expression>." - (interactive) - (let ((name (read-string "Case-Expression: "))) - (insert "CASE " name " OF") - (m2-newline) - (m2-newline) - (insert "END (* case " name " *);")) - (end-of-line 0) - (m2-tab)) + "Case-Expression: " + \n "CASE " str " OF" > \n _ \n "END (* " str " *);" > \n) -(defun m2-definition () +(define-skeleton m2-definition "Build skeleton DEFINITION MODULE, prompting for the <module name>." - (interactive) - (insert "DEFINITION MODULE ") - (let ((name (read-string "Name: "))) - (insert name ";\n\n\n\nEND " name ".\n")) - (forward-line -3)) + "Name: " + \n "DEFINITION MODULE " str ";" > \n \n _ \n \n "END " str "." > \n) -(defun m2-else () +(define-skeleton m2-else "Insert ELSE keyword and indent for next line." - (interactive) - (m2-newline) - (backward-delete-char-untabify m2-indent ()) - (insert "ELSE") - (m2-newline) - (m2-tab)) + nil + \n "ELSE" > \n) -(defun m2-for () +(define-skeleton m2-for "Build skeleton FOR loop statement, prompting for the loop parameters." - (interactive) - (insert "FOR ") - (let ((name (read-string "Loop Initializer: ")) limit by) - (insert name " TO ") - (setq limit (read-string "Limit: ")) - (insert limit) - (setq by (read-string "Step: ")) + "Loop Initializer: " + ;; FIXME: this seems to be lacking a "<var> :=". + \n "FOR " str " TO " + (setq v1 (read-string "Limit: ")) + (let ((by (read-string "Step: "))) (if (not (string-equal by "")) - (insert " BY " by)) - (insert " DO") - (m2-newline) - (m2-newline) - (insert "END (* for " name " to " limit " *);")) - (end-of-line 0) - (m2-tab)) + (concat " BY " by))) + " DO" > \n _ \n "END (* for " str " to " v1 " *);" > \n) -(defun m2-header () +(define-skeleton m2-header "Insert a comment block containing the module title, author, etc." - (interactive) - (insert "(*\n Title: \t") - (insert (read-string "Title: ")) - (insert "\n Created:\t") - (insert (current-time-string)) - (insert "\n Author: \t") - (insert (user-full-name)) - (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n")) - (insert "*)\n\n")) + "Title: " + "(*\n Title: \t" str + "\n Created: \t" (current-time-string) + "\n Author: \t" (user-full-name) " <" user-mail-address ">\n" + "*)" > \n) -(defun m2-if () +(define-skeleton m2-if "Insert skeleton IF statement, prompting for <boolean-expression>." - (interactive) - (insert "IF ") - (let ((thecondition (read-string "<boolean-expression>: "))) - (insert thecondition " THEN") - (m2-newline) - (m2-newline) - (insert "END (* if " thecondition " *);")) - (end-of-line 0) - (m2-tab)) + "<boolean-expression>: " + \n "IF " str " THEN" > \n _ \n "END (* if " str " *);" > \n) -(defun m2-loop () +(define-skeleton m2-loop "Build skeleton LOOP (with END)." - (interactive) - (insert "LOOP") - (m2-newline) - (m2-newline) - (insert "END (* loop *);") - (end-of-line 0) - (m2-tab)) + nil + \n "LOOP" > \n _ \n "END (* loop *);" > \n) -(defun m2-module () +(define-skeleton m2-module "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>." - (interactive) - (insert "IMPLEMENTATION MODULE ") - (let ((name (read-string "Name: "))) - (insert name ";\n\n\n\nEND " name ".\n") - (forward-line -3) - (m2-header) - (m2-type) - (newline) - (m2-var) - (newline) - (m2-begin) - (m2-begin-comment) - (insert " Module " name " Initialisation Code ")) - (m2-end-comment) - (newline) - (m2-tab)) + "Name: " + \n "IMPLEMENTATION MODULE " str ";" > \n \n + '(m2-header) + '(m2-type) \n + '(m2-var) \n _ \n \n + '(m2-begin) + '(m2-begin-comment) + " Module " str " Initialisation Code " + '(m2-end-comment) + \n \n "END " str "." > \n) -(defun m2-or () - (interactive) - (m2-newline) - (backward-delete-char-untabify m2-indent) - (insert "|") - (m2-newline) - (m2-tab)) +(define-skeleton m2-or + "No doc." + nil + \n "|" > \n) -(defun m2-procedure () - (interactive) - (insert "PROCEDURE ") - (let ((name (read-string "Name: " )) - args) - (insert name " (") - (insert (read-string "Arguments: ") ")") - (setq args (read-string "Result Type: ")) - (if (not (string-equal args "")) - (insert " : " args)) - (insert ";") - (m2-newline) - (insert "BEGIN") - (m2-newline) - (m2-newline) - (insert "END ") - (insert name) - (insert ";") - (end-of-line 0) - (m2-tab))) +(define-skeleton m2-procedure + "No doc." + "Name: " + \n "PROCEDURE " str " (" (read-string "Arguments: ") ")" + (let ((args (read-string "Result Type: "))) + (if (not (equal args "")) (concat " : " args))) + ";" > \n "BEGIN" > \n _ \n "END " str ";" > \n) -(defun m2-with () - (interactive) - (insert "WITH ") - (let ((name (read-string "Record-Type: "))) - (insert name) - (insert " DO") - (m2-newline) - (m2-newline) - (insert "END (* with " name " *);")) - (end-of-line 0) - (m2-tab)) +(define-skeleton m2-with + "No doc." + "Record-Type: " + \n "WITH " str " DO" > \n _ \n "END (* with " str " *);" > \n) + +(define-skeleton m2-record + "No doc." + nil + \n "RECORD" > \n _ \n "END (* record *);" > \n) -(defun m2-record () - (interactive) - (insert "RECORD") - (m2-newline) - (m2-newline) - (insert "END (* record *);") - (end-of-line 0) - (m2-tab)) +(define-skeleton m2-stdio + "No doc." + nil + \n "FROM TextIO IMPORT" + > \n "WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER," + > \n "WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN," + > \n "WriteREAL, ReadREAL, WriteBITSET, ReadBITSET," + > \n "WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars," + > \n "WriteString, ReadString, WhiteSpace, EndOfLine;" + > \n \n "FROM SysStreams IMPORT sysIn, sysOut, sysErr;" > \n \n) -(defun m2-stdio () - (interactive) - (insert " -FROM TextIO IMPORT - WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER, - WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN, - WriteREAL, ReadREAL, WriteBITSET, ReadBITSET, - WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars, - WriteString, ReadString, WhiteSpace, EndOfLine; - -FROM SysStreams IMPORT sysIn, sysOut, sysErr; - -")) - -(defun m2-type () - (interactive) - (insert "TYPE") - (m2-newline) - (m2-tab)) +(define-skeleton m2-type + "No doc." + nil + \n "TYPE" > \n ";" > \n) -(defun m2-until () - (interactive) - (insert "REPEAT") - (m2-newline) - (m2-newline) - (insert "UNTIL ") - (insert (read-string "<boolean-expression>: ") ";") - (end-of-line 0) - (m2-tab)) +(define-skeleton m2-until + "No doc." + "<boolean-expression>: " + \n "REPEAT" > \n _ \n "UNTIL " str ";" > \n) -(defun m2-var () - (interactive) - (m2-newline) - (insert "VAR") - (m2-newline) - (m2-tab)) +(define-skeleton m2-var + "No doc." + nil + \n "VAR" > \n ";" > \n) -(defun m2-while () - (interactive) - (insert "WHILE ") - (let ((name (read-string "<boolean-expression>: "))) - (insert name " DO" ) - (m2-newline) - (m2-newline) - (insert "END (* while " name " *);")) - (end-of-line 0) - (m2-tab)) +(define-skeleton m2-while + "No doc." + "<boolean-expression>: " + \n "WHILE " str " DO" > \n _ \n "END (* while " str " *);" > \n) -(defun m2-export () - (interactive) - (insert "EXPORT QUALIFIED ")) +(define-skeleton m2-export + "No doc." + nil + \n "EXPORT QUALIFIED " > _ \n) -(defun m2-import () - (interactive) - (insert "FROM ") - (insert (read-string "Module: ")) - (insert " IMPORT ")) +(define-skeleton m2-import + "No doc." + "Module: " + \n "FROM " str " IMPORT " > _ \n) (defun m2-begin-comment () (interactive) @@ -501,15 +554,15 @@ (defun m2-link () (interactive) - (if m2-link-name - (compile (concat m2-link-command " " m2-link-name)) - (compile (concat m2-link-command " " - (setq m2-link-name (read-string "Name of executable: " - (buffer-name))))))) + (compile (concat m2-link-command " " + (or m2-link-name + (setq m2-link-name (read-string "Name of executable: " + (buffer-name))))))) (defun m2-execute-monitor-command (command) (let* ((shell shell-file-name) - (csh (equal (file-name-nondirectory shell) "csh"))) + ;; (csh (equal (file-name-nondirectory shell) "csh")) + ) (call-process shell nil t t "-cf" (concat "exec " command)))) (defun m2-visit ()
--- a/lisp/progmodes/octave-mod.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/octave-mod.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; octave-mod.el --- editing Octave source files under Emacs -;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ;; Author: John Eaton <jwe@octave.org> @@ -212,9 +212,6 @@ (defvar octave-mode-map (let ((map (make-sparse-keymap))) (define-key map "`" 'octave-abbrev-start) - (define-key map ";" 'octave-electric-semi) - (define-key map " " 'octave-electric-space) - (define-key map "\n" 'octave-reindent-then-newline-and-indent) (define-key map "\e\n" 'octave-indent-new-comment-line) (define-key map "\M-\C-q" 'octave-indent-defun) (define-key map "\C-c\C-b" 'octave-submit-bug-report) @@ -319,16 +316,6 @@ table) "Syntax table in use in `octave-mode' buffers.") -(defcustom octave-auto-indent nil - "Non-nil means indent line after a semicolon or space in Octave mode." - :type 'boolean - :group 'octave) - -(defcustom octave-auto-newline nil - "Non-nil means automatically newline after a semicolon in Octave mode." - :type 'boolean - :group 'octave) - (defcustom octave-blink-matching-block t "Control the blinking of matching Octave block keywords. Non-nil means show matching begin of block when inserting a space, @@ -536,7 +523,7 @@ ;; (if (smie-parent-p "switch") 4) 0)))) -(defvar electric-indent-chars) +(defvar electric-layout-rules) ;;;###autoload (define-derived-mode octave-mode prog-mode "Octave" @@ -567,14 +554,6 @@ Variables you can use to customize Octave mode ============================================== -`octave-auto-indent' - Non-nil means indent current line after a semicolon or space. - Default is nil. - -`octave-auto-newline' - Non-nil means auto-insert a newline and indent after a semicolon. - Default is nil. - `octave-blink-matching-block' Non-nil means show matching begin of block when inserting a space, newline or semicolon after an else or end keyword. Default is t. @@ -636,6 +615,9 @@ (set (make-local-variable 'electric-indent-chars) (cons ?\; electric-indent-chars)) + ;; IIUC matlab-mode takes the opposite approach: it makes RET insert + ;; a ";" at those places where it's correct (i.e. outside of parens). + (set (make-local-variable 'electric-layout-rules) '((?\; . after))) (set (make-local-variable 'comment-start) octave-comment-start) (set (make-local-variable 'comment-end) "") @@ -736,7 +718,7 @@ (error "Cannot split a code line inside a string")) (t (insert (concat " " octave-continuation-string)) - (octave-reindent-then-newline-and-indent)))) + (reindent-then-newline-and-indent)))) (defun octave-indent-defun () "Properly indent the Octave function which contains point." @@ -829,7 +811,7 @@ (unless (or (looking-at "\\s(") (save-excursion (let* ((token (funcall smie-forward-token-function)) - (level (assoc token smie-op-levels))) + (level (assoc token smie-grammar))) (and level (null (cadr level)))))) (backward-up-list 1)) (mark-sexp)) @@ -1017,45 +999,6 @@ (apply 'completion-in-region (octave-completion-at-point-function))) ;;; Electric characters && friends -(defun octave-reindent-then-newline-and-indent () - "Reindent current Octave line, insert newline, and indent the new line. -If Abbrev mode is on, expand abbrevs first." - ;; FIXME: None of this is Octave-specific. - (interactive) - (reindent-then-newline-and-indent)) - -(defun octave-electric-semi () - "Insert a semicolon in Octave mode. -Maybe expand abbrevs and blink matching block open keywords. -Reindent the line if `octave-auto-indent' is non-nil. -Insert a newline if `octave-auto-newline' is non-nil." - (interactive) - (setq last-command-event ?\;) - (if (not (octave-not-in-string-or-comment-p)) - (self-insert-command 1) - (if octave-auto-indent - (indent-according-to-mode)) - (self-insert-command 1) - (if octave-auto-newline - (newline-and-indent)))) - -(defun octave-electric-space () - "Insert a space in Octave mode. -Maybe expand abbrevs and blink matching block open keywords. -Reindent the line if `octave-auto-indent' is non-nil." - (interactive) - (setq last-command-event ? ) - (if (and octave-auto-indent - (not (octave-not-in-string-or-comment-p))) - (progn - (indent-according-to-mode) - (self-insert-command 1)) - (if (and octave-auto-indent - (save-excursion - (skip-syntax-backward " ") - (not (bolp)))) - (indent-according-to-mode)) - (self-insert-command 1))) (defun octave-abbrev-start () "Start entering an Octave abbreviation. @@ -1213,8 +1156,6 @@ octave-maintainer-address (concat "Emacs version " emacs-version) (list - 'octave-auto-indent - 'octave-auto-newline 'octave-blink-matching-block 'octave-block-offset 'octave-comment-char @@ -1228,5 +1169,4 @@ (provide 'octave-mod) -;; arch-tag: 05f1ce09-be87-4c00-803e-4919ffa26c23 ;;; octave-mod.el ends here
--- a/lisp/progmodes/python.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/python.el Wed Nov 17 13:09:08 2010 +0900 @@ -171,21 +171,9 @@ ;; string delimiters. Fixme: Is there a better way? ;; First avoid a sequence preceded by an odd number of backslashes. (syntax-propertize-rules - (;; (rx (not (any ?\\)) - ;; ?\\ (* (and ?\\ ?\\)) - ;; (group (syntax string-quote)) - ;; (backref 1) - ;; (group (backref 1))) - ;; ¡Backrefs don't work in syntax-propertize-rules! - "[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)" - (2 "\"")) ; dummy - (;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property - ;; (optional (any "rR")) ; possible second prefix - ;; (group (syntax string-quote)) ; maybe gets property - ;; (backref 2) ; per first quote - ;; (group (backref 2))) ; maybe gets property - ;; ¡Backrefs don't work in syntax-propertize-rules! - "\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)" + (;; ¡Backrefs don't work in syntax-propertize-rules! + (concat "\\(?:\\([RUru]\\)[Rr]?\\|^\\|[^\\]\\(?:\\\\.\\)*\\)" ;Prefix. + "\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)") (3 (ignore (python-quote-syntax)))) ;; This doesn't really help. ;;((rx (and ?\\ (group ?\n))) (1 " "))
--- a/lisp/progmodes/sh-script.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/sh-script.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,8 @@ ;;; sh-script.el --- shell-script editing commands for Emacs ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer <occitan@esperanto.org> ;; Version: 2.0f @@ -2136,11 +2137,7 @@ (defun sh-handle-prev-do () (cond ((save-restriction - (narrow-to-region - (point) - (save-excursion - (beginning-of-line) - (point))) + (narrow-to-region (point) (line-beginning-position)) (sh-goto-match-for-done)) (sh-debug "match for done found on THIS line") (list '(+ sh-indent-after-loop-construct))) @@ -3840,5 +3837,4 @@ (provide 'sh-script) -;; arch-tag: eccd8b72-f337-4fc2-ae86-18155a69d937 ;;; sh-script.el ends here
--- a/lisp/progmodes/tcl.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/tcl.el Wed Nov 17 13:09:08 2010 +0900 @@ -607,15 +607,11 @@ (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "[$!]") (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|\\s_") - ;; This can only be set to t in Emacs 19 and XEmacs. - ;; Emacs 18 and Epoch lose. (set (make-local-variable 'parse-sexp-ignore-comments) t) ;; XEmacs has defun-prompt-regexp, but I don't believe ;; that it works for end-of-defun -- only for ;; beginning-of-defun. (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp) - ;; The following doesn't work in Lucid Emacs 19.6, but maybe - ;; it will appear in later versions. (set (make-local-variable 'add-log-current-defun-function) 'tcl-add-log-defun) @@ -1201,15 +1197,10 @@ "Determine if point is in a comment. Returns a list of the form `(FLAG . STATE)'. STATE can be used as input to future invocations. FLAG is nil if not in comment, -t otherwise. If in comment, leaves point at beginning of comment. - -This function does not work in Emacs 18. -See also `tcl-simple-scan-for-comment', a -simpler version that is often right, and works in Emacs 18." +t otherwise. If in comment, leaves point at beginning of comment." (let ((bol (save-excursion (goto-char end) - (beginning-of-line) - (point))) + (line-beginning-position))) real-comment last-cstart) (while (and (not last-cstart) (< (point) end)) @@ -1557,5 +1548,4 @@ (provide 'tcl) -;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d ;;; tcl.el ends here
--- a/lisp/progmodes/verilog-mode.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/verilog-mode.el Wed Nov 17 13:09:08 2010 +0900 @@ -124,9 +124,9 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "647" +(defconst verilog-mode-version "650" "Version of this Verilog mode.") -(defconst verilog-mode-release-date "2010-10-20-GNU" +(defconst verilog-mode-release-date "2010-11-05-GNU" "Release date of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -4551,16 +4551,18 @@ default nil nil 'verilog-preprocess-history default))))) (unless command (setq command (verilog-expand-command verilog-preprocessor))) - (let* ((dir (file-name-directory (or filename buffer-file-name))) + (let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode)) + (dir (file-name-directory (or filename buffer-file-name))) (file (file-name-nondirectory (or filename buffer-file-name))) (cmd (concat "cd " dir "; " command " " file))) (with-output-to-temp-buffer "*Verilog-Preprocessed*" - (save-excursion - (set-buffer "*Verilog-Preprocessed*") + (with-current-buffer (get-buffer "*Verilog-Preprocessed*") (insert (concat "// " cmd "\n")) (shell-command cmd "*Verilog-Preprocessed*") (verilog-mode) - (font-lock-mode))))) + ;; Without this force, it takes a few idle seconds + ;; to get the color, which is very jarring + (when fontlocked (font-lock-fontify-buffer)))))) ;; @@ -7266,7 +7268,10 @@ ((looking-at "\\s-*\\(\\[[^]]+\\]\\)") (goto-char (match-end 0)) (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3) - (setcar (cdr (cdr (cdr newsig))) (match-string 1))) + (setcar (cdr (cdr (cdr newsig))) + (if (verilog-sig-memory newsig) + (concat (verilog-sig-memory newsig) (match-string 1)) + (match-string 1)))) (vec ;; Multidimensional (setq multidim (cons vec multidim)) (setq vec (verilog-string-replace-matches @@ -7404,7 +7409,9 @@ (cons (verilog-sig-new sig (if dotname (verilog-sig-bits portdata) vec) - (concat "To/From " comment) nil nil + (concat "To/From " comment) + (verilog-sig-memory portdata) + nil (verilog-sig-signed portdata) (verilog-sig-type portdata) multidim nil) @@ -7415,7 +7422,9 @@ (cons (verilog-sig-new sig (if dotname (verilog-sig-bits portdata) vec) - (concat "From " comment) nil nil + (concat "From " comment) + (verilog-sig-memory portdata) + nil (verilog-sig-signed portdata) (verilog-sig-type portdata) multidim nil) @@ -7426,7 +7435,9 @@ (cons (verilog-sig-new sig (if dotname (verilog-sig-bits portdata) vec) - (concat "To " comment) nil nil + (concat "To " comment) + (verilog-sig-memory portdata) + nil (verilog-sig-signed portdata) (verilog-sig-type portdata) multidim nil) @@ -7436,7 +7447,9 @@ (cons (verilog-sig-new sig (if dotname (verilog-sig-bits portdata) vec) - (concat "To/From " comment) nil nil + (concat "To/From " comment) + (verilog-sig-memory portdata) + nil (verilog-sig-signed portdata) (verilog-sig-type portdata) multidim nil) @@ -7448,7 +7461,9 @@ (cons (verilog-sig-new sig (if dotname (verilog-sig-bits portdata) vec) - (concat "To/From " comment) nil nil + (concat "To/From " comment) + (verilog-sig-memory portdata) + nil (verilog-sig-signed portdata) (verilog-sig-type portdata) multidim nil) @@ -8862,7 +8877,9 @@ (indent-to (max 24 (+ indent-pt 16))) (unless (= (char-syntax (preceding-char)) ?\ ) (insert " ")) ; Need space between "]name" if indent-to did nothing - (insert (verilog-sig-name sig))) + (insert (verilog-sig-name sig)) + (when (verilog-sig-memory sig) + (insert " " (verilog-sig-memory sig)))) (defun verilog-insert-definition (sigs direction indent-pt v2k &optional dont-sort) "Print out a definition for a list of SIGS of the given DIRECTION,
--- a/lisp/progmodes/vhdl-mode.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/vhdl-mode.el Wed Nov 17 13:09:08 2010 +0900 @@ -12115,9 +12115,7 @@ "Return the line number of the line containing point." (save-restriction (widen) - (save-excursion - (beginning-of-line) - (1+ (count-lines (point-min) (point)))))) + (1+ (count-lines (point-min) (point-at-bol))))) (defun vhdl-line-kill-entire (&optional arg) "Delete entire line." @@ -12134,8 +12132,7 @@ "Copy current line." (interactive "p") (save-excursion - (beginning-of-line) - (let ((position (point))) + (let ((position (point-at-bol))) (forward-line (or arg 1)) (copy-region-as-kill position (point)))))
--- a/lisp/progmodes/xscheme.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/progmodes/xscheme.el Wed Nov 17 13:09:08 2010 +0900 @@ -701,12 +701,7 @@ "Send the current line to the Scheme process. Useful for working with debugging Scheme under adb." (interactive) - (let ((line - (save-excursion - (beginning-of-line) - (let ((start (point))) - (end-of-line) - (buffer-substring start (point)))))) + (let ((line (buffer-substring (line-beginning-position) (line-end-position)))) (end-of-line) (insert ?\n) (xscheme-send-string-2 line))) @@ -1224,5 +1219,4 @@ (provide 'xscheme) -;; arch-tag: cfc14adc-2917-409e-ad16-432e8d0017de ;;; xscheme.el ends here
--- a/lisp/server.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/server.el Wed Nov 17 13:09:08 2010 +0900 @@ -498,7 +498,7 @@ (error "The directory `%s' is unsafe" dir))))) ;;;###autoload -(defun server-start (&optional leave-dead) +(defun server-start (&optional leave-dead inhibit-prompt) "Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which client \"editors\" can send your editing commands to this Emacs @@ -508,7 +508,10 @@ Optional argument LEAVE-DEAD (interactively, a prefix arg) means just kill any existing server communications subprocess. -If a server is already running, the server is not started. +If a server is already running, restart it. If clients are +running, ask the user for confirmation first, unless optional +argument INHIBIT-PROMPT is non-nil. + To force-start a server, do \\[server-force-delete] and then \\[server-start]." (interactive "P") @@ -516,12 +519,14 @@ ;; Ask the user before deleting existing clients---except ;; when we can't get user input, which may happen when ;; doing emacsclient --eval "(kill-emacs)" in daemon mode. - (if (and (daemonp) - (null (cdr (frame-list))) - (eq (selected-frame) terminal-frame)) - leave-dead - (yes-or-no-p - "The current server still has clients; delete them? "))) + (cond + ((and (daemonp) + (null (cdr (frame-list))) + (eq (selected-frame) terminal-frame)) + leave-dead) + (inhibit-prompt t) + (t (yes-or-no-p + "The current server still has clients; delete them? ")))) (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) (server-file (expand-file-name server-name server-dir))) (when server-process @@ -560,7 +565,7 @@ (add-hook 'delete-frame-functions 'server-handle-delete-frame) (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) - (add-hook 'kill-emacs-hook (lambda () (server-mode -1))) ;Cleanup upon exit. + (add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit. (setq server-process (apply #'make-network-process :name server-name @@ -601,6 +606,11 @@ " " (number-to-string (emacs-pid)) ; Kept for compatibility "\n" auth-key))))))))) +(defun server-force-stop () + "Kill all connections to the current server. +This function is meant to be called from `kill-emacs-hook'." + (server-start nil t)) + ;;;###autoload (defun server-force-delete (&optional name) "Unconditionally delete connection file for server NAME.
--- a/lisp/shell.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/shell.el Wed Nov 17 13:09:08 2010 +0900 @@ -472,6 +472,10 @@ (when (string-equal shell "bash") (add-hook 'comint-output-filter-functions 'shell-filter-ctrl-a-ctrl-b nil t))) + (when shell-dir-cookie-re + ;; Watch for magic cookies in the output to track the current dir. + (add-hook 'comint-output-filter-functions + 'shell-dir-cookie-watcher nil t)) (comint-read-input-ring t))) (defun shell-filter-ctrl-a-ctrl-b (string) @@ -619,6 +623,31 @@ ;; replace it with a process filter that watches for and strips out ;; these messages. +(defcustom shell-dir-cookie-re nil + "Regexp matching your prompt, including some part of the current directory. +If your prompt includes the current directory or the last few elements of it, +set this to a pattern that matches your prompt and whose subgroup 1 matches +the directory part of it. +This is used by `shell-dir-cookie-watcher' to try and use this info +to track your current directory. It can be used instead of or in addition +to `dirtrack-mode'." + :type '(choice (const nil) regexp)) + +(defun shell-dir-cookie-watcher (text) + ;; This is fragile: the TEXT could be split into several chunks and we'd + ;; miss it. Oh well. It's a best effort anyway. I'd expect that it's + ;; rather unusual to have the prompt split into several packets, but + ;; I'm sure Murphy will prove me wrong. + (when (and shell-dir-cookie-re (string-match shell-dir-cookie-re text)) + (let ((dir (match-string 1 text))) + (cond + ((file-name-absolute-p dir) (shell-cd dir)) + ;; Let's try and see if it seems to be up or down from where we were. + ((string-match "\\`\\(.*\\)\\(?:/.*\\)?\n\\(.*/\\)\\1\\(?:/.*\\)?\\'" + (setq text (concat dir "\n" default-directory))) + (shell-cd (concat (match-string 2 text) dir))))))) + + (defun shell-directory-tracker (str) "Tracks cd, pushd and popd commands issued to the shell. This function is called on each input passed to the shell.
--- a/lisp/simple.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/simple.el Wed Nov 17 13:09:08 2010 +0900 @@ -512,7 +512,7 @@ (interactive "*p") (let* ((do-fill-prefix (and fill-prefix (bolp))) (do-left-margin (and (bolp) (> (current-left-margin) 0))) - (loc (point)) + (loc (point-marker)) ;; Don't expand an abbrev before point. (abbrev-mode nil)) (newline n) @@ -973,6 +973,21 @@ (re-search-forward "[\n\C-m]" nil 'end (1- line)) (forward-line (1- line))))) +(defun count-words-region (start end) + "Print the number of words in the region. +When called interactively, the word count is printed in echo area." + (interactive "r") + (let ((count 0)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (forward-word 1) + (setq count (1+ count))))) + (if (interactive-p) + (message "Region has %d words" count)) + count)) + (defun count-lines-region (start end) "Print number of lines and characters in the region." (interactive "r") @@ -5060,16 +5075,12 @@ ;; Point is neither within nor adjacent to a word. (not strict)) ;; Look for preceding word in same line. - (skip-syntax-backward not-syntaxes - (save-excursion (beginning-of-line) - (point))) + (skip-syntax-backward not-syntaxes (line-beginning-position)) (if (bolp) ;; No preceding word in same line. ;; Look for following word in same line. (progn - (skip-syntax-forward not-syntaxes - (save-excursion (end-of-line) - (point))) + (skip-syntax-forward not-syntaxes (line-end-position)) (setq start (point)) (skip-syntax-forward syntaxes) (setq end (point)))
--- a/lisp/skeleton.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/skeleton.el Wed Nov 17 13:09:08 2010 +0900 @@ -108,7 +108,7 @@ are integer buffer positions in the reverse order of the insertion order.") ;; reduce the number of compiler warnings -(defvar skeleton) +(defvar skeleton-il) (defvar skeleton-modified) (defvar skeleton-point) (defvar skeleton-regions) @@ -299,7 +299,10 @@ (eolp (eolp))) ;; since Emacs doesn't show main window's cursor, do something noticeable (or eolp - (open-line 1)) + ;; We used open-line before, but that can do a lot more than we want, + ;; since it runs self-insert-command. E.g. it may remove spaces + ;; before point. + (save-excursion (insert "\n"))) (unwind-protect (setq prompt (if (stringp prompt) (read-string (format prompt skeleton-subprompt) @@ -317,25 +320,26 @@ (signal 'quit t) prompt)) -(defun skeleton-internal-list (skeleton &optional str recursive) +(defun skeleton-internal-list (skeleton-il &optional str recursive) (let* ((start (line-beginning-position)) (column (current-column)) (line (buffer-substring start (line-end-position))) opoint) (or str - (setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive)))) - (when (and (eq (cadr skeleton) '\n) (not recursive) + (setq str `(setq str + (skeleton-read ',(car skeleton-il) nil ,recursive)))) + (when (and (eq (cadr skeleton-il) '\n) (not recursive) (save-excursion (skip-chars-backward " \t") (bolp))) - (setq skeleton (cons nil (cons '> (cddr skeleton))))) + (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) (while (setq skeleton-modified (eq opoint (point)) opoint (point) - skeleton (cdr skeleton)) + skeleton-il (cdr skeleton-il)) (condition-case quit - (skeleton-internal-1 (car skeleton) nil recursive) + (skeleton-internal-1 (car skeleton-il) nil recursive) (quit (if (eq (cdr quit) 'recursive) (setq recursive 'quit - skeleton (memq 'resume: skeleton)) + skeleton-il (memq 'resume: skeleton-il)) ;; Remove the subskeleton as far as it has been shown ;; the subskeleton shouldn't have deleted outside current line. (end-of-line) @@ -343,7 +347,7 @@ (insert line) (move-to-column column) (if (cdr quit) - (setq skeleton () + (setq skeleton-il () recursive nil) (signal 'quit 'recursive))))))) ;; maybe continue loop or go on to next outer resume: section @@ -351,6 +355,16 @@ (signal 'quit 'recursive) recursive)) +(defun skeleton-newline () + (if (or (eq (point) skeleton-point) + (eq (point) (car skeleton-positions))) + ;; If point is recorded, avoid `newline' since it may do things like + ;; strip trailing spaces, and since recorded points are commonly placed + ;; right after a trailing space, calling `newline' can destroy the + ;; position and renders the recorded position incorrect. + (insert "\n") + (newline))) + (defun skeleton-internal-1 (element &optional literal recursive) (cond ((or (integerp element) (stringp element)) @@ -365,29 +379,29 @@ ((or (eq element '\n) ; actually (eq '\n 'n) ;; The sequence `> \n' is handled specially so as to indent the first ;; line after inserting the newline (to get the proper indentation). - (and (eq element '>) (eq (nth 1 skeleton) '\n) (pop skeleton))) + (and (eq element '>) (eq (nth 1 skeleton-il) '\n) (pop skeleton-il))) (let ((pos (if (eq element '>) (point)))) (cond - ((and skeleton-regions (eq (nth 1 skeleton) '_)) + ((and skeleton-regions (eq (nth 1 skeleton-il) '_)) (or (eolp) (newline)) (if pos (save-excursion (goto-char pos) (indent-according-to-mode))) (indent-region (line-beginning-position) (car skeleton-regions) nil)) ;; \n as last element only inserts \n if not at eol. - ((and (null (cdr skeleton)) (not recursive) (eolp)) + ((and (null (cdr skeleton-il)) (not recursive) (eolp)) (if pos (indent-according-to-mode))) (skeleton-newline-indent-rigidly (let ((pt (point))) - (newline) + (skeleton-newline) (indent-to (save-excursion (goto-char pt) (if pos (indent-according-to-mode)) (current-indentation))))) (t (if pos (reindent-then-newline-and-indent) - (newline) + (skeleton-newline) (indent-according-to-mode)))))) ((eq element '>) - (if (and skeleton-regions (eq (nth 1 skeleton) '_)) + (if (and skeleton-regions (eq (nth 1 skeleton-il) '_)) (indent-region (line-beginning-position) (car skeleton-regions) nil) (indent-according-to-mode))) @@ -396,16 +410,16 @@ (progn (goto-char (pop skeleton-regions)) (and (<= (current-column) (current-indentation)) - (eq (nth 1 skeleton) '\n) + (eq (nth 1 skeleton-il) '\n) (end-of-line 0))) (or skeleton-point (setq skeleton-point (point))))) ((eq element '-) (setq skeleton-point (point))) ((eq element '&) - (when skeleton-modified (pop skeleton))) + (when skeleton-modified (pop skeleton-il))) ((eq element '|) - (unless skeleton-modified (pop skeleton))) + (unless skeleton-modified (pop skeleton-il))) ((eq element '@) (push (point) skeleton-positions)) ((eq 'quote (car-safe element))
--- a/lisp/speedbar.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/speedbar.el Wed Nov 17 13:09:08 2010 +0900 @@ -3986,13 +3986,10 @@ (speedbar-unhighlight-one-tag-line) (setq speedbar-highlight-one-tag-line (speedbar-make-overlay (line-beginning-position) - (save-excursion (end-of-line) - (forward-char 1) - (point)))) + (1+ (line-end-position)))) (speedbar-overlay-put speedbar-highlight-one-tag-line 'face 'speedbar-highlight-face) - (add-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line) - ) + (add-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line)) (defun speedbar-unhighlight-one-tag-line () "Unhighlight the currently highlighted line."
--- a/lisp/startup.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/startup.el Wed Nov 17 13:09:08 2010 +0900 @@ -693,7 +693,7 @@ (defvar server-process) ;; Autoload in package.el, but when we bootstrap, we don't have loaddefs yet. (defvar package-enable-at-startup) -(declare-function package-initialize "package" ()) +(declare-function package-initialize "package" (&optional no-activate)) (defun command-line () (setq before-init-time (current-time) @@ -885,14 +885,15 @@ ;; Under X, this creates the X frame and deletes the terminal frame. (unless (daemonp) - ;; Enable or disable the tool-bar and menu-bar. - ;; While we're at it, set `no-blinking-cursor' too. + + ;; If X resources are available, use them to initialize the values + ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of + ;; `no-blinking-cursor' and the `cursor' face. (cond ((or noninteractive emacs-basic-display) (setq menu-bar-mode nil tool-bar-mode nil no-blinking-cursor t)) - ;; Check X resources if available. ((memq initial-window-system '(x w32 ns)) (let ((no-vals '("no" "off" "false" "0"))) (if (member (x-get-resource "menuBar" "MenuBar") no-vals) @@ -901,7 +902,13 @@ (setq tool-bar-mode nil)) (if (member (x-get-resource "cursorBlink" "CursorBlink") no-vals) - (setq no-blinking-cursor t))))) + (setq no-blinking-cursor t))) + ;; If the cursorColor X resource exists, alter the `cursor' face + ;; spec, but mark it as changed outside of Customize. + (let ((color (x-get-resource "cursorColor" "CursorColor"))) + (when color + (face-spec-set 'cursor `((t (:background ,color)))) + (put 'cursor 'face-modified t))))) (frame-initialize)) (when (fboundp 'x-create-frame)
--- a/lisp/term.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/term.el Wed Nov 17 13:09:08 2010 +0900 @@ -2611,10 +2611,7 @@ (defun term-move-columns (delta) (setq term-current-column (max 0 (+ (term-current-column) delta))) - (let (point-at-eol) - (save-excursion - (end-of-line) - (setq point-at-eol (point))) + (let ((point-at-eol (line-end-position))) (move-to-column term-current-column t) ;; If move-to-column extends the current line it will use the face ;; from the last character on the line, set the face for the chars @@ -3792,10 +3789,8 @@ (term-vertical-motion 1) (when (bolp) (backward-char)) - (setq save-eol (point)) - (save-excursion - (end-of-line) - (setq pnt-at-eol (point))) + (setq save-eol (point) + pnt-at-eol (line-end-position)) (move-to-column (+ (term-start-line-column) (- term-width count)) t) ;; If move-to-column extends the current line it will use the face ;; from the last character on the line, set the face for the chars @@ -4228,7 +4223,7 @@ files, such as /dev/ttyS0. Return nil if this is Windows or DOS, where serial ports have special identifiers such as COM1." - (not (member system-type (list 'windows-nt 'cygwin 'ms-dos)))) + (not (memq system-type '(windows-nt cygwin ms-dos)))) (defvar serial-name-history (if (serial-port-is-file-p)
--- a/lisp/textmodes/fill.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/textmodes/fill.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,8 @@ ;;; fill.el --- fill commands for Emacs -*- coding: utf-8 -*- -;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp @@ -137,7 +138,7 @@ number equals or exceeds the local fill-column - right-margin difference." (save-excursion (if fill-column - (let* ((here (progn (beginning-of-line) (point))) + (let* ((here (line-beginning-position)) (here-col 0) (eol (progn (end-of-line) (point))) margin fill-col change col) @@ -1517,5 +1518,4 @@ "") string)) -;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d ;;; fill.el ends here
--- a/lisp/textmodes/flyspell.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/textmodes/flyspell.el Wed Nov 17 13:09:08 2010 +0900 @@ -380,7 +380,8 @@ (defun flyspell-generic-progmode-verify () "Used for `flyspell-generic-check-word-predicate' in programming modes." - (let ((f (get-text-property (point) 'face))) + ;; (point) is next char after the word. Must check one char before. + (let ((f (get-text-property (- (point) 1) 'face))) (memq f flyspell-prog-text-faces))) ;;;###autoload @@ -1013,11 +1014,13 @@ ;;*---------------------------------------------------------------------*/ ;;* flyspell-word ... */ ;;*---------------------------------------------------------------------*/ -(defun flyspell-word (&optional following) +(defun flyspell-word (&optional following known-misspelling) "Spell check a word. If the optional argument FOLLOWING, or, when called interactively `ispell-following-word', is non-nil, checks the following (rather -than preceding) word when the cursor is not over a word." +than preceding) word when the cursor is not over a word. If +optional argument KNOWN-MISSPELLING is non nil considers word a +misspelling and skips redundant spell-checking step." (interactive (list ispell-following-word)) (ispell-set-spellchecker-params) ; Initialize variables and dicts alists (save-excursion @@ -1078,29 +1081,35 @@ (setq flyspell-word-cache-end end) (setq flyspell-word-cache-word word) ;; now check spelling of word. - (ispell-send-string "%\n") - ;; put in verbose mode - (ispell-send-string (concat "^" word "\n")) - ;; we mark the ispell process so it can be killed - ;; when emacs is exited without query - (set-process-query-on-exit-flag ispell-process nil) - ;; Wait until ispell has processed word. Since this code is often - ;; executed from post-command-hook but the ispell process may not - ;; be responsive, it's important to make sure we re-enable C-g. - (with-local-quit - (while (progn - (accept-process-output ispell-process) - (not (string= "" (car ispell-filter)))))) - ;; (ispell-send-string "!\n") - ;; back to terse mode. - ;; Remove leading empty element - (setq ispell-filter (cdr ispell-filter)) - ;; ispell process should return something after word is sent. - ;; Tag word as valid (i.e., skip) otherwise - (or ispell-filter - (setq ispell-filter '(*))) - (if (consp ispell-filter) - (setq poss (ispell-parse-output (car ispell-filter)))) + (if (not known-misspelling) + (progn + (ispell-send-string "%\n") + ;; put in verbose mode + (ispell-send-string (concat "^" word "\n")) + ;; we mark the ispell process so it can be killed + ;; when emacs is exited without query + (set-process-query-on-exit-flag ispell-process nil) + ;; Wait until ispell has processed word. Since this + ;; code is often executed from post-command-hook but + ;; the ispell process may not be responsive, it's + ;; important to make sure we re-enable C-g. + (with-local-quit + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter)))))) + ;; (ispell-send-string "!\n") + ;; back to terse mode. + ;; Remove leading empty element + (setq ispell-filter (cdr ispell-filter)) + ;; ispell process should return something after word is sent. + ;; Tag word as valid (i.e., skip) otherwise + (or ispell-filter + (setq ispell-filter '(*))) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter))))) + ;; Else, this was a known misspelling to begin with, and + ;; we should forge an ispell return value. + (setq poss (list word 0 '() '()))) (let ((res (cond ((eq poss t) ;; correct (setq flyspell-word-cache-result t) @@ -1433,7 +1442,7 @@ t nil)))) (setq keep nil) - (flyspell-word) + (flyspell-word nil t) ;; Search for next misspelled word will begin from ;; end of last validated match. (setq buffer-scan-pos (point))))
--- a/lisp/textmodes/ispell.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/textmodes/ispell.el Wed Nov 17 13:09:08 2010 +0900 @@ -2912,8 +2912,7 @@ (min skip-region-start ispell-region-end) (marker-position ispell-region-end)))) (let* ((ispell-start (point)) - (ispell-end (save-excursion - (end-of-line) (min (point) reg-end))) + (ispell-end (min (point-at-eol) reg-end)) (string (ispell-get-line ispell-start ispell-end in-comment))) (if in-comment ; account for comment chars added
--- a/lisp/textmodes/remember.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/textmodes/remember.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; remember --- a mode for quickly jotting down things to remember -;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> ;; Created: 29 Mar 1999 @@ -315,12 +315,6 @@ (let ((remember-in-new-frame t)) (remember initial))) -(defsubst remember-time-to-seconds (time) - "Convert TIME to a floating point number." - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (car (cdr (cdr time))) 0) 1000000.0))) - (defsubst remember-mail-date (&optional rfc822-p) "Return a simple date. Nothing fancy." (if rfc822-p @@ -355,8 +349,7 @@ Each piece of pseudo-mail created will have an `X-Todo-Priority' field, for the purpose of appropriate splitting." (let ((who (read-string "Who is this item related to? ")) - (moment - (format "%.0f" (remember-time-to-seconds (current-time)))) + (moment (format "%.0f" (float-time))) (desc (remember-buffer-desc)) (text (buffer-string))) (with-temp-buffer @@ -535,5 +528,4 @@ \\{remember-mode-map}" (set-keymap-parent remember-mode-map nil)) -;; arch-tag: 59312a05-06c7-4da1-b6f7-5ea41c9d5577 ;;; remember.el ends here
--- a/lisp/textmodes/texinfmt.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/textmodes/texinfmt.el Wed Nov 17 13:09:08 2010 +0900 @@ -663,11 +663,12 @@ ;; Else ;; 3. Do not refill a paragraph containing @w or @*, or ending ;; with @<newline> followed by a newline. - (if (or (>= (point) (point-max)) - (re-search-forward - "@w{\\|@\\*\\|@\n\n" - (save-excursion (forward-paragraph) (forward-line 1) (point)) - t)) + (if (or (>= (point) (point-max)) + (re-search-forward + "@w{\\|@\\*\\|@\n\n" + (save-excursion (forward-paragraph) + (line-beginning-position 2)) + t)) ;; Go to end of paragraph and do nothing. (forward-paragraph) ;; 4. Else go to end of paragraph and insert @refill @@ -944,8 +945,8 @@ (end (progn (re-search-forward "^@end copying[ \t]*\n") (point)))) (setq texinfo-copying-text (buffer-substring-no-properties - (save-excursion (goto-char beg) (forward-line 1) (point)) - (save-excursion (goto-char end) (forward-line -1) (point)))) + (save-excursion (goto-char beg) (line-beginning-position 2)) + (save-excursion (goto-char end) (line-beginning-position 0)))) (delete-region beg end))) (defun texinfo-insertcopying () @@ -4297,5 +4298,4 @@ ;;; Place `provide' at end of file. (provide 'texinfmt) -;; arch-tag: 1e8d9a2d-bca0-40a0-ac6c-dab01bc6f725 ;;; texinfmt.el ends here
--- a/lisp/textmodes/texnfo-upd.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/textmodes/texnfo-upd.el Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,7 @@ ;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files -;; Copyright (C) 1989, 1990, 1991, 1992, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1990, 1991, 1992, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Maintainer: bug-texinfo@gnu.org @@ -349,9 +349,7 @@ (when (search-forward texinfo-master-menu-header nil t) ;; Check if @detailmenu kludge is used; ;; if so, leave point before @detailmenu. - (search-backward "\n@detailmenu" - (save-excursion (forward-line -3) (point)) - t) + (search-backward "\n@detailmenu" (line-beginning-position -2) t) ;; Remove detailed master menu listing (setq master-menu-p t) (goto-char (match-beginning 0)) @@ -627,9 +625,7 @@ (point) (save-excursion (re-search-forward "\\(^\\* \\|^@ignore\\|^@end menu\\)" end-of-menu t) - (forward-line -1) - (end-of-line) ; go to end of last description line - (point))) + (line-end-position 0))) ; end of last description line "")) (defun texinfo-menu-end () @@ -737,16 +733,14 @@ (skip-chars-forward " \t") (setq beginning (point)) ;; Menu entry line ends in a period, comma, or tab. - (if (re-search-forward "[.,\t]" - (save-excursion (forward-line 1) (point)) t) + (if (re-search-forward "[.,\t]" (line-beginning-position 2) t) (progn (if (looking-at "[ \t]*[^ \t\n]+") (error "Descriptive text already exists")) (skip-chars-backward "., \t") (setq node-name (buffer-substring beginning (point)))) ;; Menu entry line ends in a return. - (re-search-forward ".*\n" - (save-excursion (forward-line 1) (point)) t) + (re-search-forward ".*\n" (line-beginning-position 2) t) (skip-chars-backward " \t\n") (setq node-name (buffer-substring beginning (point))) (if (= 0 (length node-name)) @@ -904,9 +898,7 @@ (progn ;; Check if @detailmenu kludge is used; ;; if so, leave point before @detailmenu. - (search-backward "\n@detailmenu" - (save-excursion (forward-line -3) (point)) - t) + (search-backward "\n@detailmenu" (line-beginning-position -2) t) ;; Remove detailed master menu listing (goto-char (match-beginning 0)) (let ((end-of-detailed-menu-descriptions @@ -941,9 +933,7 @@ (goto-char (match-beginning 0)) ;; Check if @detailmenu kludge is used; ;; if so, leave point before @detailmenu. - (search-backward "\n@detailmenu" - (save-excursion (forward-line -3) (point)) - t) + (search-backward "\n@detailmenu" (line-beginning-position -2) t) (insert "\n") (delete-blank-lines) (goto-char (point-min)))) @@ -1449,7 +1439,7 @@ (end-of-line) ; this handles prev node top case (re-search-backward ; when point is already "^@node" ; at the beginning of @node line - (save-excursion (forward-line -3)) + (line-beginning-position -2) t) (setq name (texinfo-copy-node-name))) ((eq kind 'no-pointer) @@ -1649,7 +1639,8 @@ "^@node" ;; Avoid finding previous node line if node lines are close. (or last-section-position - (save-excursion (forward-line -2) (point))) t) + (line-beginning-position -1)) + t) ;; @node is present, and point at beginning of that line (forward-word 1) ; Leave point just after @node. ;; Else @node missing; insert one. @@ -1671,7 +1662,7 @@ (message "Inserted title %s ... " title))))) ;; Go forward beyond current section title. (re-search-forward texinfo-section-types-regexp - (save-excursion (forward-line 3) (point)) t) + (line-beginning-position 4) t) (setq last-section-position (point)) (forward-line 1)) @@ -2015,9 +2006,7 @@ (goto-char (match-beginning 0)) ;; Check if @detailmenu kludge is used; ;; if so, leave point before @detailmenu. - (search-backward "\n@detailmenu" - (save-excursion (forward-line -3) (point)) - t) + (search-backward "\n@detailmenu" (line-beginning-position -2) t) ;; Remove detailed master menu listing (let ((end-of-detailed-menu-descriptions (save-excursion ; beginning of end menu line
--- a/lisp/url/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/url/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,8 @@ +2010-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * url-file.el (url-file-build-filename): Avoid interpreting + file:/foo:/bar URLs via tramp. + 2010-10-14 Lars Magne Ingebrigtsen <larsi@gnus.org> * url-gw.el (url-open-stream): Use open-gnutls-stream if it exists.
--- a/lisp/url/url-file.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/url/url-file.el Wed Nov 17 13:09:08 2010 +0900 @@ -103,12 +103,19 @@ (format "%s#%d" host port)) host)) (file (url-unhex-string (url-filename url))) - (filename (if (or user (not (url-file-host-is-local-p host))) - (concat "/" (or user "anonymous") "@" site ":" file) - (if (and (memq system-type '(ms-dos windows-nt)) - (string-match "^/[a-zA-Z]:/" file)) - (substring file 1) - file))) + (filename (cond + ;; ftp: URL. + ((or user (not (url-file-host-is-local-p host))) + (concat "/" (or user "anonymous") "@" site ":" file)) + ;; file: URL on Windows. + ((and (string-match "\\`/[a-zA-Z]:/" file) + (memq system-type '(ms-dos windows-nt))) + (substring file 1)) + ;; file: URL with a file:/bar:/foo-like spec. + ((string-match "\\`/[^/]+:/" file) + (concat "/:" file)) + (t + file))) pos-index) (and user pass
--- a/lisp/vc/emerge.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/vc/emerge.el Wed Nov 17 13:09:08 2010 +0900 @@ -2474,10 +2474,8 @@ (defvar emerge-line-diff) (defun emerge-line-number-in-buf (begin-marker end-marker) - (let (temp) - (setq temp (save-excursion - (beginning-of-line) - (1+ (count-lines 1 (point))))) + ;; FIXME point-min rather than 1? widen? + (let ((temp (1+ (count-lines 1 (line-beginning-position))))) (if valid-diff (progn (if (> (point) (aref emerge-line-diff begin-marker))
--- a/lisp/vc/smerge-mode.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/vc/smerge-mode.el Wed Nov 17 13:09:08 2010 +0900 @@ -1009,6 +1009,10 @@ (setq part (cond ((null (match-end 2)) 2) ((eq (match-end 1) (match-end 3)) 1) ((integerp part) part) + ;; If one of the parts is empty, any refinement using + ;; it will be trivial and uninteresting. + ((eq (match-end 1) (match-beginning 1)) 1) + ((eq (match-end 3) (match-beginning 3)) 3) (t 2))) (let ((n1 (if (eq part 1) 2 1)) (n2 (if (eq part 3) 2 3)))
--- a/lisp/vc/vc-mtn.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/vc/vc-mtn.el Wed Nov 17 13:09:08 2010 +0900 @@ -110,7 +110,7 @@ (defun vc-mtn-after-dir-status (update-function) (let (result) (goto-char (point-min)) - (re-search-forward "Current branch: \\(.*\\)\nChanges against parent \\(.*\\)" nil t) + (re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)" nil t) (while (re-search-forward "^ \\(?:\\(patched \\)\\|\\(added \\)\\)\\(.*\\)$" nil t) (cond ((match-end 1) (push (list (match-string 3) 'edited) result)) @@ -129,7 +129,7 @@ (with-temp-buffer (vc-mtn-command t 0 file "status") (goto-char (point-min)) - (re-search-forward "Current branch: \\(.*\\)\nChanges against parent \\(.*\\)") + (re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)") (match-string 2)))) (defun vc-mtn-workfile-branch (file) @@ -139,7 +139,7 @@ (with-temp-buffer (vc-mtn-command t 0 file "status") (goto-char (point-min)) - (re-search-forward "Current branch: \\(.*\\)\nChanges against parent \\(.*\\)") + (re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)") (match-string 1)))) (defun vc-mtn-workfile-unchanged-p (file)
--- a/lisp/vc/vc.el Mon Nov 08 14:19:54 2010 +0900 +++ b/lisp/vc/vc.el Wed Nov 17 13:09:08 2010 +0900 @@ -920,7 +920,8 @@ (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) ((derived-mode-p 'log-view-mode) log-view-vc-backend) ((derived-mode-p 'diff-mode) diff-vc-backend) - ((derived-mode-p 'dired-mode) + ;; Maybe we could even use comint-mode rather than shell-mode? + ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode) (vc-responsible-backend default-directory)) (vc-mode (vc-backend buffer-file-name)))) @@ -986,7 +987,7 @@ (let ((backend (vc-responsible-backend default-directory))) (unless backend (error "Directory not under VC")) (list backend - (dired-map-over-marks (dired-get-filename nil t) nil)))) + (dired-map-over-marks (dired-get-filename nil t) nil)))) (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file."
--- a/oldXMenu/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/oldXMenu/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,9 @@ +2010-11-09 Elias Pipping <pipping.elias@googlemail.com> (tiny change) + + Make Emacs compile with clang (bug#7309). + * XMakeAssoc.c (XMakeAssoc): + * XDelAssoc.c (XDeleteAssoc): Declare the return type. + 2010-07-12 Dan Nicolaescu <dann@ics.uci.edu> * XMenu.h: Include <stdlib.h>.
--- a/oldXMenu/XDelAssoc.c Mon Nov 08 14:19:54 2010 +0900 +++ b/oldXMenu/XDelAssoc.c Wed Nov 17 13:09:08 2010 +0900 @@ -17,6 +17,7 @@ * an XId. An association may be removed only once. Redundant * deletes are meaningless (but cause no problems). */ +void XDeleteAssoc(register Display *dpy, register XAssocTable *table, register XID x_id) { int hash;
--- a/oldXMenu/XMakeAssoc.c Mon Nov 08 14:19:54 2010 +0900 +++ b/oldXMenu/XMakeAssoc.c Wed Nov 17 13:09:08 2010 +0900 @@ -26,6 +26,7 @@ * meaningless (but cause no problems). The queue in each association * bucket is sorted (lowest XId to highest XId). */ +void XMakeAssoc(register Display *dpy, register XAssocTable *table, register XID x_id, register caddr_t data) { int hash;
--- a/src/.gdbinit Mon Nov 08 14:19:54 2010 +0900 +++ b/src/.gdbinit Wed Nov 17 13:09:08 2010 +0900 @@ -494,14 +494,30 @@ end # COMPOSITE_GLYPH if ($g->type == 1) - printf "COMP[%d (%d..%d)]", $g->u.cmp.id, $g->u.cmp.from, $g->u.cmp.to + printf "COMP[%d (%d..%d)]", $g->u.cmp.id, $g->slice.cmp.from, $g->slice.cmp.to + end + # GLYPHLESS_GLYPH + if ($g->type == 2) + printf "GLYPHLESS[" + if ($g->u.glyphless.method == 0) + printf "THIN]" + end + if ($g->u.glyphless.method == 1) + printf "EMPTY]" + end + if ($g->u.glyphless.method == 2) + printf "ACRO]" + end + if ($g->u.glyphless.method == 3) + printf "HEX]" + end end # IMAGE_GLYPH - if ($g->type == 2) + if ($g->type == 3) printf "IMAGE[%d]", $g->u.img_id end # STRETCH_GLYPH - if ($g->type == 3) + if ($g->type == 4) printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent end xgettype ($g->object) @@ -544,8 +560,8 @@ if ($g->right_box_line_p) printf " ]" end - if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height) - printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height + if ($g->slice.img.x || $g->slice.img.y || $g->slice.img.width || $g->slice.img.height) + printf " slice=%d,%d,%d,%d" ,$g->slice.img.x, $g->slice.img.y, $g->slice.img.width, $g->slice.img.height end printf "\n" end
--- a/src/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/src/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,244 @@ +2010-11-16 Chong Yidong <cyd@stupidchicken.com> + + * keyboard.c (make_lispy_position): For text area clicks, record Y + pixel position relative to the text area, excluding header line. + Also change X and Y to Lisp_Objects, not pointers; don't return + coordinate values via pointers. Pass ON_TEXT_AREA coordinate to + buffer_posn_from_coords counting from the start of the text area. + (Fposn_at_x_y, make_lispy_event): Callers changed. + + * window.c (coordinates_in_window): Change X and Y to ints rather + than pointers; don't return coordinates via pointers. + (struct check_window_data): Change X and Y from pointers to ints. + (window_from_coordinates): Remove args WX and WY; don't return + coordinates via pointers. + (Fcoordinates_in_window_p, window_from_coordinates): + (check_window_containing, Fwindow_at): Callers changed. + (window_relative_x_coord): New function. + + * window.h (window_from_coordinates, window_relative_x_coord): + Update prototypes. + + * dispnew.c (buffer_posn_from_coords): Assume that X counts from + the start of the text area. + + * xdisp.c (remember_mouse_glyph): Change window_from_coordinates + call. Use window_relative_x_coord. + (note_mouse_highlight): Change window_from_coordinates call. + + * w32term.c (w32_read_socket): + * msdos.c (dos_rawgetc): + * xterm.c (handle_one_xevent): Likewise. + +2010-11-16 Dan Nicolaescu <dann@ics.uci.edu> + + * strftime.c (LOCALE_PARAM_DECL): Update for standard C. + (LOCALE_PARAM, LOCALE_PARAM_PROTO): Remove, unused. + (memcpy_lowcase, so_week_days, extra_args_spec, emacs_strftimeu): + Convert definitions to standard C. + * regex.c: Do not include <stdlib.h>, config.h does it. + Include unistd.h. + (xrealloc, init_syntax_once, re_match, regcomp, regexec) + (regerror, regfree): Convert definitions to standard C. + * mktime.c (my_mktime_localtime_r, ydhms_tm_diff, ranged_convert) + (__mktime_internal): Convert definitions to standard C. + +2010-11-15 Dan Nicolaescu <dann@ics.uci.edu> + + * w32proc.c: + * w32inevt.c: + * w32heap.c: + * w32.c: Remove config.h include guards. + + * callproc.c (child_setup): Reorder code to simplify #ifdefs. + No code changes. + + * process.c: Include <sys/ioctl.h> unconditionally, + keyboard.c already does it. + + * keyboard.c (pending_malloc_warning): Add const to match + definition in alloc.c. + (Fset_input_interrupt_mode): Simplify #ifdefs. + +2010-11-15 Dan Nicolaescu <dann@ics.uci.edu> + + Clean up systty.h macros. + * systty.h (EMACS_GET_TTY_PGRP, EMACS_SET_TTY_PGRP, EMACS_GET_TTY) + (EMACS_SET_TTY): Remove unneeded abstraction, instead inline the + definition in all uses. + (EMACS_TTY_TABS_OK): Remove, it has a single user. + * sysdep.c (discard_tty_input, child_setup_tty) + (init_sys_modes, tabs_safe_p, reset_sys_modes): + * emacs.c (shut_down_emacs): + * callproc.c (child_setup): + * term.c (dissociate_if_controlling_tty): Inline removed macros. + + * data.c (sign_extend_temp, sign_extend_lisp_int): Remove, unused. + +2010-11-14 Chong Yidong <cyd@stupidchicken.com> + + * w32fns.c (Fx_create_frame): + * nsfns.m (Fx_create_frame): Don't check for the cursorColor + resource here; it's now done at startup. + +2010-11-14 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.c (set_wm_state): Add Qnil to final cons. + + * xselect.c (x_send_client_event): Remove unused variables cons and + size. + +2010-11-14 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * keyboard.c (modify_event_symbol) : Add const to array elements of + arg NAME_TABLE. + (lispy_accent_keys, lispy_function_keys, lispy_multimedia_keys) + (lispy_kana_keys, iso_lispy_function_keys, lispy_wheel_names) + (lispy_wheel_names, lispy_drag_n_drop_names, modifier_names): + Add const to array elements. + (scroll_bar_parts): Make static. Fix position of const. + + * w32fns.c (lispy_function_keys): Add const to extern. + + * w32inevt.c (lispy_function_keys): Likewise. + +2010-11-14 Chong Yidong <cyd@stupidchicken.com> + + * xfns.c (Fx_create_frame): Don't check for the cursorColor + resource here; it's now done at startup. + +2010-11-13 Dan Nicolaescu <dann@ics.uci.edu> + + * xmenu.c: Make it clear that ../lwlib/lwlib.h is only needed for Motif. + + Fix compilation on Solaris. + * sysdep.c: Do not #include <term.h>. + (tputs): Add declaration, similar to what cm.c does. (Bug#7178) + + * s/ms-w32.h (HAVE_TERMIOS_H): Do not undef, not used anymore. + +2010-11-13 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.c (set_wm_state): Don't put Atom in cons, call + make_fixnum_or_float on them first. + (x_term_init): Initialize Xatom_net_supporting_wm_check and + Xatom_net_supported correctly. + + * xselect.c (x_send_client_event): Move CHECK_STRING ... + (Fx_send_client_event): to here. + +2010-11-13 Martin Rudalics <rudalics@gmx.at> + + * window.c (Fwindow_use_time): New function. + +2010-11-13 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (set_cursor_from_row): Fix cursor positioning on + zero-width characters. + + * .gdbinit (pgx): Adapt to latest changes in `struct glyph'. + + * w32term.c (x_draw_glyphless_glyph_string_foreground): Draw the + box before drawing the glyphs inside it. + + * xdisp.c (syms_of_xdisp) <glyphless-char-display>: Doc fix. + + * dispextern.h (enum glyphless_display_method): Rename + GLYPHLESS_DISPLAY_HEXA_CODE to GLYPHLESS_DISPLAY_HEX_CODE. All + users changed. + + * term.c (append_glyphless_glyph, produce_glyphless_glyph): Fix + comments. + (produce_glyphless_glyph): Enclose "U+nnnn" and "empty box" + whitespace in "[]", to simulate a box. Don't use uninitialized + variable `width'. + +2010-11-11 Julien Danjou <julien@danjou.info> + + * xsettings.c (init_xsettings): Use already fetch atoms. + + * xsmfns.c (create_client_leader_window): Use SM_CLIENT_ID atom + from dpyinfo. + + * xselect.c (Fx_send_client_event): Split and create + x_send_client_event. + + * lisp.h: Do not EXFUN Fx_send_client_event. + + * xterm.c (x_set_frame_alpha): Use _NET_WM_WINDOW_OPACITY atom + from dpyinfo. + (wm_supports): Use atoms from dpyinfo. + (do_ewmh_fullscreen): Use atoms from dpyinfo. + (x_ewmh_activate_frame): Use atoms from dpyinfo. + (xembed_set_info): Use atoms from dpyinfo. + (x_term_init): Fetch _XEMBED_INFO, _NET_SUPPORTED, + _NET_SUPPORTING_WM_CHECK, _NET_WM_WINDOW_OPACITY and + _NET_ACTIVE_WINDOW, XSETTINGS atoms. + Get all atoms in one round-trip. + (set_wm_state): Use x_send_client_event rather than + Fx_send_client_event, using Atom directly. + (x_ewmh_activate_frame): Ditto. + (x_set_sticky): Pass atoms to set_wm_state. + (do_ewmh_fullscreen): Ditto. + + + * xterm.h (x_display_info): Add Xatom_net_supported, + Xatom_net_supporting_wm_check, Xatom_net_active_window, + Xatom_net_wm_window_opacity, Xatom_XEMBED_INFO, SM_CLIENT_ID. + + * xfns.c (Fx_show_tip): Fix typo in docstring. + +2010-11-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * cmds.c (Fself_insert_command): Don't call XFASTINT without checking + it's not negative. + +2010-11-10 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * font.c (font_filter_properties): Add const to array elements of + properties args. + + * font.h (font_filter_properties): Likewise. + + * ftfont.c (ftfont_booleans, ftfont_non_booleans): Add const to array + elements. + + * w32font.c (w32font_booleans, w32font_non_booleans): Likewise. + +2010-11-10 Michael Albinus <michael.albinus@gmx.de> + + * dbusbind.c (QCdbus_type_unix_fd): New Lisp object. + (XD_BASIC_DBUS_TYPE, xd_symbol_to_dbus_type, xd_signature) + (xd_append_arg, xd_retrieve_arg): Support DBUS_TYPE_UNIX_FD. + (Fdbus_call_method): Add DBUS_TYPE_UNIX_FD type mapping to doc string. + (syms_of_dbusbind): Initialize QCdbus_type_unix_fd). + +2010-11-10 Glenn Morris <rgm@gnu.org> + + * emacs.c (syms_of_emacs) <system-type>: Doc fix. + +2010-11-09 Eli Zaretskii <eliz@gnu.org> + + * xfns.c (x_real_positions): Fix declaration-after-statement problem. + +2010-11-09 Chong Yidong <cyd@stupidchicken.com> + + * image.c (free_image): Don't garbage the frame here, since this + function can be called while redisplaying (Bug#7210). + (uncache_image): Garbage the frame here (Bug#6426). + +2010-11-09 Jan Djärv <jan.h.d@swipnet.se> + + * xfns.c (x_real_positions): Only use _NET_FRAME_EXTENTS if our + parent is the root window. Check this after traversing window tree. + + * xterm.c (x_term_init): Initialize Xatom_net_frame_extents. + + * xterm.h (struct x_display_info): Xatom_net_frame_extents is new. + + * xfns.c (x_real_positions): Try to get _NET_FRAME_EXTENTS first + before traversing window tree (Bug#5721). + 2010-11-07 Jan Djärv <jan.h.d@swipnet.se> * xfns.c (set_machine_and_pid_properties): Let X set WM_CLIENT_MACHINE.
--- a/src/callproc.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/callproc.c Wed Nov 17 13:09:08 2010 +0900 @@ -1154,6 +1154,14 @@ #ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); set_process_dir (SDATA (current_dir)); + /* Spawn the child. (See ntproc.c:Spawnve). */ + cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); + reset_standard_handles (in, out, err, handles); + if (cpid == -1) + /* An error occurred while trying to spawn the process. */ + report_file_error ("Spawning child process", Qnil); + return cpid; + #else /* not WINDOWSNT */ /* Make sure that in, out, and err are not actually already in descriptors zero, one, or two; this could happen if Emacs is @@ -1192,36 +1200,17 @@ emacs_close (out); if (err != in && err != out) emacs_close (err); -#endif /* not MSDOS */ -#endif /* not WINDOWSNT */ #if defined(USG) #ifndef SETPGRP_RELEASES_CTTY setpgrp (); /* No arguments but equivalent in this case */ #endif -#else +#else /* not USG */ setpgrp (pid, pid); -#endif /* USG */ +#endif /* not USG */ -#ifdef MSDOS - pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env); - xfree (pwd_var); - if (pid == -1) - /* An error occurred while trying to run the subprocess. */ - report_file_error ("Spawning child process", Qnil); - return pid; -#else /* not MSDOS */ -#ifdef WINDOWSNT - /* Spawn the child. (See ntproc.c:Spawnve). */ - cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); - reset_standard_handles (in, out, err, handles); - if (cpid == -1) - /* An error occurred while trying to spawn the process. */ - report_file_error ("Spawning child process", Qnil); - return cpid; -#else /* not WINDOWSNT */ /* setpgrp_of_tty is incorrect here; it uses input_fd. */ - EMACS_SET_TTY_PGRP (0, &pid); + tcsetpgrp (0, pid); /* execvp does not accept an environment arg so the only way to pass this environment is to set environ. Our caller @@ -1233,8 +1222,16 @@ emacs_write (1, new_argv[0], strlen (new_argv[0])); emacs_write (1, "\n", 1); _exit (1); -#endif /* not WINDOWSNT */ -#endif /* not MSDOS */ + +#else /* MSDOS */ + pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env); + xfree (pwd_var); + if (pid == -1) + /* An error occurred while trying to run the subprocess. */ + report_file_error ("Spawning child process", Qnil); + return pid; +#endif /* MSDOS */ +#endif /* not WINDOWSNT */ } #ifndef WINDOWSNT @@ -1609,5 +1606,3 @@ defsubr (&Scall_process_region); } -/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95 - (do not change this comment) */
--- a/src/cmds.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/cmds.c Wed Nov 17 13:09:08 2010 +0900 @@ -276,7 +276,7 @@ (Lisp_Object n) { int remove_boundary = 1; - CHECK_NUMBER (n); + CHECK_NATNUM (n); if (!EQ (Vthis_command, current_kboard->Vlast_command)) nonundocount = 0;
--- a/src/config.in Mon Nov 08 14:19:54 2010 +0900 +++ b/src/config.in Wed Nov 17 13:09:08 2010 +0900 @@ -687,9 +687,6 @@ /* Define to 1 if you have the <sys/systeminfo.h> header file. */ #undef HAVE_SYS_SYSTEMINFO_H -/* Define to 1 if you have the <sys/timeb.h> header file. */ -#undef HAVE_SYS_TIMEB_H - /* Define to 1 if you have the <sys/time.h> header file. */ #undef HAVE_SYS_TIME_H @@ -711,9 +708,6 @@ /* Define to 1 if you have the <sys/_mbstate_t.h> header file. */ #undef HAVE_SYS__MBSTATE_T_H -/* Define to 1 if you have the <termios.h> header file. */ -#undef HAVE_TERMIOS_H - /* Define to 1 if you have the <term.h> header file. */ #undef HAVE_TERM_H @@ -1059,9 +1053,6 @@ /* Define to `int' if <sys/types.h> does not define. */ #undef pid_t -/* Define to `unsigned int' if <sys/types.h> does not define. */ -#undef size_t - /* Define to any substitute for sys_siglist. */ #undef sys_siglist
--- a/src/data.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/data.c Wed Nov 17 13:09:08 2010 +0900 @@ -135,21 +135,6 @@ xsignal3 (Qargs_out_of_range, a1, a2, a3); } -/* On some machines, XINT needs a temporary location. - Here it is, in case it is needed. */ - -int sign_extend_temp; - -/* On a few machines, XINT can only be done by calling this. */ - -int -sign_extend_lisp_int (EMACS_INT num) -{ - if (num & (((EMACS_INT) 1) << (VALBITS - 1))) - return num | (((EMACS_INT) (-1)) << VALBITS); - else - return num & ((((EMACS_INT) 1) << VALBITS) - 1); -} /* Data type predicates */
--- a/src/dbusbind.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/dbusbind.c Wed Nov 17 13:09:08 2010 +0900 @@ -57,6 +57,9 @@ Lisp_Object QCdbus_type_int64, QCdbus_type_uint64; Lisp_Object QCdbus_type_double, QCdbus_type_string; Lisp_Object QCdbus_type_object_path, QCdbus_type_signature; +#ifdef DBUS_TYPE_UNIX_FD +Lisp_Object QCdbus_type_unix_fd; +#endif Lisp_Object QCdbus_type_array, QCdbus_type_variant; Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry; @@ -147,6 +150,22 @@ #endif /* Check whether TYPE is a basic DBusType. */ +#ifdef DBUS_TYPE_UNIX_FD +#define XD_BASIC_DBUS_TYPE(type) \ + ((type == DBUS_TYPE_BYTE) \ + || (type == DBUS_TYPE_BOOLEAN) \ + || (type == DBUS_TYPE_INT16) \ + || (type == DBUS_TYPE_UINT16) \ + || (type == DBUS_TYPE_INT32) \ + || (type == DBUS_TYPE_UINT32) \ + || (type == DBUS_TYPE_INT64) \ + || (type == DBUS_TYPE_UINT64) \ + || (type == DBUS_TYPE_DOUBLE) \ + || (type == DBUS_TYPE_STRING) \ + || (type == DBUS_TYPE_OBJECT_PATH) \ + || (type == DBUS_TYPE_SIGNATURE) \ + || (type == DBUS_TYPE_UNIX_FD)) +#else #define XD_BASIC_DBUS_TYPE(type) \ ((type == DBUS_TYPE_BYTE) \ || (type == DBUS_TYPE_BOOLEAN) \ @@ -160,6 +179,7 @@ || (type == DBUS_TYPE_STRING) \ || (type == DBUS_TYPE_OBJECT_PATH) \ || (type == DBUS_TYPE_SIGNATURE)) +#endif /* This was a macro. On Solaris 2.11 it was said to compile for hours, when optimzation is enabled. So we have transferred it into @@ -182,6 +202,9 @@ : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE +#ifdef DBUS_TYPE_UNIX_FD + : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD +#endif : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT @@ -238,6 +261,9 @@ case DBUS_TYPE_UINT16: case DBUS_TYPE_UINT32: case DBUS_TYPE_UINT64: +#ifdef DBUS_TYPE_UNIX_FD + case DBUS_TYPE_UNIX_FD: +#endif CHECK_NATNUM (object); sprintf (signature, "%c", dtype); break; @@ -451,6 +477,9 @@ } case DBUS_TYPE_UINT32: +#ifdef DBUS_TYPE_UNIX_FD + case DBUS_TYPE_UNIX_FD: +#endif CHECK_NUMBER (object); { dbus_uint32_t val = XUINT (object); @@ -648,6 +677,9 @@ } case DBUS_TYPE_UINT32: +#ifdef DBUS_TYPE_UNIX_FD + case DBUS_TYPE_UNIX_FD: +#endif { dbus_uint32_t val; dbus_message_iter_get_basic (iter, &val); @@ -983,6 +1015,7 @@ DBUS_TYPE_UINT16 => number DBUS_TYPE_INT16 => integer DBUS_TYPE_UINT32 => number or float + DBUS_TYPE_UNIX_FD => number or float DBUS_TYPE_INT32 => integer or float DBUS_TYPE_UINT64 => number or float DBUS_TYPE_INT64 => integer or float @@ -2104,6 +2137,11 @@ QCdbus_type_signature = intern_c_string (":signature"); staticpro (&QCdbus_type_signature); +#ifdef DBUS_TYPE_UNIX_FD + QCdbus_type_unix_fd = intern_c_string (":unix-fd"); + staticpro (&QCdbus_type_unix_fd); +#endif + QCdbus_type_array = intern_c_string (":array"); staticpro (&QCdbus_type_array);
--- a/src/dispextern.h Mon Nov 08 14:19:54 2010 +0900 +++ b/src/dispextern.h Wed Nov 17 13:09:08 2010 +0900 @@ -371,12 +371,11 @@ displaying. The member `pixel_width' above is set to 1. */ unsigned padding_p : 1; - /* 1 means the actual glyph is not available, draw a box instead. - This can happen when a font couldn't be loaded, or a character - doesn't have a glyph in a font. */ + /* 1 means the actual glyph is not available, draw using `struct + glyphless' below instead. This can happen when a font couldn't + be loaded, or a character doesn't have a glyph in a font. */ unsigned glyph_not_available_p : 1; - /* Non-zero means don't display cursor here. */ unsigned avoid_cursor_p : 1; @@ -1997,14 +1996,15 @@ enum glyphless_display_method { - /* Display a thin (1-pixel width) space. */ + /* Display a thin (1-pixel width) space. On a TTY, display a + 1-character width space. */ GLYPHLESS_DISPLAY_THIN_SPACE, /* Display an empty box of proper width. */ GLYPHLESS_DISPLAY_EMPTY_BOX, /* Display an acronym string in a box. */ GLYPHLESS_DISPLAY_ACRONYM, - /* Display a hexadecimal character code in a box. */ - GLYPHLESS_DISPLAY_HEXA_CODE + /* Display the hexadecimal code of the character in a box. */ + GLYPHLESS_DISPLAY_HEX_CODE }; struct it_slice
--- a/src/dispnew.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/dispnew.c Wed Nov 17 13:09:08 2010 +0900 @@ -5393,7 +5393,7 @@ BYTEPOS (startp) = min (ZV_BYTE, max (BEGV_BYTE, BYTEPOS (startp))); start_display (&it, w, startp); - x0 = *x - WINDOW_LEFT_MARGIN_WIDTH (w); + x0 = *x; /* First, move to the beginning of the row corresponding to *Y. We need to be in that row to get the correct value of base paragraph
--- a/src/emacs.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/emacs.c Wed Nov 17 13:09:08 2010 +0900 @@ -1,7 +1,8 @@ /* Fully extensible Emacs, running on Unix, intended for GNU. - Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, 1998, 1999, - 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, - 2010 Free Software Foundation, Inc. + +Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, 1998, 1999, + 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -2052,10 +2053,8 @@ #ifndef DOS_NT { int pgrp = EMACS_GETPGRP (0); - - int tpgrp; - if (EMACS_GET_TTY_PGRP (0, &tpgrp) != -1 - && tpgrp == pgrp) + int tpgrp = tcgetpgrp (0); + if ((tpgrp != -1) && tpgrp == pgrp) { reset_all_sys_modes (); if (sig && sig != SIGTERM) @@ -2411,9 +2410,10 @@ `ms-dos' compiled as an MS-DOS application. `windows-nt' compiled as a native W32 application. `cygwin' compiled using the Cygwin library. -Anything else (in Emacs 23.1, the possibilities are: aix, berkeley-unix, -hpux, irix, lynxos 3.0.1, usg-unix-v) indicates some sort of Unix system. */); +Anything else (in Emacs 24.1, the possibilities are: aix, berkeley-unix, +hpux, irix, usg-unix-v) indicates some sort of Unix system. */); Vsystem_type = intern_c_string (SYSTEM_TYPE); + /* Above values are from SYSTEM_TYPE in src/s/*.h. */ DEFVAR_LISP ("system-configuration", &Vsystem_configuration, doc: /* Value is string indicating configuration Emacs was built for. @@ -2531,5 +2531,3 @@ daemon_pipe[1] = 0; } -/* arch-tag: 7bfd356a-c720-4612-8ab6-aa4222931c2e - (do not change this comment) */
--- a/src/font.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/font.c Wed Nov 17 13:09:08 2010 +0900 @@ -3732,8 +3732,8 @@ void font_filter_properties (Lisp_Object font, Lisp_Object alist, - const char *boolean_properties[], - const char *non_boolean_properties[]) + const char *const boolean_properties[], + const char *const non_boolean_properties[]) { Lisp_Object it; int i;
--- a/src/font.h Mon Nov 08 14:19:54 2010 +0900 +++ b/src/font.h Wed Nov 17 13:09:08 2010 +0900 @@ -823,8 +823,8 @@ extern void font_filter_properties (Lisp_Object font, Lisp_Object alist, - const char *boolean_properties[], - const char *non_boolean_properties[]); + const char *const boolean_properties[], + const char *const non_boolean_properties[]); #ifdef HAVE_FREETYPE extern struct font_driver ftfont_driver;
--- a/src/ftfont.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/ftfont.c Wed Nov 17 13:09:08 2010 +0900 @@ -2598,7 +2598,7 @@ return intern ("unknown"); } -static const char *ftfont_booleans [] = { +static const char *const ftfont_booleans [] = { ":antialias", ":hinting", ":verticallayout", @@ -2611,7 +2611,7 @@ NULL, }; -static const char *ftfont_non_booleans [] = { +static const char *const ftfont_non_booleans [] = { ":family", ":familylang", ":style",
--- a/src/image.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/image.c Wed Nov 17 13:09:08 2010 +0900 @@ -1049,10 +1049,6 @@ /* Free resources, then free IMG. */ img->type->free (f, img); xfree (img); - - /* As display glyphs may still be referring to the image ID, we - must garbage the frame (Bug#6426). */ - SET_FRAME_GARBAGED (f); } } @@ -1471,7 +1467,12 @@ { struct image *img = search_image_cache (f, spec, sxhash (spec, 0)); if (img) - free_image (f, img); + { + free_image (f, img); + /* As display glyphs may still be referring to the image ID, we + must garbage the frame (Bug#6426). */ + SET_FRAME_GARBAGED (f); + } }
--- a/src/keyboard.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/keyboard.c Wed Nov 17 13:09:08 2010 +0900 @@ -431,7 +431,7 @@ /* Nonzero if input is available. */ int input_pending; -extern char *pending_malloc_warning; +extern const char *pending_malloc_warning; /* Circular buffer for pre-read keyboard input. */ @@ -620,7 +620,7 @@ unsigned long); #endif static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object, - Lisp_Object, const char **, + Lisp_Object, const char *const *, Lisp_Object *, unsigned); static Lisp_Object make_lispy_switch_frame (Lisp_Object); static void save_getcjmp (jmp_buf); @@ -4752,7 +4752,7 @@ /* This is a list of Lisp names for special "accent" characters. It parallels lispy_accent_codes. */ -static const char *lispy_accent_keys[] = +static const char *const lispy_accent_keys[] = { "dead-circumflex", "dead-grave", @@ -4779,7 +4779,7 @@ #ifdef HAVE_NTGUI #define FUNCTION_KEY_OFFSET 0x0 -char const *lispy_function_keys[] = +const char *const lispy_function_keys[] = { 0, /* 0 */ @@ -4973,7 +4973,7 @@ /* Some of these duplicate the "Media keys" on newer keyboards, but they are delivered to the application in a different way. */ -static const char *lispy_multimedia_keys[] = +static const char *const lispy_multimedia_keys[] = { 0, "browser-back", @@ -5037,7 +5037,7 @@ the XK_kana_A case below. */ #if 0 #ifdef XK_kana_A -static const char *lispy_kana_keys[] = +static const char *const lispy_kana_keys[] = { /* X Keysym value */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */ @@ -5076,7 +5076,7 @@ /* You'll notice that this table is arranged to be conveniently indexed by X Windows keysym values. */ -static const char *lispy_function_keys[] = +static const char *const lispy_function_keys[] = { /* X Keysym value */ @@ -5162,7 +5162,7 @@ /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */ #define ISO_FUNCTION_KEY_OFFSET 0xfe00 -static const char *iso_lispy_function_keys[] = +static const char *const iso_lispy_function_keys[] = { 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */ 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */ @@ -5185,14 +5185,14 @@ Lisp_Object Vlispy_mouse_stem; -static const char *lispy_wheel_names[] = +static const char *const lispy_wheel_names[] = { "wheel-up", "wheel-down", "wheel-left", "wheel-right" }; /* drag-n-drop events are generated when a set of selected files are dragged from another application and dropped onto an Emacs window. */ -static const char *lispy_drag_n_drop_names[] = +static const char *const lispy_drag_n_drop_names[] = { "drag-n-drop" }; @@ -5203,7 +5203,7 @@ Lisp_Object Qtop, Qratio; /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */ -const Lisp_Object *scroll_bar_parts[] = { +static Lisp_Object *const scroll_bar_parts[] = { &Qabove_handle, &Qhandle, &Qbelow_handle, &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio }; @@ -5243,24 +5243,22 @@ int double_click_count; -/* Return position of a mouse click or wheel event */ +/* X and Y are frame-relative coordinates for a click or wheel event. + Return a Lisp-style event list. */ static Lisp_Object -make_lispy_position (struct frame *f, Lisp_Object *x, Lisp_Object *y, +make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, unsigned long time) { - Lisp_Object window; enum window_part part; Lisp_Object posn = Qnil; Lisp_Object extra_info = Qnil; - int wx, wy; - - /* Set `window' to the window under frame pixel coordinates (x,y) */ - if (f) - window = window_from_coordinates (f, XINT (*x), XINT (*y), - &part, &wx, &wy, 0); - else - window = Qnil; + /* Coordinate pixel positions to return. */ + int xret = 0, yret = 0; + /* The window under frame pixel coordinates (x,y) */ + Lisp_Object window = f + ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0) + : Qnil; if (WINDOWP (window)) { @@ -5268,102 +5266,113 @@ struct window *w = XWINDOW (window); Lisp_Object string_info = Qnil; EMACS_INT textpos = -1; - int rx = -1, ry = -1; - int dx = -1, dy = -1; + int col = -1, row = -1; + int dx = -1, dy = -1; int width = -1, height = -1; Lisp_Object object = Qnil; - /* Set event coordinates to window-relative coordinates - for constructing the Lisp event below. */ - XSETINT (*x, wx); - XSETINT (*y, wy); - + /* Pixel coordinates relative to the window corner. */ + int wx = XINT (x) - WINDOW_LEFT_EDGE_X (w); + int wy = XINT (y) - WINDOW_TOP_EDGE_Y (w); + + /* For text area clicks, return X, Y relative to the corner of + this text area. Note that dX, dY etc are set below, by + buffer_posn_from_coords. */ if (part == ON_TEXT) { - wx += WINDOW_LEFT_MARGIN_WIDTH (w); - } + xret = XINT (x) - window_box_left (w, TEXT_AREA); + yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); + } + /* For mode line and header line clicks, return X relative to + the left window edge; ignore Y. Use mode_line_string to look + for a string on the click position. */ else if (part == ON_MODE_LINE || part == ON_HEADER_LINE) { - /* Mode line or header line. Look for a string under - the mouse that may have a `local-map' property. */ Lisp_Object string; EMACS_INT charpos; - posn = part == ON_MODE_LINE ? Qmode_line : Qheader_line; - rx = wx, ry = wy; - string = mode_line_string (w, part, &rx, &ry, &charpos, + posn = (part == ON_MODE_LINE) ? Qmode_line : Qheader_line; + /* Note that mode_line_string takes COL, ROW as pixels and + converts them to characters. */ + col = wx; + row = wy; + string = mode_line_string (w, part, &col, &row, &charpos, &object, &dx, &dy, &width, &height); if (STRINGP (string)) string_info = Fcons (string, make_number (charpos)); - if (w == XWINDOW (selected_window) - && current_buffer == XBUFFER (w->buffer)) - textpos = PT; - else - textpos = XMARKER (w->pointm)->charpos; - } - else if (part == ON_VERTICAL_BORDER) - { - posn = Qvertical_line; - wx = -1; - dx = 0; - width = 1; - } + textpos = (w == XWINDOW (selected_window) + && current_buffer == XBUFFER (w->buffer)) + ? PT : XMARKER (w->pointm)->charpos; + + xret = wx; + } + /* For fringes and margins, Y is relative to the area's (and the + window's) top edge, while X is meaningless. */ else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN) { Lisp_Object string; EMACS_INT charpos; posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin; - rx = wx, ry = wy; - string = marginal_area_string (w, part, &rx, &ry, &charpos, + col = wx; + row = wy; + string = marginal_area_string (w, part, &col, &row, &charpos, &object, &dx, &dy, &width, &height); if (STRINGP (string)) string_info = Fcons (string, make_number (charpos)); - if (part == ON_LEFT_MARGIN) - wx = 0; - else - wx = window_box_right_offset (w, TEXT_AREA) - 1; + yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); } else if (part == ON_LEFT_FRINGE) { posn = Qleft_fringe; - rx = 0; - dx = wx; - wx = (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) - ? 0 - : window_box_width (w, LEFT_MARGIN_AREA)); - dx -= wx; + col = 0; + dx = wx + - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) + ? 0 : window_box_width (w, LEFT_MARGIN_AREA)); + dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); } else if (part == ON_RIGHT_FRINGE) { posn = Qright_fringe; - rx = 0; - dx = wx; - wx = (window_box_width (w, LEFT_MARGIN_AREA) - + window_box_width (w, TEXT_AREA) - + (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) - ? window_box_width (w, RIGHT_MARGIN_AREA) - : 0)); - dx -= wx; - } - else - { - /* Note: We have no special posn for part == ON_SCROLL_BAR. */ - wx = max (WINDOW_LEFT_MARGIN_WIDTH (w), wx); - } - + col = 0; + dx = wx + - window_box_width (w, LEFT_MARGIN_AREA) + - window_box_width (w, TEXT_AREA) + - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) + ? window_box_width (w, RIGHT_MARGIN_AREA) + : 0); + dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w); + } + else if (part == ON_VERTICAL_BORDER) + { + posn = Qvertical_line; + width = 1; + dx = 0; + dy = yret = wy; + } + /* Nothing special for part == ON_SCROLL_BAR. */ + + /* For clicks in the text area, fringes, or margins, call + buffer_posn_from_coords to extract TEXTPOS, the buffer + position nearest to the click. */ if (textpos < 0) { Lisp_Object string2, object2 = Qnil; struct display_pos p; int dx2, dy2; int width2, height2; - string2 = buffer_posn_from_coords (w, &wx, &wy, &p, + /* The pixel X coordinate passed to buffer_posn_from_coords + is the X coordinate relative to the text area for + text-area clicks, zero otherwise. */ + int x2 = (part == ON_TEXT) ? xret : 0; + int y2 = wy; + + string2 = buffer_posn_from_coords (w, &x2, &y2, &p, &object2, &dx2, &dy2, &width2, &height2); textpos = CHARPOS (p.pos); - if (rx < 0) rx = wx; - if (ry < 0) ry = wy; + if (col < 0) col = x2; + if (row < 0) row = y2; if (dx < 0) dx = dx2; if (dy < 0) dy = dy2; if (width < 0) width = width2; @@ -5394,34 +5403,27 @@ #endif /* Object info */ - extra_info = Fcons (object, - Fcons (Fcons (make_number (dx), - make_number (dy)), - Fcons (Fcons (make_number (width), - make_number (height)), - Qnil))); + extra_info + = list3 (object, + Fcons (make_number (dx), make_number (dy)), + Fcons (make_number (width), make_number (height))); /* String info */ extra_info = Fcons (string_info, Fcons (make_number (textpos), - Fcons (Fcons (make_number (rx), - make_number (ry)), + Fcons (Fcons (make_number (col), + make_number (row)), extra_info))); } else if (f != 0) - { - XSETFRAME (window, f); - } + XSETFRAME (window, f); else - { - window = Qnil; - XSETFASTINT (*x, 0); - XSETFASTINT (*y, 0); - } + window = Qnil; return Fcons (window, Fcons (posn, - Fcons (Fcons (*x, *y), + Fcons (Fcons (make_number (xret), + make_number (yret)), Fcons (make_number (time), extra_info)))); } @@ -5610,14 +5612,6 @@ int hpos; int i; -#if 0 - /* Activate the menu bar on the down event. If the - up event comes in before the menu code can deal with it, - just ignore it. */ - if (! (event->modifiers & down_modifier)) - return Qnil; -#endif - /* Find the menu bar item under `column'. */ item = Qnil; items = FRAME_MENU_BAR_ITEMS (f); @@ -5649,7 +5643,7 @@ } #endif /* not USE_X_TOOLKIT && not USE_GTK && not HAVE_NS */ - position = make_lispy_position (f, &event->x, &event->y, + position = make_lispy_position (f, event->x, event->y, event->timestamp); } #ifndef USE_TOOLKIT_SCROLL_BARS @@ -5749,23 +5743,21 @@ return Qnil; event->modifiers &= ~up_modifier; -#if 0 /* Formerly we treated an up with no down as a click event. */ - if (!CONSP (start_pos)) - event->modifiers |= click_modifier; - else -#endif + { - Lisp_Object down; + Lisp_Object new_down, down; EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz; /* The third element of every position should be the (x,y) pair. */ down = Fcar (Fcdr (Fcdr (start_pos))); + new_down = Fcar (Fcdr (Fcdr (position))); + if (CONSP (down) && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down))) { - xdiff = XINT (event->x) - XINT (XCAR (down)); - ydiff = XINT (event->y) - XINT (XCDR (down)); + xdiff = XINT (XCAR (new_down)) - XINT (XCAR (down)); + ydiff = XINT (XCDR (new_down)) - XINT (XCDR (down)); } if (ignore_mouse_drag_p) @@ -5848,7 +5840,7 @@ if (! FRAME_LIVE_P (f)) return Qnil; - position = make_lispy_position (f, &event->x, &event->y, + position = make_lispy_position (f, event->x, event->y, event->timestamp); /* Set double or triple modifiers to indicate the wheel speed. */ @@ -5868,10 +5860,8 @@ else abort (); - if (FRAME_WINDOW_P (f)) - fuzz = double_click_fuzz; - else - fuzz = double_click_fuzz / 8; + fuzz = FRAME_WINDOW_P (f) + ? double_click_fuzz : double_click_fuzz / 8; if (event->modifiers & up_modifier) { @@ -6009,7 +5999,7 @@ if (! FRAME_LIVE_P (f)) return Qnil; - position = make_lispy_position (f, &event->x, &event->y, + position = make_lispy_position (f, event->x, event->y, event->timestamp); head = modify_event_symbol (0, event->modifiers, @@ -6092,8 +6082,8 @@ start_pos_ptr = &AREF (button_down_location, button); start_pos = *start_pos_ptr; - position = make_lispy_position (f, &event->x, &event->y, - event->timestamp); + position = make_lispy_position (f, event->x, event->y, + event->timestamp); if (event->modifiers & down_modifier) *start_pos_ptr = Fcopy_alist (position); @@ -6152,25 +6142,19 @@ part_sym = *scroll_bar_parts[(int) part]; return Fcons (Qscroll_bar_movement, - (Fcons (Fcons (bar_window, - Fcons (Qvertical_scroll_bar, - Fcons (Fcons (x, y), - Fcons (make_number (time), - Fcons (part_sym, - Qnil))))), - Qnil))); - } - + Fcons (list5 (bar_window, + Qvertical_scroll_bar, + Fcons (x, y), + make_number (time), + part_sym), + Qnil)); + } /* Or is it an ordinary mouse movement? */ else { Lisp_Object position; - - position = make_lispy_position (frame, &x, &y, time); - - return Fcons (Qmouse_movement, - Fcons (position, - Qnil)); + position = make_lispy_position (frame, x, y, time); + return list2 (Qmouse_movement, position); } } @@ -6351,7 +6335,7 @@ } -static const char *modifier_names[] = +static const char *const modifier_names[] = { "up", "down", "drag", "click", "double", "triple", 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -6571,7 +6555,7 @@ static Lisp_Object modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object symbol_kind, - Lisp_Object name_alist_or_stem, const char **name_table, + Lisp_Object name_alist_or_stem, const char *const *name_table, Lisp_Object *symbol_table, unsigned int table_size) { Lisp_Object value; @@ -11100,10 +11084,10 @@ #ifndef DOS_NT /* this causes startup screen to be restored and messes with the mouse */ reset_all_sys_modes (); -#endif interrupt_input = new_interrupt_input; -#ifndef DOS_NT init_all_sys_modes (); +#else + interrupt_input = new_interrupt_input; #endif #ifdef POLL_FOR_INPUT @@ -11327,7 +11311,7 @@ CHECK_LIVE_FRAME (frame_or_window); - return make_lispy_position (XFRAME (frame_or_window), &x, &y, 0); + return make_lispy_position (XFRAME (frame_or_window), x, y, 0); } DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
--- a/src/lisp.h Mon Nov 08 14:19:54 2010 +0900 +++ b/src/lisp.h Wed Nov 17 13:09:08 2010 +0900 @@ -3600,7 +3600,6 @@ extern void syms_of_xsmfns (void); /* Defined in xselect.c */ -EXFUN (Fx_send_client_event, 6); extern void syms_of_xselect (void); /* Defined in xterm.c */
--- a/src/mktime.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/mktime.c Wed Nov 17 13:09:08 2010 +0900 @@ -110,9 +110,7 @@ localtime to localtime_r, since many localtime_r implementations are buggy. */ static struct tm * -my_mktime_localtime_r (t, tp) - const time_t *t; - struct tm *tp; +my_mktime_localtime_r (const time_t *t, struct tm *tp) { struct tm *l = localtime (t); if (! l) @@ -130,9 +128,7 @@ If TP is null, return a nonzero value. If overflow occurs, yield the low order bits of the correct answer. */ static time_t -ydhms_tm_diff (year, yday, hour, min, sec, tp) - int year, yday, hour, min, sec; - const struct tm *tp; +ydhms_tm_diff (int year, int yday, int hour, int min, int sec, const struct tm *tp) { if (!tp) return 1; @@ -163,14 +159,8 @@ If *T is out of range for conversion, adjust it so that it is the nearest in-range value and then convert that. */ static struct tm * -ranged_convert (convert, t, tp) -#ifdef PROTOTYPES - struct tm *(*convert) (const time_t *, struct tm *); -#else - struct tm *(*convert)(); -#endif - time_t *t; - struct tm *tp; +ranged_convert (struct tm *(*convert) (const time_t *, struct tm *), + time_t *t, struct tm *tp) { struct tm *r; @@ -217,14 +207,8 @@ compared to what the result would be for UTC without leap seconds. If *OFFSET's guess is correct, only one CONVERT call is needed. */ time_t -__mktime_internal (tp, convert, offset) - struct tm *tp; -#ifdef PROTOTYPES - struct tm *(*convert) (const time_t *, struct tm *); -#else - struct tm *(*convert)(); -#endif - time_t *offset; +__mktime_internal (struct tm *tp, struct tm *(*convert) (const time_t *, struct tm *), + time_t *offset) { time_t t, dt, t0, t1, t2; struct tm tm; @@ -558,5 +542,3 @@ End: */ -/* arch-tag: 9456752f-7ddd-47cb-8286-fa807b1355ae - (do not change this comment) */
--- a/src/msdos.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/msdos.c Wed Nov 17 13:09:08 2010 +0900 @@ -2698,7 +2698,7 @@ mouse_window = window_from_coordinates (SELECTED_FRAME(), mouse_last_x, mouse_last_y, - 0, 0, 0, 0); + 0, 0); /* A window will be selected only when it is not selected now, and the last mouse movement event was not in it. A minibuffer window will be selected iff
--- a/src/nsfns.m Mon Nov 08 14:19:54 2010 +0900 +++ b/src/nsfns.m Wed Nov 17 13:09:08 2010 +0900 @@ -1224,8 +1224,6 @@ "foreground", "Foreground", RES_TYPE_STRING); x_default_parameter (f, parms, Qbackground_color, build_string ("White"), "background", "Background", RES_TYPE_STRING); - x_default_parameter (f, parms, Qcursor_color, build_string ("grey"), - "cursorColor", "CursorColor", RES_TYPE_STRING); /* FIXME: not suppported yet in Nextstep */ x_default_parameter (f, parms, Qline_spacing, Qnil, "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
--- a/src/process.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/process.c Wed Nov 17 13:09:08 2010 +0900 @@ -56,12 +56,10 @@ #endif #endif -#if defined(HAVE_SYS_IOCTL_H) #include <sys/ioctl.h> #if defined(HAVE_NET_IF_H) #include <net/if.h> #endif /* HAVE_NET_IF_H */ -#endif /* HAVE_SYS_IOCTL_H */ #ifdef NEED_BSDTTY #include <bsdtty.h>
--- a/src/regex.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/regex.c Wed Nov 17 13:09:08 2010 +0900 @@ -196,18 +196,14 @@ even if config.h says that we can. */ # undef REL_ALLOC -# if defined STDC_HEADERS || defined _LIBC -# include <stdlib.h> -# else -char *malloc (); -char *realloc (); +# ifdef HAVE_UNISTD_H +# include <unistd.h> # endif /* When used in Emacs's lib-src, we need xmalloc and xrealloc. */ void * -xmalloc (size) - size_t size; +xmalloc (size_t size) { register void *val; val = (void *) malloc (size); @@ -220,9 +216,7 @@ } void * -xrealloc (block, size) - void *block; - size_t size; +xrealloc (void *block, size_t size) { register void *val; /* We must call malloc explicitly when BLOCK is 0, since some @@ -435,7 +429,7 @@ static char re_syntax_table[CHAR_SET_SIZE]; static void -init_syntax_once () +init_syntax_once (void) { register int c; static int done = 0; @@ -4978,11 +4972,8 @@ /* re_match is like re_match_2 except it takes only a single string. */ int -re_match (bufp, string, size, pos, regs) - struct re_pattern_buffer *bufp; - const char *string; - int size, pos; - struct re_registers *regs; +re_match (struct re_pattern_buffer *bufp, const char *string, + int size, int pos, struct re_registers *regs) { int result = re_match_2_internal (bufp, NULL, 0, (re_char*) string, size, pos, regs, size); @@ -6534,10 +6525,8 @@ the return codes and their meanings.) */ int -regcomp (preg, pattern, cflags) - regex_t *__restrict preg; - const char *__restrict pattern; - int cflags; +regcomp (regex_t *__restrict preg, const char *__restrict pattern, + int cflags) { reg_errcode_t ret; reg_syntax_t syntax @@ -6619,12 +6608,8 @@ We return 0 if we find a match and REG_NOMATCH if not. */ int -regexec (preg, string, nmatch, pmatch, eflags) - const regex_t *__restrict preg; - const char *__restrict string; - size_t nmatch; - regmatch_t pmatch[__restrict_arr]; - int eflags; +regexec (const regex_t *__restrict preg, const char *__restrict string, + size_t nmatch, regmatch_t pmatch[__restrict_arr], int eflags) { int ret; struct re_registers regs; @@ -6696,11 +6681,7 @@ error with msvc8 compiler. */ size_t -regerror (err_code, preg, errbuf, errbuf_size) - int err_code; - const regex_t *preg; - char *errbuf; - size_t errbuf_size; +regerror (int err_code, const regex_t *preg, char *errbuf, size_t errbuf_size) { const char *msg; size_t msg_size; @@ -6736,8 +6717,7 @@ /* Free dynamically allocated space used by PREG. */ void -regfree (preg) - regex_t *preg; +regfree (regex_t *preg) { free (preg->buffer); preg->buffer = NULL; @@ -6756,5 +6736,3 @@ #endif /* not emacs */ -/* arch-tag: 4ffd68ba-2a9e-435b-a21a-018990f9eeb2 - (do not change this comment) */
--- a/src/s/ms-w32.h Mon Nov 08 14:19:54 2010 +0900 +++ b/src/s/ms-w32.h Wed Nov 17 13:09:08 2010 +0900 @@ -112,7 +112,6 @@ #undef HAVE_UTIME_H #undef HAVE_LINUX_VERSION_H #undef HAVE_SYS_SYSTEMINFO_H -#undef HAVE_TERMIOS_H #define HAVE_LIMITS_H 1 #define HAVE_STRING_H 1 #define HAVE_STDLIB_H 1
--- a/src/strftime.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/strftime.c Wed Nov 17 13:09:08 2010 +0900 @@ -318,14 +318,10 @@ # undef _NL_CURRENT # define _NL_CURRENT(category, item) \ (current->values[_NL_ITEM_INDEX (item)].string) -# define LOCALE_PARAM , loc # define LOCALE_ARG , loc -# define LOCALE_PARAM_DECL __locale_t loc; -# define LOCALE_PARAM_PROTO , __locale_t loc +# define LOCALE_PARAM_DECL , __locale_t loc # define HELPER_LOCALE_ARG , current #else -# define LOCALE_PARAM -# define LOCALE_PARAM_PROTO # define LOCALE_ARG # define LOCALE_PARAM_DECL # ifdef _LIBC @@ -363,30 +359,16 @@ more reliable way to accept other sets of digits. */ #define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) -static CHAR_T *memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, - size_t len LOCALE_PARAM_PROTO); - static CHAR_T * -memcpy_lowcase (dest, src, len LOCALE_PARAM) - CHAR_T *dest; - const CHAR_T *src; - size_t len; - LOCALE_PARAM_DECL +memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM_DECL) { while (len-- > 0) dest[len] = TOLOWER ((UCHAR_T) src[len], loc); return dest; } -static CHAR_T *memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, - size_t len LOCALE_PARAM_PROTO); - static CHAR_T * -memcpy_uppcase (dest, src, len LOCALE_PARAM) - CHAR_T *dest; - const CHAR_T *src; - size_t len; - LOCALE_PARAM_DECL +memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM_DECL) { while (len-- > 0) dest[len] = TOUPPER ((UCHAR_T) src[len], loc); @@ -437,9 +419,7 @@ __inline__ #endif static int -iso_week_days (yday, wday) - int yday; - int wday; +iso_week_days (int yday, int wday) { /* Add enough to the first operand of % to make it nonnegative. */ int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; @@ -470,7 +450,7 @@ #ifdef my_strftime # define extra_args , ut, ns -# define extra_args_spec int ut; int ns; +# define extra_args_spec , int ut, int ns # define extra_args_spec_iso , int ut, int ns #else # ifdef COMPILE_WIDE @@ -517,13 +497,8 @@ anywhere, so to determine how many characters would be written, use NULL for S and (size_t) UINT_MAX for MAXSIZE. */ size_t -my_strftime (s, maxsize, format, tp extra_args LOCALE_PARAM) - CHAR_T *s; - size_t maxsize; - const CHAR_T *format; - const struct tm *tp; - extra_args_spec - LOCALE_PARAM_DECL +my_strftime (CHAR_T *s, size_t maxsize, const CHAR_T *format, + const struct tm *tp extra_args_spec LOCALE_PARAM_DECL) { #if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL struct locale_data *const current = loc->__locales[LC_TIME]; @@ -1474,16 +1449,10 @@ /* For Emacs we have a separate interface which corresponds to the normal strftime function plus the ut argument, but without the ns argument. */ size_t -emacs_strftimeu (s, maxsize, format, tp, ut) - char *s; - size_t maxsize; - const char *format; - const struct tm *tp; - int ut; +emacs_strftimeu (char *s, size_t maxsize, const char *format, + const struct tm *tp, int ut) { return my_strftime (s, maxsize, format, tp, ut, 0); } #endif -/* arch-tag: 662bc9c4-f8e2-41b6-bf96-b8346d0ce0d8 - (do not change this comment) */
--- a/src/sysdep.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/sysdep.c Wed Nov 17 13:09:08 2010 +0900 @@ -90,12 +90,6 @@ #include "dispextern.h" #include "process.h" #include "cm.h" /* for reset_sys_modes */ -#ifdef HAVE_TERM_H -/* Include this last. If it is ncurses header file, it adds a lot of - defines that interfere with stuff in other headers. Someone responsible - for ncurses messed up bigtime. See bug#6812. */ -#include <term.h> -#endif #ifdef WINDOWSNT #include <direct.h> @@ -123,6 +117,9 @@ #endif #endif +/* Declare here, including term.h is problematic on some systems. */ +extern void tputs (const char *, int, int (*)(int)); + static const int baud_convert[] = { 0, 50, 75, 110, 135, 150, 200, 300, 600, 1200, @@ -232,8 +229,8 @@ { if (tty->input) /* Is the device suspended? */ { - EMACS_GET_TTY (fileno (tty->input), &buf); - EMACS_SET_TTY (fileno (tty->input), &buf, 0); + emacs_get_tty (fileno (tty->input), &buf); + emacs_set_tty (fileno (tty->input), &buf, 0); } } } @@ -369,7 +366,7 @@ #ifndef WINDOWSNT struct emacs_tty s; - EMACS_GET_TTY (out, &s); + emacs_get_tty (out, &s); s.main.c_oflag |= OPOST; /* Enable output postprocessing */ s.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */ #ifdef NLDLY @@ -447,7 +444,7 @@ s.main.c_cc[VTIME] = 0; #endif - EMACS_SET_TTY (out, &s, 0); + emacs_set_tty (out, &s, 0); #endif /* not WINDOWSNT */ } #endif /* not MSDOS */ @@ -859,7 +856,7 @@ if (! tty_out->old_tty) tty_out->old_tty = (struct emacs_tty *) xmalloc (sizeof (struct emacs_tty)); - EMACS_GET_TTY (fileno (tty_out->input), tty_out->old_tty); + emacs_get_tty (fileno (tty_out->input), tty_out->old_tty); tty = *tty_out->old_tty; @@ -1005,7 +1002,7 @@ dos_ttraw (tty_out); #endif - EMACS_SET_TTY (fileno (tty_out->input), &tty, 0); + emacs_set_tty (fileno (tty_out->input), &tty, 0); /* This code added to insure that, if flow-control is not to be used, we have an unlocked terminal at the start. */ @@ -1097,8 +1094,16 @@ { struct emacs_tty etty; - EMACS_GET_TTY (fd, &etty); - return EMACS_TTY_TABS_OK (&etty); + emacs_get_tty (fd, &etty); +#ifndef DOS_NT +#ifdef TABDLY + return ((etty.main.c_oflag & TABDLY) != TAB3); +#else /* not TABDLY */ + return 1; +#endif /* not TABDLY */ +#else /* DOS_NT */ + return 0; +#endif /* DOS_NT */ } /* Get terminal size from system. @@ -1260,7 +1265,7 @@ #endif /* F_SETFL */ if (tty_out->old_tty) - while (EMACS_SET_TTY (fileno (tty_out->input), + while (emacs_set_tty (fileno (tty_out->input), tty_out->old_tty, 0) < 0 && errno == EINTR) ; @@ -3071,6 +3076,3 @@ #endif /* !defined (WINDOWSNT) */ - -/* arch-tag: edb43589-4e09-4544-b325-978b5b121dcf - (do not change this comment) */
--- a/src/systty.h Mon Nov 08 14:19:54 2010 +0900 +++ b/src/systty.h Wed Nov 17 13:09:08 2010 +0900 @@ -86,17 +86,6 @@ /* Manipulate a terminal's current process group. */ -/* EMACS_GET_TTY_PGRP(int FD, int *PGID) sets *PGID the terminal FD's - current process group. Return -1 if there is an error. - - EMACS_SET_TTY_PGRP(int FD, int *PGID) sets the terminal FD's - current process group to *PGID. Return -1 if there is an error. */ - -#ifndef DOS_NT -#define EMACS_GET_TTY_PGRP(fd, pgid) (*(pgid) = tcgetpgrp ((fd))) -#define EMACS_SET_TTY_PGRP(fd, pgid) (tcsetpgrp ((fd), *(pgid))) -#endif /* not DOS_NT */ - /* EMACS_GETPGRP (arg) returns the process group of the process. */ #if defined (GETPGRP_VOID) @@ -112,21 +101,7 @@ state, for example a struct tchars, a struct sgttyb, a struct tchars, a struct ltchars, and a struct pagechars, struct emacs_tty should contain an element for each parameter struct - that Emacs may change. - - EMACS_GET_TTY (int FD, struct emacs_tty *P) stores the parameters - of the tty on FD in *P. Return zero if all's well, or -1 if we ran - into an error we couldn't deal with. - - EMACS_SET_TTY (int FD, struct emacs_tty *P, int flushp) - sets the parameters of the tty on FD according to the contents of - *P. If flushp is non-zero, we discard queued input to be - written before making the change. - Return 0 if all went well, and -1 if anything failed. - - EMACS_TTY_TABS_OK (struct emacs_tty *P) is false if the kernel - expands tabs to spaces upon output; in that case, there is no - advantage to using tabs over spaces. */ + that Emacs may change. */ /* For each tty parameter structure that Emacs might want to save and restore, @@ -145,31 +120,6 @@ #endif /* DOS_NT */ }; -/* Define EMACS_GET_TTY and EMACS_SET_TTY, - the macros for reading and setting parts of `struct emacs_tty'. - - These got pretty unmanageable (huge macros are hard to debug), and - finally needed some code which couldn't be done as part of an - expression, so we moved them out to their own functions in sysdep.c. */ -#define EMACS_GET_TTY(fd, p) (emacs_get_tty ((fd), (p))) -#define EMACS_SET_TTY(fd, p, waitp) (emacs_set_tty ((fd), (p), (waitp))) extern int emacs_get_tty (int, struct emacs_tty *); extern int emacs_set_tty (int, struct emacs_tty *, int); - -/* Define EMACS_TTY_TABS_OK. */ - -#ifndef DOS_NT - -#ifdef TABDLY -#define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3) -#else /* not TABDLY */ -#define EMACS_TTY_TABS_OK(p) 1 -#endif /* not TABDLY */ - -#else /* DOS_NT */ -#define EMACS_TTY_TABS_OK(p) 0 -#endif /* DOS_NT */ - -/* arch-tag: cf4b90bc-be41-401c-be98-40619178a712 - (do not change this comment) */
--- a/src/term.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/term.c Wed Nov 17 13:09:08 2010 +0900 @@ -1850,9 +1850,9 @@ /* Append a glyph for a glyphless character to IT->glyph_row. FACE_ID - is a face ID to be used for the glyph. What actually appended are - glyphs of type CHAR_GLYPH of which characters are in STR - (it->nglyphs bytes). */ + is a face ID to be used for the glyph. What is actually appended + are glyphs of type CHAR_GLYPH whose characters are in STR (which + comes from it->nglyphs bytes). */ static void append_glyphless_glyph (struct it *it, int face_id, char *str) @@ -1923,7 +1923,7 @@ /* Produce glyphs for a glyphless character for iterator IT. IT->glyphless_method specifies which method to use for displaying the character. See the description of enum - glyphless_display_method in dispextern.h for the detail. + glyphless_display_method in dispextern.h for the details. FOR_NO_FONT is nonzero if and only if this is for a character that is not supproted by the coding system of the terminal. ACRONYM, if @@ -1935,11 +1935,11 @@ produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym) { int face_id; - int width, len; - char buf[9], *str = " "; + int len; + char buf[11], *str = " "; /* Get a face ID for the glyph by utilizing a cache (the same way as - doen for `escape-glyph' in get_next_display_element). */ + done for `escape-glyph' in get_next_display_element). */ if (it->f == last_glyphless_glyph_frame && it->face_id == last_glyphless_glyph_face_id) { @@ -1956,8 +1956,8 @@ if (it->glyphless_method == GLYPHLESS_DISPLAY_THIN_SPACE) { - /* As there's no way to produce a thin space, we produce - a space of canonical width.. */ + /* As there's no way to produce a thin space, we produce a space + of canonical width. */ len = 1; } else if (it->glyphless_method == GLYPHLESS_DISPLAY_EMPTY_BOX) @@ -1965,8 +1965,11 @@ len = CHAR_WIDTH (it->c); if (len == 0) len = 1; - else if (width > 4) + else if (len > 4) len = 4; + sprintf (buf, "[%.*s]", len, str); + len += 2; + str = buf; } else { @@ -1983,11 +1986,11 @@ } else { - xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEXA_CODE); - len = (it->c < 0x100 ? sprintf (buf, "U+%02X", it->c) - : it->c < 0x10000 ? sprintf (buf, "U+%04X", it->c) - : it->c <= MAX_UNICODE_CHAR ? sprintf (buf, "U+%06X", it->c) - : sprintf (buf, "E+%06X", it->c)); + xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE); + len = (it->c < 0x100 ? sprintf (buf, "[U+%02X]", it->c) + : it->c < 0x10000 ? sprintf (buf, "[U+%04X]", it->c) + : it->c <= MAX_UNICODE_CHAR ? sprintf (buf, "[U+%06X]", it->c) + : sprintf (buf, "[E+%06X]", it->c)); } str = buf; } @@ -3084,8 +3087,7 @@ dissociate_if_controlling_tty (int fd) { #ifndef DOS_NT - int pgid; - EMACS_GET_TTY_PGRP (fd, &pgid); /* If tcgetpgrp succeeds, fd is the ctty. */ + int pgid = tcgetpgrp (fd); /* If tcgetpgrp succeeds, fd is the ctty. */ if (pgid != -1) { #if defined (USG5) @@ -3829,7 +3831,3 @@ encode_terminal_dst = NULL; } - - -/* arch-tag: 498e7449-6f2e-45e2-91dd-b7d4ca488193 - (do not change this comment) */
--- a/src/w32.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/w32.c Wed Nov 17 13:09:08 2010 +0900 @@ -38,9 +38,7 @@ /* must include CRT headers *before* config.h */ -#ifdef HAVE_CONFIG_H #include <config.h> -#endif #undef access #undef chdir @@ -6086,5 +6084,3 @@ /* end of w32.c */ -/* arch-tag: 90442dd3-37be-482b-b272-ac752e3049f1 - (do not change this comment) */
--- a/src/w32fns.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/w32fns.c Wed Nov 17 13:09:08 2010 +0900 @@ -82,7 +82,7 @@ extern int quit_char; -extern char *lispy_function_keys[]; +extern const char *const lispy_function_keys[]; /* The colormap for converting color names to RGB values */ Lisp_Object Vw32_color_map; @@ -4345,8 +4345,6 @@ "background", "Background", RES_TYPE_STRING); x_default_parameter (f, parameters, Qmouse_color, build_string ("black"), "pointerColor", "Foreground", RES_TYPE_STRING); - x_default_parameter (f, parameters, Qcursor_color, build_string ("black"), - "cursorColor", "Foreground", RES_TYPE_STRING); x_default_parameter (f, parameters, Qborder_color, build_string ("black"), "borderColor", "BorderColor", RES_TYPE_STRING); x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
--- a/src/w32font.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/w32font.c Wed Nov 17 13:09:08 2010 +0900 @@ -2377,11 +2377,11 @@ return DECODE_SYSTEM (build_string (buf)); } -static const char *w32font_booleans [] = { +static const char *const w32font_booleans [] = { NULL, }; -static const char *w32font_non_booleans [] = { +static const char *const w32font_non_booleans [] = { ":script", ":antialias", ":style",
--- a/src/w32heap.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/w32heap.c Wed Nov 17 13:09:08 2010 +0900 @@ -21,10 +21,7 @@ Geoff Voelker (voelker@cs.washington.edu) 7-29-94 */ -#ifdef HAVE_CONFIG_H #include <config.h> -#endif - #include <stdio.h> #include <setjmp.h> @@ -301,5 +298,3 @@ #endif -/* arch-tag: 9a6a9860-040d-422d-8905-450dd535cd9c - (do not change this comment) */
--- a/src/w32inevt.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/w32inevt.c Wed Nov 17 13:09:08 2010 +0900 @@ -23,10 +23,7 @@ */ -#ifdef HAVE_CONFIG_H #include <config.h> -#endif - #include <stdio.h> #include <windows.h> #include <setjmp.h> @@ -282,7 +279,7 @@ } -extern char *lispy_function_keys[]; +extern const char *const lispy_function_keys[]; static int faked_key = 0; @@ -784,5 +781,3 @@ return ret; } -/* arch-tag: 0bcb39b7-d085-4b85-9070-6750e8c03047 - (do not change this comment) */
--- a/src/w32proc.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/w32proc.c Wed Nov 17 13:09:08 2010 +0900 @@ -32,10 +32,7 @@ #include <setjmp.h> /* must include CRT headers *before* config.h */ - -#ifdef HAVE_CONFIG_H #include <config.h> -#endif #undef signal #undef wait @@ -2370,7 +2367,5 @@ staticpro (&Vw32_valid_locale_ids); staticpro (&Vw32_valid_codepages); } -/* end of ntproc.c */ +/* end of w32proc.c */ -/* arch-tag: 23d3a34c-06d2-48a1-833b-ac7609aa5250 - (do not change this comment) */
--- a/src/w32term.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/w32term.c Wed Nov 17 13:09:08 2010 +0900 @@ -1440,7 +1440,7 @@ str = (char *) SDATA (acronym); } } - else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEXA_CODE) + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) { sprintf ((char *) buf, "%0*X", glyph->u.glyphless.ch < 0x10000 ? 4 : 6, @@ -1448,6 +1448,11 @@ str = buf; } + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) + w32_draw_rectangle (s->hdc, s->gc, + x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1); if (str) { struct font *font = s->font; @@ -1456,7 +1461,7 @@ HFONT old_font; old_font = SelectObject (s->hdc, FONT_HANDLE (font)); - /* It is assured that all LEN characters in STR is ASCII. */ + /* It is certain that all LEN characters in STR are ASCII. */ for (j = 0; j < len; j++) { code = font->driver->encode_char (font, str[j]); @@ -1472,11 +1477,6 @@ with_background); SelectObject (s->hdc, old_font); } - if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) - w32_draw_rectangle (s->hdc, s->gc, - x, s->ybase - glyph->ascent, - glyph->pixel_width - 1, - glyph->ascent + glyph->descent - 1); x += glyph->pixel_width; } } @@ -4317,7 +4317,7 @@ int x = LOWORD (msg.msg.lParam); int y = HIWORD (msg.msg.lParam); - window = window_from_coordinates (f, x, y, 0, 0, 0, 0); + window = window_from_coordinates (f, x, y, 0, 0); /* Window will be selected only when it is not selected now and last mouse movement event was @@ -4396,7 +4396,7 @@ int x = XFASTINT (inev.x); int y = XFASTINT (inev.y); - window = window_from_coordinates (f, x, y, 0, 0, 0, 1); + window = window_from_coordinates (f, x, y, 0, 1); if (EQ (window, f->tool_bar_window)) {
--- a/src/window.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/window.c Wed Nov 17 13:09:08 2010 +0900 @@ -755,32 +755,26 @@ - WINDOW_MODE_LINE_HEIGHT (w) + add_y)); } -/* Test if the character at column *X, row *Y is within window W. +/* Test if the character at column X, row Y is within window W. If it is not, return ON_NOTHING; - if it is in the window's text area, - set *x and *y to its location relative to the upper left corner - of the window, and - return ON_TEXT; + if it is in the window's text area, return ON_TEXT; if it is on the window's modeline, return ON_MODE_LINE; if it is on the border between the window and its right sibling, return ON_VERTICAL_BORDER. - if it is on a scroll bar, - return ON_SCROLL_BAR. + if it is on a scroll bar, return ON_SCROLL_BAR. if it is on the window's top line, return ON_HEADER_LINE; if it is in left or right fringe of the window, - return ON_LEFT_FRINGE or ON_RIGHT_FRINGE, and convert *X and *Y - to window-relative coordinates; + return ON_LEFT_FRINGE or ON_RIGHT_FRINGE; if it is in the marginal area to the left/right of the window, - return ON_LEFT_MARGIN or ON_RIGHT_MARGIN, and convert *X and *Y - to window-relative coordinates. + return ON_LEFT_MARGIN or ON_RIGHT_MARGIN. X and Y are frame relative pixel coordinates. */ static enum window_part -coordinates_in_window (register struct window *w, register int *x, register int *y) +coordinates_in_window (register struct window *w, int x, int y) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - int left_x, right_x, top_y, bottom_y; + int left_x, right_x; enum window_part part; int ux = FRAME_COLUMN_WIDTH (f); int x0 = WINDOW_LEFT_EDGE_X (w); @@ -789,6 +783,12 @@ (Between mode lines for instance. */ int grabbable_width = ux; int lmargin_width, rmargin_width, text_left, text_right; + int top_y = WINDOW_TOP_EDGE_Y (w); + int bottom_y = WINDOW_BOTTOM_EDGE_Y (w); + + /* Outside any interesting row? */ + if (y < top_y || y >= bottom_y) + 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. */ @@ -796,21 +796,13 @@ { left_x = 0; right_x = WINDOW_TOTAL_WIDTH (w) - 1; - top_y = WINDOW_TOP_EDGE_Y (w); - bottom_y = WINDOW_BOTTOM_EDGE_Y (w); } else { left_x = WINDOW_BOX_LEFT_EDGE_X (w); right_x = WINDOW_BOX_RIGHT_EDGE_X (w) - 1; - top_y = WINDOW_TOP_EDGE_Y (w); - bottom_y = WINDOW_BOTTOM_EDGE_Y (w); } - /* Outside any interesting row? */ - if (*y < top_y || *y >= bottom_y) - return ON_NOTHING; - /* On the mode line or header line? If it's near the start of the mode or header line of window that's has a horizontal sibling, say it's on the vertical line. That's to be able @@ -818,7 +810,7 @@ scroll bars. */ if (WINDOW_WANTS_MODELINE_P (w) - && *y >= bottom_y - CURRENT_MODE_LINE_HEIGHT (w)) + && y >= bottom_y - CURRENT_MODE_LINE_HEIGHT (w)) { part = ON_MODE_LINE; @@ -827,60 +819,37 @@ between mode lines of horizontally adjacent mode lines as the vertical border. If scroll bars on the left, return the right window. */ - if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) - || WINDOW_RIGHTMOST_P (w)) - { - if (!WINDOW_LEFTMOST_P (w) && eabs (*x - x0) < grabbable_width) - { - /* Convert X and Y to window relative coordinates. - Vertical border is at the left edge of window. */ - *x = max (0, *x - x0); - *y -= top_y; - return ON_VERTICAL_BORDER; - } - } - else - { - /* Make sure we're not at the rightmost position of a - mode-/header-line and there's yet another window on - the right. (Bug#1372) */ - if ((WINDOW_RIGHTMOST_P (w) || *x < x1) - && eabs (*x - x1) < grabbable_width) - { - /* Convert X and Y to window relative coordinates. - Vertical border is at the right edge of window. */ - *x = min (x1, *x) - x0; - *y -= top_y; - return ON_VERTICAL_BORDER; - } - } - - if (*x < x0 || *x >= x1) + if ((WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) + || WINDOW_RIGHTMOST_P (w)) + && !WINDOW_LEFTMOST_P (w) + && eabs (x - x0) < grabbable_width) + return ON_VERTICAL_BORDER; + + /* Make sure we're not at the rightmost position of a + mode-/header-line and there's yet another window on the + right. (Bug#1372) */ + else if ((WINDOW_RIGHTMOST_P (w) || x < x1) + && eabs (x - x1) < grabbable_width) + 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; - *y -= top_y; return part; } if (WINDOW_WANTS_HEADER_LINE_P (w) - && *y < top_y + CURRENT_HEADER_LINE_HEIGHT (w)) + && y < top_y + CURRENT_HEADER_LINE_HEIGHT (w)) { part = ON_HEADER_LINE; goto header_vertical_border_check; } - if (*x < x0 || *x >= x1) - return ON_NOTHING; + if (x < x0 || x >= x1) return ON_NOTHING; /* Outside any interesting column? */ - if (*x < left_x || *x > right_x) - { - *y -= top_y; - return ON_SCROLL_BAR; - } + if (x < left_x || x > right_x) + return ON_SCROLL_BAR; lmargin_width = window_box_width (w, LEFT_MARGIN_AREA); rmargin_width = window_box_width (w, RIGHT_MARGIN_AREA); @@ -893,77 +862,79 @@ if (!w->pseudo_window_p && !WINDOW_HAS_VERTICAL_SCROLL_BAR (w) && !WINDOW_RIGHTMOST_P (w) - && (eabs (*x - right_x) < grabbable_width)) - { - /* Convert X and Y to window relative coordinates. - Vertical border is at the right edge of window. */ - *x = min (right_x, *x) - left_x; - *y -= top_y; - return ON_VERTICAL_BORDER; - } + && (eabs (x - right_x) < grabbable_width)) + return ON_VERTICAL_BORDER; } - else - { - /* Need to say "*x > right_x" rather than >=, since on character - terminals, the vertical line's x coordinate is right_x. */ - if (!w->pseudo_window_p - && !WINDOW_RIGHTMOST_P (w) - && *x > right_x - ux) - { - /* On the border on the right side of the window? Assume that - this area begins at RIGHT_X minus a canonical char width. */ - *x = min (right_x, *x) - left_x; - *y -= top_y; - return ON_VERTICAL_BORDER; - } - } - - if (*x < text_left) + /* Need to say "x > right_x" rather than >=, since on character + terminals, the vertical line's x coordinate is right_x. */ + else if (!w->pseudo_window_p + && !WINDOW_RIGHTMOST_P (w) + && x > right_x - ux) + return ON_VERTICAL_BORDER; + + if (x < text_left) { if (lmargin_width > 0 && (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) - ? (*x >= left_x + WINDOW_LEFT_FRINGE_WIDTH (w)) - : (*x < left_x + lmargin_width))) - { - *x -= left_x; - if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)) - *x -= WINDOW_LEFT_FRINGE_WIDTH (w); - *y -= top_y; - return ON_LEFT_MARGIN; - } - - /* Convert X and Y to window-relative pixel coordinates. */ - *x -= left_x; - *y -= top_y; + ? (x >= left_x + WINDOW_LEFT_FRINGE_WIDTH (w)) + : (x < left_x + lmargin_width))) + return ON_LEFT_MARGIN; + return ON_LEFT_FRINGE; } - if (*x >= text_right) + if (x >= text_right) { if (rmargin_width > 0 && (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w) - ? (*x < right_x - WINDOW_RIGHT_FRINGE_WIDTH (w)) - : (*x >= right_x - rmargin_width))) - { - *x -= right_x - rmargin_width; - if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)) - *x += WINDOW_RIGHT_FRINGE_WIDTH (w); - *y -= top_y; - return ON_RIGHT_MARGIN; - } - - /* Convert X and Y to window-relative pixel coordinates. */ - *x -= left_x + WINDOW_LEFT_FRINGE_WIDTH (w); - *y -= top_y; + ? (x < right_x - WINDOW_RIGHT_FRINGE_WIDTH (w)) + : (x >= right_x - rmargin_width))) + return ON_RIGHT_MARGIN; + return ON_RIGHT_FRINGE; } /* Everything special ruled out - must be on text area */ - *x -= text_left; - *y -= top_y; return ON_TEXT; } +/* Take X is the frame-relative pixel x-coordinate, and return the + x-coordinate relative to part PART of window W. */ +int +window_relative_x_coord (struct window *w, enum window_part part, int x) +{ + int left_x = (w->pseudo_window_p) ? 0 : WINDOW_BOX_LEFT_EDGE_X (w); + + switch (part) + { + case ON_TEXT: + return x - window_box_left (w, TEXT_AREA); + + case ON_LEFT_FRINGE: + return x - left_x; + + case ON_RIGHT_FRINGE: + return x - left_x - WINDOW_LEFT_FRINGE_WIDTH (w); + + case ON_LEFT_MARGIN: + return (x - left_x + - ((WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)) + ? WINDOW_LEFT_FRINGE_WIDTH (w) : 0)); + + case ON_RIGHT_MARGIN: + return (x + 1 + - ((w->pseudo_window_p) + ? WINDOW_TOTAL_WIDTH (w) + : WINDOW_BOX_RIGHT_EDGE_X (w)) + + window_box_width (w, RIGHT_MARGIN_AREA) + + ((WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)) + ? WINDOW_RIGHT_FRINGE_WIDTH (w) : 0)); + } + + /* ON_SCROLL_BAR, ON_NOTHING, and ON_VERTICAL_BORDER: */ + return 0; +} + DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p, Scoordinates_in_window_p, 2, 2, 0, @@ -1000,14 +971,16 @@ x = FRAME_PIXEL_X_FROM_CANON_X (f, lx) + FRAME_INTERNAL_BORDER_WIDTH (f); y = FRAME_PIXEL_Y_FROM_CANON_Y (f, ly) + FRAME_INTERNAL_BORDER_WIDTH (f); - switch (coordinates_in_window (w, &x, &y)) + switch (coordinates_in_window (w, x, y)) { case ON_NOTHING: return Qnil; case ON_TEXT: - /* X and Y are now window relative pixel coordinates. Convert - them to canonical char units before returning them. */ + /* Convert X and Y to window relative pixel coordinates, and + return the canonical char units. */ + x -= window_box_left (w, TEXT_AREA); + y -= WINDOW_TOP_EDGE_Y (w); return Fcons (FRAME_CANON_X_FROM_PIXEL_X (f, x), FRAME_CANON_Y_FROM_PIXEL_Y (f, y)); @@ -1054,7 +1027,7 @@ struct check_window_data { Lisp_Object *window; - int *x, *y; + int x, y; enum window_part *part; }; @@ -1081,8 +1054,7 @@ return it as a Lisp_Object. If X, Y is on one of the window's special `window_part' elements, - set *PART to the id of that element, and return X and Y converted - to window relative coordinates in WX and WY. + set *PART to the id of that element. If there is no window under X, Y return nil and leave *PART unmodified. TOOL_BAR_P non-zero means detect tool-bar windows. @@ -1097,7 +1069,8 @@ case. */ Lisp_Object -window_from_coordinates (struct frame *f, int x, int y, enum window_part *part, int *wx, int *wy, int tool_bar_p) +window_from_coordinates (struct frame *f, int x, int y, + enum window_part *part, int tool_bar_p) { Lisp_Object window; struct check_window_data cw; @@ -1107,7 +1080,7 @@ part = &dummy; window = Qnil; - cw.window = &window, cw.x = &x, cw.y = &y; cw.part = part; + cw.window = &window, cw.x = x, cw.y = y; cw.part = part; foreach_window (f, check_window_containing, &cw); /* If not found above, see if it's in the tool bar window, if a tool @@ -1116,16 +1089,13 @@ && tool_bar_p && WINDOWP (f->tool_bar_window) && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)) > 0 - && (coordinates_in_window (XWINDOW (f->tool_bar_window), &x, &y) + && (coordinates_in_window (XWINDOW (f->tool_bar_window), x, y) != ON_NOTHING)) { *part = ON_TEXT; window = f->tool_bar_window; } - if (wx) *wx = x; - if (wy) *wy = y; - return window; } @@ -1152,7 +1122,7 @@ + FRAME_INTERNAL_BORDER_WIDTH (f)), (FRAME_PIXEL_Y_FROM_CANON_Y (f, y) + FRAME_INTERNAL_BORDER_WIDTH (f)), - 0, 0, 0, 0); + 0, 0); } DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0, @@ -2420,6 +2390,16 @@ window_loop (CHECK_ALL_WINDOWS, Qnil, 1, Qt); } +DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0, + doc: /* Return WINDOW's use time. +WINDOW defaults to the selected window. The window with the highest use +time is the most recently selected one. The window with the lowest use +time is the least recently selected one. */) + (Lisp_Object window) +{ + return decode_window (window)->use_time; +} + DEFUN ("get-lru-window", Fget_lru_window, Sget_lru_window, 0, 2, 0, doc: /* Return the window least recently selected or used for display. \(LRU means Least Recently Used.)
--- a/src/window.h Mon Nov 08 14:19:54 2010 +0900 +++ b/src/window.h Wed Nov 17 13:09:08 2010 +0900 @@ -788,8 +788,7 @@ extern Lisp_Object make_window (void); extern void delete_window (Lisp_Object); extern Lisp_Object window_from_coordinates (struct frame *, int, int, - enum window_part *, - int *, int*, int); + enum window_part *, int); EXFUN (Fwindow_dedicated_p, 1); extern int window_height (Lisp_Object); extern int window_width (Lisp_Object); @@ -804,6 +803,7 @@ void *); extern void grow_mini_window (struct window *, int); extern void shrink_mini_window (struct window *); +extern int window_relative_x_coord (struct window *, enum window_part, int); void run_window_configuration_change_hook (struct frame *f);
--- a/src/xdisp.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xdisp.c Wed Nov 17 13:09:08 2010 +0900 @@ -971,7 +971,7 @@ Lisp_Object Qglyphless_char_display; /* Method symbols for Vglyphless_char_display. */ -static Lisp_Object Qhexa_code, Qempty_box, Qthin_space, Qzero_width; +static Lisp_Object Qhex_code, Qempty_box, Qthin_space, Qzero_width; /* Default pixel width of `thin-space' display method. */ #define THIN_SPACE_WIDTH 1 @@ -2218,7 +2218,7 @@ frame pixel coordinates X/Y on frame F. */ if (!f->glyphs_initialized_p - || (window = window_from_coordinates (f, gx, gy, &part, &x, &y, 0), + || (window = window_from_coordinates (f, gx, gy, &part, 0), NILP (window))) { width = FRAME_SMALLEST_CHAR_WIDTH (f); @@ -2230,6 +2230,9 @@ width = WINDOW_FRAME_COLUMN_WIDTH (w); height = WINDOW_FRAME_LINE_HEIGHT (w); + x = window_relative_x_coord (w, part, gx); + y = gy - WINDOW_TOP_EDGE_Y (w); + r = MATRIX_FIRST_TEXT_ROW (w->current_matrix); end_row = MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w); @@ -5813,8 +5816,8 @@ it->glyphless_method = GLYPHLESS_DISPLAY_THIN_SPACE; else if (EQ (glyphless_method, Qempty_box)) it->glyphless_method = GLYPHLESS_DISPLAY_EMPTY_BOX; - else if (EQ (glyphless_method, Qhexa_code)) - it->glyphless_method = GLYPHLESS_DISPLAY_HEXA_CODE; + else if (EQ (glyphless_method, Qhex_code)) + it->glyphless_method = GLYPHLESS_DISPLAY_HEX_CODE; else if (STRINGP (glyphless_method)) it->glyphless_method = GLYPHLESS_DISPLAY_ACRONYM; else @@ -12871,10 +12874,10 @@ || (row->truncated_on_left_p && pt_old < bpos_min) || (row->truncated_on_right_p && pt_old > bpos_max) /* Zero-width characters produce no glyphs. */ - || ((row->reversed_p - ? glyph_after > glyphs_end - : glyph_after < glyphs_end) - && eabs (glyph_after - glyph_before) == 1)) + || (!string_seen + && (row->reversed_p + ? glyph_after > glyphs_end + : glyph_after < glyphs_end))) { cursor = glyph_after; x = -1; @@ -22292,7 +22295,7 @@ and only if this is for a character for which no font was found. If the display method (it->glyphless_method) is - GLYPHLESS_DISPLAY_ACRONYM or GLYPHLESS_DISPLAY_HEXA_CODE, LEN is a + GLYPHLESS_DISPLAY_ACRONYM or GLYPHLESS_DISPLAY_HEX_CODE, LEN is a length of the acronym or the hexadecimal string, UPPER_XOFF and UPPER_YOFF are pixel offsets for the upper part of the string, LOWER_XOFF and LOWER_YOFF are for the lower part. @@ -22441,7 +22444,7 @@ } else { - xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEXA_CODE); + xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE); sprintf (buf, "%0*X", it->c < 0x10000 ? 4 : 6, it->c); str = buf; } @@ -25383,7 +25386,7 @@ } /* Which window is that in? */ - window = window_from_coordinates (f, x, y, &part, 0, 0, 1); + window = window_from_coordinates (f, x, y, &part, 1); /* If we were displaying active text in another window, clear that. Also clear if we move out of text area in same window. */ @@ -27057,7 +27060,7 @@ hourglass_shown_p = 0; DEFSYM (Qglyphless_char, "glyphless-char"); - DEFSYM (Qhexa_code, "hexa-code"); + DEFSYM (Qhex_code, "hex-code"); DEFSYM (Qempty_box, "empty-box"); DEFSYM (Qthin_space, "thin-space"); DEFSYM (Qzero_width, "zero-width"); @@ -27073,13 +27076,13 @@ doc: /* Char-table to control displaying of glyphless characters. Each element, if non-nil, is an ASCII acronym string (displayed in a box) or one of these symbols: - hexa-code: display with hexadecimal character code in a box - empty-box: display with an empty box - thin-space: display with 1-pixel width space + hex-code: display the hexadecimal code of a character in a box + empty-box: display as an empty box + thin-space: display as 1-pixel width space zero-width: don't display It has one extra slot to control the display of a character for which -no font is found. The value of the slot is `hexa-code' or `empty-box'. +no font is found. The value of the slot is `hex-code' or `empty-box'. The default is `empty-box'. */); Vglyphless_char_display = Fmake_char_table (Qglyphless_char_display, Qnil); Fset_char_table_extra_slot (Vglyphless_char_display, make_number (0),
--- a/src/xfns.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xfns.c Wed Nov 17 13:09:08 2010 +0900 @@ -519,12 +519,20 @@ int real_x = 0, real_y = 0; int had_errors = 0; Window win = f->output_data.x->parent_desc; + Atom actual_type; + unsigned long actual_size, bytes_remaining; + int i, rc, actual_format; + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + long max_len = 400; + Display *dpy = FRAME_X_DISPLAY (f); + unsigned char *tmp_data = NULL; + Atom target_type = XA_CARDINAL; BLOCK_INPUT; - x_catch_errors (FRAME_X_DISPLAY (f)); - - if (win == FRAME_X_DISPLAY_INFO (f)->root_window) + x_catch_errors (dpy); + + if (win == dpyinfo->root_window) win = FRAME_OUTER_WINDOW (f); /* This loop traverses up the containment tree until we hit the root @@ -609,6 +617,33 @@ had_errors = x_had_errors_p (FRAME_X_DISPLAY (f)); } + + if (dpyinfo->root_window == f->output_data.x->parent_desc) + { + /* Try _NET_FRAME_EXTENTS if our parent is the root window. */ + rc = XGetWindowProperty (dpy, win, dpyinfo->Xatom_net_frame_extents, + 0, max_len, False, target_type, + &actual_type, &actual_format, &actual_size, + &bytes_remaining, &tmp_data); + + if (rc == Success && actual_type == target_type && !x_had_errors_p (dpy) + && actual_size == 4 && actual_format == 32) + { + int ign; + Window rootw; + long *fe = (long *)tmp_data; + + XGetGeometry (FRAME_X_DISPLAY (f), win, + &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign); + outer_x = -fe[0]; + outer_y = -fe[2]; + real_x -= fe[0]; + real_y -= fe[2]; + } + } + + if (tmp_data) XFree (tmp_data); + x_uncatch_errors (); UNBLOCK_INPUT; @@ -3332,8 +3367,6 @@ "background", "Background", RES_TYPE_STRING); x_default_parameter (f, parms, Qmouse_color, build_string ("black"), "pointerColor", "Foreground", RES_TYPE_STRING); - x_default_parameter (f, parms, Qcursor_color, build_string ("black"), - "cursorColor", "Foreground", RES_TYPE_STRING); x_default_parameter (f, parms, Qborder_color, build_string ("black"), "borderColor", "BorderColor", RES_TYPE_STRING); x_default_parameter (f, parms, Qscreen_gamma, Qnil, @@ -4986,7 +5019,7 @@ Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil means use the default timeout of 5 seconds. -If the list of frame parameters PARAMS contains a `left' parameters, +If the list of frame parameters PARMS contains a `left' parameters, the tooltip is displayed at that x-position. Otherwise it is displayed at the mouse position, with offset DX added (default is 5 if DX isn't specified). Likewise for the y-position; if a `top' frame
--- a/src/xmenu.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xmenu.c Wed Nov 17 13:09:08 2010 +0900 @@ -89,7 +89,9 @@ #include <X11/Xaw/Paned.h> #endif /* HAVE_XAW3D */ #endif /* USE_LUCID */ +#ifdef USE_MOTIF #include "../lwlib/lwlib.h" +#endif #else /* not USE_X_TOOLKIT */ #ifndef USE_GTK #include "../oldXMenu/XMenu.h" @@ -2581,5 +2583,3 @@ #endif } -/* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242 - (do not change this comment) */
--- a/src/xselect.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xselect.c Wed Nov 17 13:09:08 2010 +0900 @@ -2527,14 +2527,26 @@ (Lisp_Object display, Lisp_Object dest, Lisp_Object from, Lisp_Object message_type, Lisp_Object format, Lisp_Object values) { struct x_display_info *dpyinfo = check_x_display_info (display); + + CHECK_STRING (message_type); + x_send_client_event(display, dest, from, + XInternAtom (dpyinfo->display, + SDATA (message_type), + False), + format, values); + + return Qnil; +} + +void +x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, Atom message_type, Lisp_Object format, Lisp_Object values) +{ + struct x_display_info *dpyinfo = check_x_display_info (display); Window wdest; XEvent event; - Lisp_Object cons; - int size; struct frame *f = check_x_frame (from); int to_root; - CHECK_STRING (message_type); CHECK_NUMBER (format); CHECK_CONS (values); @@ -2579,13 +2591,9 @@ if (wdest == 0) wdest = dpyinfo->root_window; to_root = wdest == dpyinfo->root_window; - for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size) - ; - BLOCK_INPUT; - event.xclient.message_type - = XInternAtom (dpyinfo->display, SDATA (message_type), False); + event.xclient.message_type = message_type; event.xclient.display = dpyinfo->display; /* Some clients (metacity for example) expects sending window to be here @@ -2610,8 +2618,6 @@ } x_uncatch_errors (); UNBLOCK_INPUT; - - return Qnil; }
--- a/src/xsettings.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xsettings.c Wed Nov 17 13:09:08 2010 +0900 @@ -656,18 +656,10 @@ static void init_xsettings (struct x_display_info *dpyinfo) { - char sel[64]; Display *dpy = dpyinfo->display; BLOCK_INPUT; - sprintf (sel, "_XSETTINGS_S%d", XScreenNumberOfScreen (dpyinfo->screen)); - dpyinfo->Xatom_xsettings_sel = XInternAtom (dpy, sel, False); - dpyinfo->Xatom_xsettings_prop = XInternAtom (dpy, - "_XSETTINGS_SETTINGS", - False); - dpyinfo->Xatom_xsettings_mgr = XInternAtom (dpy, "MANAGER", False); - /* Select events so we can detect client messages sent when selection owner changes. */ XSelectInput (dpy, dpyinfo->root_window, StructureNotifyMask);
--- a/src/xsmfns.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xsmfns.c Wed Nov 17 13:09:08 2010 +0900 @@ -410,8 +410,8 @@ XSetClassHint (dpyinfo->display, w, &class_hints); XStoreName (dpyinfo->display, w, class_hints.res_name); - sm_id = XInternAtom (dpyinfo->display, "SM_CLIENT_ID", False); - XChangeProperty (dpyinfo->display, w, sm_id, XA_STRING, 8, PropModeReplace, + XChangeProperty (dpyinfo->display, w, dpyinfo->Xatom_SM_CLIENT_ID, + XA_STRING, 8, PropModeReplace, (unsigned char *)client_id, strlen (client_id)); dpyinfo->client_leader_window = w;
--- a/src/xterm.c Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xterm.c Wed Nov 17 13:09:08 2010 +0900 @@ -442,7 +442,6 @@ } #define OPAQUE 0xffffffff -#define OPACITY "_NET_WM_WINDOW_OPACITY" void x_set_frame_alpha (struct frame *f) @@ -486,7 +485,7 @@ unsigned long n, left; x_catch_errors (dpy); - rc = XGetWindowProperty (dpy, win, XInternAtom(dpy, OPACITY, False), + rc = XGetWindowProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, 0L, 1L, False, XA_CARDINAL, &actual, &format, &n, &left, &data); @@ -504,7 +503,7 @@ } x_catch_errors (dpy); - XChangeProperty (dpy, win, XInternAtom (dpy, OPACITY, False), + XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opac, 1L); x_uncatch_errors (); @@ -1370,7 +1369,7 @@ str = (char *) SDATA (acronym); } } - else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEXA_CODE) + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) { sprintf ((char *) buf, "%0*X", glyph->u.glyphless.ch < 0x10000 ? 4 : 6, @@ -6659,7 +6658,7 @@ window = window_from_coordinates (f, event.xmotion.x, event.xmotion.y, - 0, 0, 0, 0); + 0, 0); /* Window will be selected only when it is not selected now and last mouse movement event was not in it. Minibuffer window @@ -6798,7 +6797,7 @@ int x = event.xbutton.x; int y = event.xbutton.y; - window = window_from_coordinates (f, x, y, 0, 0, 0, 1); + window = window_from_coordinates (f, x, y, 0, 1); tool_bar_p = EQ (window, f->tool_bar_window); if (tool_bar_p && event.xbutton.button < 4) @@ -8285,12 +8284,11 @@ http://freedesktop.org/wiki/Specifications/wm-spec. */ static int -wm_supports (struct frame *f, const char *atomname) +wm_supports (struct frame *f, Atom want_atom) { Atom actual_type; unsigned long actual_size, bytes_remaining; int i, rc, actual_format; - Atom prop_atom; Window wmcheck_window; struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); Window target_window = dpyinfo->root_window; @@ -8298,15 +8296,13 @@ Display *dpy = FRAME_X_DISPLAY (f); unsigned char *tmp_data = NULL; Atom target_type = XA_WINDOW; - Atom want_atom; BLOCK_INPUT; - prop_atom = XInternAtom (dpy, "_NET_SUPPORTING_WM_CHECK", False); - x_catch_errors (dpy); rc = XGetWindowProperty (dpy, target_window, - prop_atom, 0, max_len, False, target_type, + dpyinfo->Xatom_net_supporting_wm_check, + 0, max_len, False, target_type, &actual_type, &actual_format, &actual_size, &bytes_remaining, &tmp_data); @@ -8341,10 +8337,10 @@ dpyinfo->net_supported_window = 0; target_type = XA_ATOM; - prop_atom = XInternAtom (dpy, "_NET_SUPPORTED", False); tmp_data = NULL; rc = XGetWindowProperty (dpy, target_window, - prop_atom, 0, max_len, False, target_type, + dpyinfo->Xatom_net_supported, + 0, max_len, False, target_type, &actual_type, &actual_format, &actual_size, &bytes_remaining, &tmp_data); @@ -8362,7 +8358,6 @@ } rc = 0; - want_atom = XInternAtom (dpy, atomname, False); for (i = 0; rc == 0 && i < dpyinfo->nr_net_supported_atoms; ++i) rc = dpyinfo->net_supported_atoms[i] == want_atom; @@ -8374,31 +8369,33 @@ } static void -set_wm_state (Lisp_Object frame, int add, const char *what, const char *what2) -{ - const char *atom = "_NET_WM_STATE"; - Fx_send_client_event (frame, make_number (0), frame, - make_unibyte_string (atom, strlen (atom)), - make_number (32), - /* 1 = add, 0 = remove */ +set_wm_state (Lisp_Object frame, int add, Atom atom, Atom value) +{ + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (frame)); + + x_send_client_event (frame, make_number (0), frame, + dpyinfo->Xatom_net_wm_state, + make_number (32), + /* 1 = add, 0 = remove */ + Fcons + (make_number (add ? 1 : 0), Fcons - (make_number (add ? 1 : 0), - Fcons - (make_unibyte_string (what, strlen (what)), - what2 != 0 - ? Fcons (make_unibyte_string (what2, strlen (what2)), - Qnil) - : Qnil))); + (make_fixnum_or_float (atom), + value != 0 + ? Fcons (make_fixnum_or_float (value), Qnil) + : Qnil))); } void x_set_sticky (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { Lisp_Object frame; + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); XSETFRAME (frame, f); + set_wm_state (frame, NILP (new_value) ? 0 : 1, - "_NET_WM_STATE_STICKY", NULL); + dpyinfo->Xatom_net_wm_state_sticky, None); } /* Return the current _NET_WM_STATE. @@ -8457,7 +8454,7 @@ else *size_state = FULLSCREEN_HEIGHT; } - else if (a == dpyinfo->Xatom_net_wm_state_fullscreen_atom) + else if (a == dpyinfo->Xatom_net_wm_state_fullscreen) *size_state = FULLSCREEN_BOTH; else if (a == dpyinfo->Xatom_net_wm_state_sticky) *sticky = 1; @@ -8472,7 +8469,8 @@ static int do_ewmh_fullscreen (struct frame *f) { - int have_net_atom = wm_supports (f, "_NET_WM_STATE"); + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + int have_net_atom = wm_supports (f, dpyinfo->Xatom_net_wm_state); Lisp_Object lval = get_frame_param (f, Qfullscreen); int cur, dummy; @@ -8481,14 +8479,11 @@ /* Some window managers don't say they support _NET_WM_STATE, but they do say they support _NET_WM_STATE_FULLSCREEN. Try that also. */ if (!have_net_atom) - have_net_atom = wm_supports (f, "_NET_WM_STATE_FULLSCREEN"); + have_net_atom = wm_supports (f, dpyinfo->Xatom_net_wm_state_fullscreen); if (have_net_atom && cur != f->want_fullscreen) { Lisp_Object frame; - const char *fs = "_NET_WM_STATE_FULLSCREEN"; - const char *fw = "_NET_WM_STATE_MAXIMIZED_HORZ"; - const char *fh = "_NET_WM_STATE_MAXIMIZED_VERT"; XSETFRAME (frame, f); @@ -8500,33 +8495,38 @@ case FULLSCREEN_BOTH: if (cur == FULLSCREEN_WIDTH || cur == FULLSCREEN_MAXIMIZED || cur == FULLSCREEN_HEIGHT) - set_wm_state (frame, 0, fw, fh); - set_wm_state (frame, 1, fs, NULL); + set_wm_state (frame, 0, dpyinfo->Xatom_net_wm_state_maximized_horz, + dpyinfo->Xatom_net_wm_state_maximized_vert); + set_wm_state (frame, 1, dpyinfo->Xatom_net_wm_state_fullscreen, None); break; case FULLSCREEN_WIDTH: if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_HEIGHT || cur == FULLSCREEN_MAXIMIZED) - set_wm_state (frame, 0, fs, fh); + set_wm_state (frame, 0, dpyinfo->Xatom_net_wm_state_fullscreen, + dpyinfo->Xatom_net_wm_state_maximized_vert); if (cur != FULLSCREEN_MAXIMIZED) - set_wm_state (frame, 1, fw, NULL); + set_wm_state (frame, 1, dpyinfo->Xatom_net_wm_state_maximized_horz, None); break; case FULLSCREEN_HEIGHT: if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_WIDTH || cur == FULLSCREEN_MAXIMIZED) - set_wm_state (frame, 0, fs, fw); + set_wm_state (frame, 0, dpyinfo->Xatom_net_wm_state_fullscreen, + dpyinfo->Xatom_net_wm_state_maximized_horz); if (cur != FULLSCREEN_MAXIMIZED) - set_wm_state (frame, 1, fh, NULL); + set_wm_state (frame, 1, dpyinfo->Xatom_net_wm_state_maximized_vert, None); break; case FULLSCREEN_MAXIMIZED: if (cur == FULLSCREEN_BOTH) - set_wm_state (frame, 0, fs, NULL); - set_wm_state (frame, 1, fw, fh); + set_wm_state (frame, 0, dpyinfo->Xatom_net_wm_state_fullscreen, None); + set_wm_state (frame, 1, dpyinfo->Xatom_net_wm_state_maximized_horz, + dpyinfo->Xatom_net_wm_state_maximized_vert); break; case FULLSCREEN_NONE: if (cur == FULLSCREEN_BOTH) - set_wm_state (frame, 0, fs, NULL); + set_wm_state (frame, 0, dpyinfo->Xatom_net_wm_state_fullscreen, None); else - set_wm_state (frame, 0, fw, fh); + set_wm_state (frame, 0, dpyinfo->Xatom_net_wm_state_maximized_horz, + dpyinfo->Xatom_net_wm_state_maximized_vert); } f->want_fullscreen = FULLSCREEN_NONE; @@ -8966,17 +8966,17 @@ /* See Window Manager Specification/Extended Window Manager Hints at http://freedesktop.org/wiki/Specifications/wm-spec */ - const char *atom = "_NET_ACTIVE_WINDOW"; - if (f->async_visible && wm_supports (f, atom)) + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + if (f->async_visible && wm_supports (f, dpyinfo->Xatom_net_active_window)) { Lisp_Object frame; XSETFRAME (frame, f); - Fx_send_client_event (frame, make_number (0), frame, - make_unibyte_string (atom, strlen (atom)), - make_number (32), - Fcons (make_number (1), - Fcons (make_number (last_user_time), - Qnil))); + x_send_client_event (frame, make_number (0), frame, + dpyinfo->Xatom_net_active_window, + make_number (32), + Fcons (make_number (1), + Fcons (make_number (last_user_time), + Qnil))); } } @@ -8996,13 +8996,13 @@ { Atom atom; unsigned long data[2]; - - atom = XInternAtom (FRAME_X_DISPLAY (f), "_XEMBED_INFO", False); + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); data[0] = XEMBED_VERSION; data[1] = flags; - XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), atom, atom, + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_XEMBED_INFO, dpyinfo->Xatom_XEMBED_INFO, 32, PropModeReplace, (unsigned char *) data, 2); } @@ -10196,88 +10196,97 @@ dpyinfo->resx = (mm < 1) ? 100 : pixels * 25.4 / mm; } - dpyinfo->Xatom_wm_protocols - = XInternAtom (dpyinfo->display, "WM_PROTOCOLS", False); - dpyinfo->Xatom_wm_take_focus - = XInternAtom (dpyinfo->display, "WM_TAKE_FOCUS", False); - dpyinfo->Xatom_wm_save_yourself - = XInternAtom (dpyinfo->display, "WM_SAVE_YOURSELF", False); - dpyinfo->Xatom_wm_delete_window - = XInternAtom (dpyinfo->display, "WM_DELETE_WINDOW", False); - dpyinfo->Xatom_wm_change_state - = XInternAtom (dpyinfo->display, "WM_CHANGE_STATE", False); - dpyinfo->Xatom_wm_configure_denied - = XInternAtom (dpyinfo->display, "WM_CONFIGURE_DENIED", False); - dpyinfo->Xatom_wm_window_moved - = XInternAtom (dpyinfo->display, "WM_MOVED", False); - dpyinfo->Xatom_wm_client_leader - = XInternAtom (dpyinfo->display, "WM_CLIENT_LEADER", False); - dpyinfo->Xatom_editres - = XInternAtom (dpyinfo->display, "Editres", False); - dpyinfo->Xatom_CLIPBOARD - = XInternAtom (dpyinfo->display, "CLIPBOARD", False); - dpyinfo->Xatom_TIMESTAMP - = XInternAtom (dpyinfo->display, "TIMESTAMP", False); - dpyinfo->Xatom_TEXT - = XInternAtom (dpyinfo->display, "TEXT", False); - dpyinfo->Xatom_COMPOUND_TEXT - = XInternAtom (dpyinfo->display, "COMPOUND_TEXT", False); - dpyinfo->Xatom_UTF8_STRING - = XInternAtom (dpyinfo->display, "UTF8_STRING", False); - dpyinfo->Xatom_DELETE - = XInternAtom (dpyinfo->display, "DELETE", False); - dpyinfo->Xatom_MULTIPLE - = XInternAtom (dpyinfo->display, "MULTIPLE", False); - dpyinfo->Xatom_INCR - = XInternAtom (dpyinfo->display, "INCR", False); - dpyinfo->Xatom_EMACS_TMP - = XInternAtom (dpyinfo->display, "_EMACS_TMP_", False); - dpyinfo->Xatom_TARGETS - = XInternAtom (dpyinfo->display, "TARGETS", False); - dpyinfo->Xatom_NULL - = XInternAtom (dpyinfo->display, "NULL", False); - dpyinfo->Xatom_ATOM_PAIR - = XInternAtom (dpyinfo->display, "ATOM_PAIR", False); - /* For properties of font. */ - dpyinfo->Xatom_PIXEL_SIZE - = XInternAtom (dpyinfo->display, "PIXEL_SIZE", False); - dpyinfo->Xatom_AVERAGE_WIDTH - = XInternAtom (dpyinfo->display, "AVERAGE_WIDTH", False); - dpyinfo->Xatom_MULE_BASELINE_OFFSET - = XInternAtom (dpyinfo->display, "_MULE_BASELINE_OFFSET", False); - dpyinfo->Xatom_MULE_RELATIVE_COMPOSE - = XInternAtom (dpyinfo->display, "_MULE_RELATIVE_COMPOSE", False); - dpyinfo->Xatom_MULE_DEFAULT_ASCENT - = XInternAtom (dpyinfo->display, "_MULE_DEFAULT_ASCENT", False); - - /* Ghostscript support. */ - dpyinfo->Xatom_PAGE = XInternAtom (dpyinfo->display, "PAGE", False); - dpyinfo->Xatom_DONE = XInternAtom (dpyinfo->display, "DONE", False); - - dpyinfo->Xatom_Scrollbar = XInternAtom (dpyinfo->display, "SCROLLBAR", - False); - - dpyinfo->Xatom_XEMBED = XInternAtom (dpyinfo->display, "_XEMBED", - False); - - dpyinfo->Xatom_net_wm_state - = XInternAtom (dpyinfo->display, "_NET_WM_STATE", False); - dpyinfo->Xatom_net_wm_state_fullscreen_atom - = XInternAtom (dpyinfo->display, "_NET_WM_STATE_FULLSCREEN", False); - dpyinfo->Xatom_net_wm_state_maximized_horz - = XInternAtom (dpyinfo->display, "_NET_WM_STATE_MAXIMIZED_HORZ", False); - dpyinfo->Xatom_net_wm_state_maximized_vert - = XInternAtom (dpyinfo->display, "_NET_WM_STATE_MAXIMIZED_VERT", False); - dpyinfo->Xatom_net_wm_state_sticky - = XInternAtom (dpyinfo->display, "_NET_WM_STATE_STICKY", False); - dpyinfo->Xatom_net_window_type - = XInternAtom (dpyinfo->display, "_NET_WM_WINDOW_TYPE", False); - dpyinfo->Xatom_net_window_type_tooltip - = XInternAtom (dpyinfo->display, "_NET_WM_WINDOW_TYPE_TOOLTIP", False); - dpyinfo->Xatom_net_wm_icon_name - = XInternAtom (dpyinfo->display, "_NET_WM_ICON_NAME", False); - dpyinfo->Xatom_net_wm_name - = XInternAtom (dpyinfo->display, "_NET_WM_NAME", False); + { + const struct + { + const char *name; + Atom *atom; + } atom_refs[] = { + { "WM_PROTOCOLS", &dpyinfo->Xatom_wm_protocols }, + { "WM_TAKE_FOCUS", &dpyinfo->Xatom_wm_take_focus }, + { "WM_SAVE_YOURSELF", &dpyinfo->Xatom_wm_save_yourself }, + { "WM_DELETE_WINDOW", &dpyinfo->Xatom_wm_delete_window }, + { "WM_CHANGE_STATE", &dpyinfo->Xatom_wm_change_state }, + { "WM_CONFIGURE_DENIED", &dpyinfo->Xatom_wm_configure_denied }, + { "WM_MOVED", &dpyinfo->Xatom_wm_window_moved }, + { "WM_CLIENT_LEADER", &dpyinfo->Xatom_wm_client_leader }, + { "Editres", &dpyinfo->Xatom_editres }, + { "CLIPBOARD", &dpyinfo->Xatom_CLIPBOARD }, + { "TIMESTAMP", &dpyinfo->Xatom_TIMESTAMP }, + { "TEXT", &dpyinfo->Xatom_TEXT }, + { "COMPOUND_TEXT", &dpyinfo->Xatom_COMPOUND_TEXT }, + { "UTF8_STRING", &dpyinfo->Xatom_UTF8_STRING }, + { "DELETE", &dpyinfo->Xatom_DELETE }, + { "MULTIPLE", &dpyinfo->Xatom_MULTIPLE }, + { "INCR", &dpyinfo->Xatom_INCR }, + { "_EMACS_TMP_", &dpyinfo->Xatom_EMACS_TMP }, + { "TARGETS", &dpyinfo->Xatom_TARGETS }, + { "NULL", &dpyinfo->Xatom_NULL }, + { "ATOM_PAIR", &dpyinfo->Xatom_ATOM_PAIR }, + { "_XEMBED_INFO", &dpyinfo->Xatom_XEMBED_INFO }, + /* For properties of font. */ + { "PIXEL_SIZE", &dpyinfo->Xatom_PIXEL_SIZE }, + { "AVERAGE_WIDTH", &dpyinfo->Xatom_AVERAGE_WIDTH }, + { "_MULE_BASELINE_OFFSET", &dpyinfo->Xatom_MULE_BASELINE_OFFSET }, + { "_MULE_RELATIVE_COMPOSE", &dpyinfo->Xatom_MULE_RELATIVE_COMPOSE }, + { "_MULE_DEFAULT_ASCENT", &dpyinfo->Xatom_MULE_DEFAULT_ASCENT }, + /* Ghostscript support. */ + { "DONE", &dpyinfo->Xatom_DONE }, + { "PAGE", &dpyinfo->Xatom_PAGE }, + { "SCROLLBAR", &dpyinfo->Xatom_Scrollbar }, + { "_XEMBED", &dpyinfo->Xatom_XEMBED }, + /* EWMH */ + { "_NET_WM_STATE", &dpyinfo->Xatom_net_wm_state }, + { "_NET_WM_STATE_FULLSCREEN", &dpyinfo->Xatom_net_wm_state_fullscreen }, + { "_NET_WM_STATE_MAXIMIZED_HORZ", + &dpyinfo->Xatom_net_wm_state_maximized_horz }, + { "_NET_WM_STATE_MAXIMIZED_VERT", + &dpyinfo->Xatom_net_wm_state_maximized_vert }, + { "_NET_WM_STATE_STICKY", &dpyinfo->Xatom_net_wm_state_sticky }, + { "_NET_WM_WINDOW_TYPE", &dpyinfo->Xatom_net_window_type }, + { "_NET_WM_WINDOW_TYPE_TOOLTIP", + &dpyinfo->Xatom_net_window_type_tooltip }, + { "_NET_WM_ICON_NAME", &dpyinfo->Xatom_net_wm_icon_name }, + { "_NET_WM_NAME", &dpyinfo->Xatom_net_wm_name }, + { "_NET_SUPPORTED", &dpyinfo->Xatom_net_supported }, + { "_NET_SUPPORTING_WM_CHECK", &dpyinfo->Xatom_net_supporting_wm_check }, + { "_NET_WM_WINDOW_OPACITY", &dpyinfo->Xatom_net_wm_window_opacity }, + { "_NET_ACTIVE_WINDOW", &dpyinfo->Xatom_net_active_window }, + { "_NET_FRAME_EXTENTS", &dpyinfo->Xatom_net_frame_extents }, + /* Session management */ + { "SM_CLIENT_ID", &dpyinfo->Xatom_SM_CLIENT_ID }, + { "_XSETTINGS_SETTINGS", &dpyinfo->Xatom_xsettings_prop }, + { "MANAGER", &dpyinfo->Xatom_xsettings_mgr }, + }; + + int i; + const int atom_count = sizeof (atom_refs) / sizeof (atom_refs[0]); + /* 1 for _XSETTINGS_SN */ + const int total_atom_count = 1 + atom_count; + Atom *atoms_return = xmalloc (sizeof (Atom) * total_atom_count); + char **atom_names = xmalloc (sizeof (char *) * total_atom_count); + char xsettings_atom_name[64]; + + for (i = 0; i < atom_count; i++) + atom_names[i] = (char *) atom_refs[i].name; + + /* Build _XSETTINGS_SN atom name */ + snprintf (xsettings_atom_name, sizeof (xsettings_atom_name), + "_XSETTINGS_S%d", XScreenNumberOfScreen (dpyinfo->screen)); + atom_names[i] = xsettings_atom_name; + + XInternAtoms (dpyinfo->display, atom_names, total_atom_count, + False, atoms_return); + + for (i = 0; i < atom_count; i++) + *atom_refs[i].atom = atoms_return[i]; + + /* Manual copy of last atom */ + dpyinfo->Xatom_xsettings_sel = atoms_return[i]; + + xfree (atom_names); + xfree (atoms_return); + } dpyinfo->x_dnd_atoms_size = 8; dpyinfo->x_dnd_atoms_length = 0;
--- a/src/xterm.h Mon Nov 08 14:19:54 2010 +0900 +++ b/src/xterm.h Wed Nov 17 13:09:08 2010 +0900 @@ -270,7 +270,7 @@ Atom Xatom_Scrollbar; /* Atom used in XEmbed client messages. */ - Atom Xatom_XEMBED; + Atom Xatom_XEMBED, Xatom_XEMBED_INFO;; /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note @@ -332,15 +332,17 @@ /* Extended window manager hints, Atoms supported by the window manager and atoms for settig the window type. */ + Atom Xatom_net_supported, Xatom_net_supporting_wm_check; Atom *net_supported_atoms; int nr_net_supported_atoms; Window net_supported_window; Atom Xatom_net_window_type, Xatom_net_window_type_tooltip; + Atom Xatom_net_active_window; - /* Atoms dealing with maximization and fullscreen */ - Atom Xatom_net_wm_state, Xatom_net_wm_state_fullscreen_atom, + /* Atoms dealing with EWMH (i.e. _NET_...) */ + Atom Xatom_net_wm_state, Xatom_net_wm_state_fullscreen, Xatom_net_wm_state_maximized_horz, Xatom_net_wm_state_maximized_vert, - Xatom_net_wm_state_sticky; + Xatom_net_wm_state_sticky, Xatom_net_frame_extents; /* XSettings atoms and windows. */ Atom Xatom_xsettings_sel, Xatom_xsettings_prop, Xatom_xsettings_mgr; @@ -348,6 +350,11 @@ /* Frame name and icon name */ Atom Xatom_net_wm_name, Xatom_net_wm_icon_name; + /* Frame opacity */ + Atom Xatom_net_wm_window_opacity; + + /* SM */ + Atom Xatom_SM_CLIENT_ID; }; #ifdef HAVE_X_I18N @@ -1011,6 +1018,13 @@ extern void x_handle_selection_event (struct input_event *); extern void x_clear_frame_selections (struct frame *); +extern void x_send_client_event (Lisp_Object display, + Lisp_Object dest, + Lisp_Object from, + Atom message_type, + Lisp_Object format, + Lisp_Object values); + extern int x_handle_dnd_message (struct frame *, XClientMessageEvent *, struct x_display_info *,
--- a/test/ChangeLog Mon Nov 08 14:19:54 2010 +0900 +++ b/test/ChangeLog Wed Nov 17 13:09:08 2010 +0900 @@ -1,3 +1,7 @@ +2010-11-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * indent/modula2.mod: New file. + 2010-10-27 Stefan Monnier <monnier@iro.umontreal.ca> * indent/octave.m: Add a test to ensure indentation is local.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/indent/modula2.mod Wed Nov 17 13:09:08 2010 +0900 @@ -0,0 +1,53 @@ +(* -*- mode: modula-2; m2-indent:3 -*- *) + +IMPLEMENTATION MODULE Indent ; + +(* This is (* a nested comment *) *) +// This is a single-line comment. + +FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD ; + +CONST + c1 = 2; + +TYPE + t = POINTER TO ARRAY [0..10] OF LONGINT; + +VAR x: t; + y:LONGINT; + + +PROCEDURE f1 (f: File) : INTEGER ; + VAR + fd: FileDescriptor ; + PROCEDURE foo (a:CARDINAL) : INTEGER; + BEGIN + END foo; +BEGIN + IF f#Error + THEN + fd := GetIndice(FileInfo, f) ; + IF fd#NIL THEN + RETURN( fd^.unixfd ) + ELSE + CASE z OF + 1: do1(); + | 2: do2(); + toto(x); + | 3: ; + | 4: do4(); + ELSE do5(); + END ; (* CASE selection *) + + END + END ; + FormatError1('file %d has not been opened or is out of range\n', f) ; + RETURN( -1 ) +END f1 ; + + +BEGIN + init +FINALLY + done +END Indent.