diff options
661 files changed, 39533 insertions, 23240 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index f12dbf7d859..f098f3e7460 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -2,6 +2,10 @@ (sentence-end-double-space . t) (fill-column . 70))) (c-mode . ((c-file-style . "GNU"))) + ;; You must set bugtracker_debbugs_url in your bazaar.conf for this to work. + ;; See admin/notes/bugtracker. + (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") diff --git a/ChangeLog b/ChangeLog index 4c5acca4dc1..aec929ce90d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,69 @@ +2010-12-10 Andreas Schwab <schwab@linux-m68k.org> + + * configure.in: Don't double machfile in final message. + +2010-12-04 Chong Yidong <cyd@stupidchicken.com> + + * configure.in: Fix last change. + +2010-12-04 Andreas Schwab <schwab@linux-m68k.org> + + * configure.in: Remove reference to removed machine description + files and allow $machine and $machfile to be empty. Substitute + M_FILE/S_FILE instead of machfile/opsysfile. + +2010-12-03 Glenn Morris <rgm@gnu.org> + + * make-dist: Remove EMACS_UNIBYTE unsetting; it does nothing. + +2010-11-23 Dan Nicolaescu <dann@ics.uci.edu> + + * configure.in <AC_CHECK_HEADERS>: Remove sys/ioctl.h. + (EXTERNALLY_VISIBLE): New definition. + +2010-11-21 Dan Nicolaescu <dann@ics.uci.edu> + + * configure.in (INLINE): Do not depend on OPTIMIZE, unused. + +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. + +2010-10-31 Ken Brown <kbrown@cornell.edu> + + * configure.in (checking whether localtime caches TZ): Use + unsetenv instead of modifying environment directly. + +2010-10-25 Andreas Schwab <schwab@linux-m68k.org> + + * configure.in (checking for -znocombreloc): Use AC_LANG_PROGRAM + to avoid warning. + +2010-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * configure.in: Remove the BROKEN annotation from gnutls. + +2010-10-22 Glenn Morris <rgm@gnu.org> + + * make-dist: Avoid listing .el files twice. Don't try to run + autoconf if --no-update. + +2010-10-20 Glenn Morris <rgm@gnu.org> + + * make-dist: No longer create lisp/MANIFEST. + 2010-10-14 Glenn Morris <rgm@gnu.org> * BUGS, INSTALL.BZR, README: Updates. @@ -2855,7 +2921,7 @@ * make-dist (lispref): Do include lispref/index.texi. -2004-01-06 Eric Hanchrow <offby1@blarg.net> (tiny change) +2004-01-06 Eric Hanchrow <offby1@blarg.net> * make-dist (tempdir): Include cursors in nt/icons. @@ -676,8 +676,7 @@ the following steps. the paths to the values specified in `./Makefile'. 2) Go to directory `./lib-src' and run `make'. This creates -executables named `ctags' and `etags' and `make-docfile' and -`digest-doc' and `test-distrib'. And others. +executables named `etags', `make-docfile', and others. 3) Go to directory `./src' and run `make'. This refers to files in the `./lisp' and `./lib-src' subdirectories using names `../lisp' and @@ -709,8 +708,6 @@ Strictly speaking, not all of the executables in `./lib-src' need be copied. are intended to be run by users; they are handled below. - The programs `make-docfile' and `test-distrib' were used in building Emacs, and are not needed any more. -- The programs `digest-doc' and `sorted-doc' convert a `DOC' file into - a file for users to read. There is no important reason to move them. 2) Copy the files in `./info' to the place specified in `./lisp/site-init.el' or `./lisp/paths.el'. Note that if the diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index b5f4d555ad4..0346bb2e620 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -62,7 +62,6 @@ SIGTYPE SYSTEM_TYPE ** Machine specific macros, decribed in detail in src/m/template.h -EXPLICIT_SIGN_EXTEND LOAD_AVE_CVT LOAD_AVE_TYPE VIRT_ADDR_VARIES diff --git a/admin/ChangeLog b/admin/ChangeLog index 6d114eae003..f5c52f09375 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,7 @@ +2010-12-03 Andreas Schwab <schwab@linux-m68k.org> + + * CPP-DEFINES (EXPLICIT_SIGN_EXTEND): Remove. + 2010-10-12 Glenn Morris <rgm@gnu.org> * notes/nextstep: Move here from ../nextstep/DEV-NOTES. diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index f685dd5e50f..6ff7a815cb7 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -4,7 +4,8 @@ Instructions to create pretest or release tarballs. For each step, check for possible errors. -1. cvs -q update -Pd +1. `bzr update' (for a bound branch), or `bzr pull'. + bzr status # check for locally modified files 2. Bootstrap to make 100% sure all elc files are up-to-date, and to make sure that the later tagged version will bootstrap, should it be @@ -27,24 +28,23 @@ For each step, check for possible errors. refer to a newer release of Emacs. (This is probably needed only when preparing a major Emacs release, or branching for it.) -5. rm configure; autoconf +5. rm configure src/config.in; autoconf; autoheader make bootstrap -6. Commit configure, README, doc/emacs/emacs.texi, - doc/lispref/elisp.texi, etc/AUTHORS, src/emacs.c, nt/emacs.rc, - and lisp/cus-edit.el (if modified). Copy lisp/loaddefs.el to - lisp/ldefs-boot.el and commit lisp/ldefs-boot.el. For a release, - also commit the ChangeLog files in all directories. +6. Commit configure, src/config.in, etc/AUTHORS, all the files changed + by M-x set-version, and lisp/cus-edit.el (if modified). + Copy lisp/loaddefs.el to lisp/ldefs-boot.el and commit lisp/ldefs-boot.el. + For a release, also commit the ChangeLog files in all directories. 7. make-dist --snapshot. Check the contents of the new tar with admin/diff-tar-files against an older tar file. Some old pretest - tarballs are kept under fencepost.gnu.org:~pot/emacs-pretest/, while - old emacs tarballs are at <ftp://ftp.gnu.org/pub/gnu/emacs/>. + tarballs may be found at <ftp://alpha.gnu.org/gnu/emacs/pretest>; + old release tarballs are at <ftp://ftp.gnu.org/pub/gnu/emacs/>. If this is the first pretest of a major release, just comparing with the previous release may overlook many new files. You can try - something like `find -f | grep -v CVS...etc' in a clean CVS tree, - and compare the results against the new tar contents. + something like `find . | sort' in a clean bzr tree, and compare the + results against the new tar contents. 8. xdelta delta emacs-OLD.tar.gz emacs-NEW.tar.gz emacs-OLD-NEW.xdelta @@ -108,5 +108,3 @@ For each step, check for possible errors. For a release, announce it on info-gnu@gnu.org, info-gnu-emacs@gnu.org, and emacs-devel. - -# arch-tag: c23c771f-ca26-4584-8a04-50ecf0989390 diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index 5b3af5e242c..7c6c0ff4272 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -384,6 +384,14 @@ fixed 123 23.0.60 *** To remove a "fixed" mark: notfixed 123 23.0.60 +*** To make a bug as present in a particular version: +found 123 23.2 +NB if there is no specified "fixed" version, or if there is one and it +is earlier than the found version, this reopens a closed bug. + +The leading "23.1;" that M-x report-emacs-bug adds to bug subjects +automatically sets a found version (if none is explicitly specified). + *** To assign or reassign a bug to a package or list of packages: reassign 1234 emacs @@ -466,16 +474,41 @@ http://lists.gnu.org/archive/html/emacs-devel/2009-11/msg00440.html ** Bazaar stuff -*** You can use `bzr commit --fixes emacs:123' to mark that a commit fixes -Emacs bug 123. You will first need to add a line to your bazaar.conf: +*** You can use `bzr commit --fixes debbugs:123' to mark that a commit fixes +Emacs bug 123. You will first need to add a line to one of your +configuration files, ~/.bazaar/bazaar.conf or ~/.bazaar/locations.conf: + +bugtracker_debbugs_url = http://debbugs.gnu.org/{id} + +Here "{id}" is a literal string, a placeholder that will be replaced +by the bug number you specify after `--fixes debbugs:' in the bzr +command line (123 in the example above). + +In the bazaar.conf file, this setting should go into the [DEFAULTS] +section. + +In the locations.conf file, it should go into the branch-specific +configuration section for the branch where you want this to be in +effect. For example, if you want this to be in effect for the branch +located at `/home/projects/emacs/trunk', you need to have this in your +~/.bazaar/locations.conf file: + +[/home/projects/emacs/trunk] +bugtracker_debbugs_url = http://debbugs.gnu.org/{id} + +If you want to use this in all Emacs branches whose common parent is +`/home/projects/emacs', put the setting in the [/home/projects/emacs] +section. See "bzr help configuration" for more information about +the *.conf files, their location and formats. See "bzr help bugs" for +more information about the bugtracker_debbugs_url setting. -bugtracker_emacs_url = http://debbugs.gnu.org/{id} +See also log-edit-rewrite-fixes in .dir-locals.el. Note that all this does is add some metadata to the commit, it doesn't -actually mark the bug as closed in the tracker. There seems to be no -way to see this "metadata" with `bzr log', which is rather poor, but -it will show up as a link in a recent loggerhead installation, or with -some of the graphical frontends to bzr log. +actually mark the bug as closed in the tracker. You can see this +information with `bzr log', and it will show up as a link in a recent +loggerhead installation, or with some of the graphical frontends to +`bzr log'. ** Gnus-specific voodoo diff --git a/admin/notes/elpa b/admin/notes/elpa new file mode 100644 index 00000000000..e28d81e6d6e --- /dev/null +++ b/admin/notes/elpa @@ -0,0 +1,42 @@ +NOTES ON THE EMACS PACKAGE ARCHIVE + +Here are instructions on uploading files to the package archive at +elpa.gnu.org, for Emacs maintainers. (If you are not a maintainer, +contact us if you want to submit a package.) + +1. You will need login access to elpa.gnu.org. You will also need to + get the FSF sysadmins to allow ssh access through the FSF firewall + for your local machine. Ensure that your uid, USER, is in the + `elpa' group on elpa.gnu.org; this gives you write access to the + bzr repository from which the packages are managed. + +2. Go to your bzr repository on your local machine. Of, if you don't + have one (you should, if you're tracking Emacs bzr), make one: + + cd $DEVHOME + bzr init-repo elpa/ + cd elpa + + Create a branch for elpa: + + bzr branch bzr+ssh://USER@elpa.gnu.org/home/elpa/package-repo package-repo + + Bind the branch: + + cd package-repo/ + echo "public_branch = bzr+ssh://USER@elpa.gnu.org/home/elpa/package-repo" >> .bzr/branch/branch.conf + bzr bind bzr+ssh://USER@elpa.gnu.org/home/elpa/package-repo + + Now you should be able to do `bzr up' and `bzr commit'. + +3. Changes in bzr do not immediately propagate to the user-facing tree + (i.e., what users see when they do `M-x list-packages'). That tree + is created by a (daily) cron job that does "bzr export". If for + some reason you need to refresh the user-facing tree immediately, + run /home/elpa/bin/package-update.sh as the "elpa" user. + + The Org mode dailies are not part of the repository. After the + package-update.sh script creates the user-facing tree, it copies + the daily tarfile hosted on orgmode.org directly into that tree. + +4. FIXME: How to actually upload a package file. diff --git a/configure b/configure index dcea52950b8..d5ffec6ca7a 100755 --- a/configure +++ b/configure @@ -1,11 +1,11 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.65 for emacs 24.0.50. +# Generated by GNU Autoconf 2.68 for emacs 24.0.50. # # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, -# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, -# Inc. +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software +# Foundation, Inc. # # # This configure script is free software; the Free Software Foundation @@ -89,6 +89,7 @@ fi 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 @@ -214,11 +215,18 @@ IFS=$as_save_IFS # 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 - exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} + 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+"$@"} fi if test x$as_have_required = xno; then : @@ -316,7 +324,7 @@ $as_echo X"$as_dir" | test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p @@ -356,19 +364,19 @@ else fi # as_fn_arith -# as_fn_error ERROR [LINENO LOG_FD] -# --------------------------------- +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with status $?, using 1 if that was 0. +# script with STATUS, using 1 if that was 0. as_fn_error () { - as_status=$?; test $as_status -eq 0 && as_status=1 - if test "$3"; then - as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi - $as_echo "$as_me: error: $1" >&2 + $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error @@ -530,7 +538,7 @@ test -n "$DJDIR" || exec 7<&0 </dev/null exec 6>&1 # Name of the host. -# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` @@ -622,8 +630,8 @@ ns_appsrc ns_appresdir ns_appbindir ns_appdir -opsysfile -machfile +S_FILE +M_FILE X_TOOLKIT_TYPE C_SWITCH_X_SYSTEM C_SWITCH_X_SITE @@ -912,8 +920,9 @@ do fi case $ac_option in - *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *) ac_optarg=yes ;; + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. @@ -958,7 +967,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid feature name: $ac_useropt" + as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -984,7 +993,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid feature name: $ac_useropt" + as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1188,7 +1197,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid package name: $ac_useropt" + as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1204,7 +1213,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error "invalid package name: $ac_useropt" + as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1234,8 +1243,8 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information." + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" ;; *=*) @@ -1243,7 +1252,7 @@ Try \`$0 --help' for more information." # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error "invalid variable name: \`$ac_envvar'" ;; + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; @@ -1253,7 +1262,7 @@ Try \`$0 --help' for more information." $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 @@ -1261,13 +1270,13 @@ done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` - as_fn_error "missing argument to $ac_option" + as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; - fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi @@ -1290,7 +1299,7 @@ do [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac - as_fn_error "expected an absolute directory name for --$ac_var: $ac_val" + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' @@ -1304,8 +1313,8 @@ target=$target_alias if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe - $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. - If a cross compiler is detected then cross compile mode will be used." >&2 + $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -1320,9 +1329,9 @@ test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - as_fn_error "working directory cannot be determined" + as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - as_fn_error "pwd does not report name of working directory" + as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified. @@ -1361,11 +1370,11 @@ else fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - as_fn_error "cannot find sources ($ac_unique_file) in $srcdir" + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg" + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then @@ -1405,7 +1414,7 @@ Configuration: --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking...' messages + -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files @@ -1624,9 +1633,9 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF emacs configure 24.0.50 -generated by GNU Autoconf 2.65 +generated by GNU Autoconf 2.68 -Copyright (C) 2009 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1670,7 +1679,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile @@ -1716,7 +1725,7 @@ fi # 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; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link @@ -1742,7 +1751,7 @@ $as_echo "$ac_try_echo"; } >&5 mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } >/dev/null && { + test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then : @@ -1753,7 +1762,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp @@ -1766,10 +1775,10 @@ fi ac_fn_c_check_header_mongrel () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + if eval \${$3+:} false; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 fi eval ac_res=\$$3 @@ -1805,7 +1814,7 @@ if ac_fn_c_try_cpp "$LINENO"; then : else ac_header_preproc=no fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 $as_echo "$ac_header_preproc" >&6; } @@ -1832,7 +1841,7 @@ $as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=\$ac_header_compiler" @@ -1841,7 +1850,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_mongrel @@ -1882,7 +1891,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run @@ -1896,7 +1905,7 @@ ac_fn_c_check_header_compile () 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 { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -1914,19 +1923,22 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile -# ac_fn_c_check_decl LINENO SYMBOL VAR -# ------------------------------------ -# Tests whether SYMBOL is declared, setting cache variable VAR accordingly. +# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES +# --------------------------------------------- +# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR +# accordingly. ac_fn_c_check_decl () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $2 is declared" >&5 -$as_echo_n "checking whether $2 is declared... " >&6; } -if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + as_decl_name=`echo $2|sed 's/ *(.*//'` + 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 : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -1935,8 +1947,12 @@ $4 int main () { -#ifndef $2 - (void) $2; +#ifndef $as_decl_name +#ifdef __cplusplus + (void) $as_decl_use; +#else + (void) $as_decl_name; +#endif #endif ; @@ -1953,7 +1969,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_decl @@ -1965,7 +1981,7 @@ ac_fn_c_check_header_preproc () 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 { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -1977,12 +1993,12 @@ if ac_fn_c_try_cpp "$LINENO"; then : else eval "$3=no" fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_preproc @@ -1995,7 +2011,7 @@ ac_fn_c_check_member () 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 { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$4+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2039,7 +2055,7 @@ fi eval ac_res=\$$4 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_member @@ -2051,7 +2067,7 @@ ac_fn_c_check_func () 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 { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2106,7 +2122,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_func @@ -2119,7 +2135,7 @@ ac_fn_c_check_type () 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 { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=no" @@ -2160,7 +2176,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_type cat >config.log <<_ACEOF @@ -2168,7 +2184,7 @@ This file contains any messages produced by compilers while 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.65. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was $ $0 $@ @@ -2278,11 +2294,9 @@ trap 'exit_status=$? { echo - cat <<\_ASBOX -## ---------------- ## + $as_echo "## ---------------- ## ## Cache variables. ## -## ---------------- ## -_ASBOX +## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( @@ -2316,11 +2330,9 @@ $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; ) echo - cat <<\_ASBOX -## ----------------- ## + $as_echo "## ----------------- ## ## Output variables. ## -## ----------------- ## -_ASBOX +## ----------------- ##" echo for ac_var in $ac_subst_vars do @@ -2333,11 +2345,9 @@ _ASBOX echo if test -n "$ac_subst_files"; then - cat <<\_ASBOX -## ------------------- ## + $as_echo "## ------------------- ## ## File substitutions. ## -## ------------------- ## -_ASBOX +## ------------------- ##" echo for ac_var in $ac_subst_files do @@ -2351,11 +2361,9 @@ _ASBOX fi if test -s confdefs.h; then - cat <<\_ASBOX -## ----------- ## + $as_echo "## ----------- ## ## confdefs.h. ## -## ----------- ## -_ASBOX +## ----------- ##" echo cat confdefs.h echo @@ -2410,7 +2418,12 @@ _ACEOF ac_site_file1=NONE ac_site_file2=NONE if test -n "$CONFIG_SITE"; then - ac_site_file1=$CONFIG_SITE + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac elif test "x$prefix" != xNONE; then ac_site_file1=$prefix/share/config.site ac_site_file2=$prefix/etc/config.site @@ -2425,7 +2438,11 @@ do { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 $as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" + . "$ac_site_file" \ + || { { $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; } fi done @@ -2506,7 +2523,7 @@ if $ac_cache_corrupted; then $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 $as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## @@ -2680,7 +2697,7 @@ if test "${with_x_toolkit+set}" = set; then : g | gt | gtk ) val=gtk ;; gtk3 ) val=gtk3 ;; * ) -as_fn_error "\`--with-x-toolkit=$withval' is invalid; +as_fn_error $? "\`--with-x-toolkit=$withval' is invalid; this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif', \`gtk' or \`gtk3'. \`yes' and \`gtk' are synonyms. \`athena' and \`lucid' are synonyms." "$LINENO" 5 ;; @@ -2983,7 +3000,7 @@ do 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" @@ -3098,16 +3115,22 @@ fi ac_aux_dir= for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do - for ac_t in install-sh install.sh shtool; do - if test -f "$ac_dir/$ac_t"; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/$ac_t -c" - break 2 - fi - done + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi done if test -z "$ac_aux_dir"; then - as_fn_error "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 + as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 fi # These three variables are undocumented and unsupported, @@ -3121,27 +3144,27 @@ ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. # Make sure we can run config.sub. $SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || - as_fn_error "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 $as_echo_n "checking build system type... " >&6; } -if test "${ac_cv_build+set}" = set; then : +if ${ac_cv_build+:} false; then : $as_echo_n "(cached) " >&6 else ac_build_alias=$build_alias test "x$ac_build_alias" = x && ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` test "x$ac_build_alias" = x && - as_fn_error "cannot guess build type; you must specify one" "$LINENO" 5 + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || - as_fn_error "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 $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='-' @@ -3159,14 +3182,14 @@ case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 $as_echo_n "checking host system type... " >&6; } -if test "${ac_cv_host+set}" = set; then : +if ${ac_cv_host+:} false; then : $as_echo_n "(cached) " >&6 else if test "x$host_alias" = x; then ac_cv_host=$ac_cv_build else ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || - as_fn_error "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 fi fi @@ -3174,7 +3197,7 @@ fi $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='-' @@ -3216,13 +3239,27 @@ configuration=${host_alias-${build_alias-$host}} machine='' opsys='' unported=no case "${canonical}" in + ## GNU/Linux ports + *-*-linux-gnu*) + opsys=gnu-linux + case ${canonical} in + alpha*) machine=alpha ;; + s390-*) machine=ibms390 ;; + s390x-*) machine=ibms390x ;; + powerpc*) machine=macppc ;; + sparc*) machine=sparc ;; + ia64*) machine=ia64 ;; + m68k*) machine=m68k ;; + x86_64*) machine=amdx86-64 ;; + esac + ;; + ## FreeBSD ports *-*-freebsd* ) opsys=freebsd case "${canonical}" in alpha*) machine=alpha ;; amd64-*|x86_64-*) machine=amdx86-64 ;; - arm*) machine=arm ;; ia64-*) machine=ia64 ;; i[3456]86-*) machine=intel386 ;; powerpc-*) machine=macppc ;; @@ -3251,13 +3288,9 @@ case "${canonical}" in case "${canonical}" in alpha*) machine=alpha ;; x86_64-*) machine=amdx86-64 ;; - arm-*) machine=arm ;; - hppa-*) machine=hp800 ;; i[3456]86-*) machine=intel386 ;; m68k-*) machine=m68k ;; powerpc-*) machine=macppc ;; - mips-*) machine=mips ;; - mipse[bl]-*) machine=mips ;; sparc*-) machine=sparc ;; vax-*) machine=vax ;; esac @@ -3269,8 +3302,6 @@ case "${canonical}" in case "${canonical}" in alpha*) machine=alpha ;; x86_64-*) machine=amdx86-64 ;; - arm-*) machine=arm ;; - hppa-*) machine=hp800 ;; i386-*) machine=intel386 ;; powerpc-*) machine=macppc ;; sparc*) machine=sparc ;; @@ -3278,14 +3309,6 @@ case "${canonical}" in esac ;; - alpha*-*-linux-gnu* ) - machine=alpha opsys=gnu-linux - ;; - - arm*-*-linux-gnu* ) - machine=arm opsys=gnu-linux - ;; - ## Apple Darwin / Mac OS X *-apple-darwin* ) case "${canonical}" in @@ -3307,24 +3330,14 @@ case "${canonical}" in ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux10.2* ) - machine=hp800 opsys=hpux10-20 + opsys=hpux10-20 ;; hppa*-hp-hpux1[1-9]* ) - machine=hp800 opsys=hpux11 + opsys=hpux11 CFLAGS="-D_INCLUDE__STDC_A1_SOURCE $CFLAGS" ;; - hppa*-*-linux-gnu* ) - machine=hp800 opsys=gnu-linux - ;; - ## IBM machines - s390-*-linux-gnu* ) - machine=ibms390 opsys=gnu-linux - ;; - s390x-*-linux-gnu* ) - machine=ibms390x opsys=gnu-linux - ;; rs6000-ibm-aix4.[23]* ) machine=ibmrs6000 opsys=aix4-2 ;; @@ -3338,11 +3351,6 @@ case "${canonical}" in machine=ibmrs6000 opsys=aix4-2 ;; - ## Macintosh PowerPC - powerpc*-*-linux-gnu* ) - machine=macppc opsys=gnu-linux - ;; - ## Silicon Graphics machines ## Iris 4D mips-sgi-irix6.5 ) @@ -3355,10 +3363,6 @@ case "${canonical}" in ;; ## Suns - sparc-*-linux-gnu* | sparc64-*-linux-gnu* ) - machine=sparc opsys=gnu-linux - ;; - *-sun-solaris* \ | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \ | x86_64-*-solaris2* | x86_64-*-sunos5*) @@ -3398,11 +3402,6 @@ case "${canonical}" in esac ;; - ## IA-64 - ia64*-*-linux* ) - machine=ia64 opsys=gnu-linux - ;; - ## Intel 386 machines where we don't care about the manufacturer. i[3456]86-*-* ) machine=intel386 @@ -3411,7 +3410,6 @@ case "${canonical}" in *-darwin* ) opsys=darwin CPP="${CC-cc} -E -no-cpp-precomp" ;; - *-linux-gnu* ) opsys=gnu-linux ;; *-sysv4.2uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;; *-sysv5uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;; *-sysv5OpenUNIX* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;; @@ -3419,32 +3417,6 @@ case "${canonical}" in esac ;; - ## m68k Linux-based GNU system - m68k-*-linux-gnu* ) - machine=m68k opsys=gnu-linux - ;; - - ## Mips Linux-based GNU system - mips-*-linux-gnu* | mipsel-*-linux-gnu* \ - | mips64-*-linux-gnu* | mips64el-*-linux-gnu* ) - machine=mips opsys=gnu-linux - ;; - - ## AMD x86-64 Linux-based GNU system - x86_64-*-linux-gnu* ) - machine=amdx86-64 opsys=gnu-linux - ;; - - ## Tensilica Xtensa Linux-based GNU system - xtensa*-*-linux-gnu* ) - machine=xtensa opsys=gnu-linux - ;; - - ## SuperH Linux-based GNU system - sh[34]*-*-linux-gnu* ) - machine=sh3 opsys=gnu-linux - ;; - * ) unported=yes ;; @@ -3468,11 +3440,15 @@ fi if test $unported = yes; then - as_fn_error "Emacs hasn't been ported to \`${canonical}' systems. + as_fn_error $? "Emacs hasn't been ported to \`${canonical}' systems. Check \`etc/MACHINES' for recognized configuration names." "$LINENO" 5 fi -machfile="m/${machine}.h" +if test -n "$machine"; then + machfile="m/${machine}.h" +else + machfile= +fi opsysfile="s/${opsys}.h" @@ -3492,7 +3468,7 @@ if test -n "$ac_tool_prefix"; then 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 test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3532,7 +3508,7 @@ if test -z "$ac_cv_prog_CC"; then 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 test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -3585,7 +3561,7 @@ if test -z "$CC"; then 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 test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3625,7 +3601,7 @@ if test -z "$CC"; then 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 test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3684,7 +3660,7 @@ if test -z "$CC"; then 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 test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -3728,7 +3704,7 @@ do 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 test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -3782,8 +3758,8 @@ fi 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; } +as_fn_error $? "no acceptable C compiler found in \$PATH +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 @@ -3897,9 +3873,8 @@ sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -{ as_fn_set_status 77 -as_fn_error "C compiler cannot create executables -See \`config.log' for more details." "$LINENO" 5; }; } +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } @@ -3941,8 +3916,8 @@ done else { { $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; } +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +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 @@ -3999,9 +3974,9 @@ $as_echo "$ac_try_echo"; } >&5 else { { $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 run C compiled programs. +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 @@ -4012,7 +3987,7 @@ rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out 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 test "${ac_cv_objext+set}" = set; then : +if ${ac_cv_objext+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4052,8 +4027,8 @@ sed 's/^/| /' conftest.$ac_ext >&5 { { $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; } +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi @@ -4063,7 +4038,7 @@ OBJEXT=$ac_cv_objext 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 test "${ac_cv_c_compiler_gnu+set}" = set; then : +if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4100,7 +4075,7 @@ ac_test_CFLAGS=${CFLAGS+set} 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 test "${ac_cv_prog_cc_g+set}" = set; then : +if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag @@ -4178,7 +4153,7 @@ else 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 test "${ac_cv_prog_cc_c89+set}" = set; then : +if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no @@ -4286,7 +4261,7 @@ if test x"$GCC" != xyes && test x"$emacs_check_sunpro_c" = xyes && \ { $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 test "${emacs_cv_sunpro_c+set}" = set; then : +if ${emacs_cv_sunpro_c+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4355,7 +4330,7 @@ if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then : + if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -4385,7 +4360,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -4401,11 +4376,11 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi @@ -4444,7 +4419,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -4460,18 +4435,18 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $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; } +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c @@ -4483,7 +4458,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu { $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 test "${ac_cv_path_GREP+set}" = set; then : +if ${ac_cv_path_GREP+:} false; then : $as_echo_n "(cached) " >&6 else if test -z "$GREP"; then @@ -4532,7 +4507,7 @@ esac done IFS=$as_save_IFS if test -z "$ac_cv_path_GREP"; then - as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_GREP=$GREP @@ -4546,7 +4521,7 @@ $as_echo "$ac_cv_path_GREP" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 $as_echo_n "checking for egrep... " >&6; } -if test "${ac_cv_path_EGREP+set}" = set; then : +if ${ac_cv_path_EGREP+:} false; then : $as_echo_n "(cached) " >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 @@ -4598,7 +4573,7 @@ esac done IFS=$as_save_IFS if test -z "$ac_cv_path_EGREP"; then - as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_EGREP=$EGREP @@ -4613,7 +4588,7 @@ $as_echo "$ac_cv_path_EGREP" >&6; } { $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 test "${ac_cv_header_stdc+set}" = set; then : +if ${ac_cv_header_stdc+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4730,8 +4705,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default " -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -4743,7 +4717,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_header_minix_config_h" = xyes; then : MINIX=yes else MINIX= @@ -4765,7 +4739,7 @@ $as_echo "#define _MINIX 1" >>confdefs.h { $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 test "${ac_cv_safe_to_define___extensions__+set}" = set; then : +if ${ac_cv_safe_to_define___extensions__+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4945,7 +4919,7 @@ if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then : + if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -4975,7 +4949,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -4991,11 +4965,11 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi @@ -5034,7 +5008,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -5050,18 +5024,18 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $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; } +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c @@ -5087,7 +5061,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu { $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 test "${ac_cv_path_install+set}" = set; then : +if ${ac_cv_path_install+:} false; then : $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -5169,7 +5143,7 @@ if test "x$RANLIB" = x; then 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 test "${ac_cv_prog_RANLIB+set}" = set; then : +if ${ac_cv_prog_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then @@ -5209,7 +5183,7 @@ if test -z "$ac_cv_prog_RANLIB"; then 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 test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then @@ -5264,7 +5238,7 @@ fi ## 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" = x""yes; then : +if test "x$ac_cv_have_decl_i386" = xyes; then : fi @@ -5279,7 +5253,7 @@ fi 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 test "${ac_cv_path_INSTALL_INFO+set}" = set; then : +if ${ac_cv_path_INSTALL_INFO+:} false; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -5319,7 +5293,7 @@ fi 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 test "${ac_cv_path_INSTALL_INFO+set}" = set; then : +if ${ac_cv_path_INSTALL_INFO+:} false; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -5359,7 +5333,7 @@ fi 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 test "${ac_cv_path_INSTALL_INFO+set}" = set; then : +if ${ac_cv_path_INSTALL_INFO+:} false; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -5400,7 +5374,7 @@ fi 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 test "${ac_cv_path_GZIP_PROG+set}" = set; then : +if ${ac_cv_path_GZIP_PROG+:} false; then : $as_echo_n "(cached) " >&6 else case $GZIP_PROG in @@ -5443,7 +5417,7 @@ fi 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 test "${ac_cv_path_MAKEINFO+set}" = set; then : +if ${ac_cv_path_MAKEINFO+:} false; then : $as_echo_n "(cached) " >&6 else case $MAKEINFO in @@ -5498,7 +5472,7 @@ if test "$MAKEINFO" = "no"; then if test "x${with_makeinfo}" = "xno"; then MAKEINFO=off elif test ! -e $srcdir/info/emacs; then - as_fn_error "You do not seem to have makeinfo >= 4.6, and your + as_fn_error $? "You do not seem to have makeinfo >= 4.6, and your source tree does not seem to have pre-built manuals in the \`info' directory. Either install a suitable version of makeinfo, or re-run configure with the \`--without-makeinfo' option to build without the manuals. " "$LINENO" 5 @@ -5506,19 +5480,17 @@ with the \`--without-makeinfo' option to build without the manuals. " "$LINENO" fi -if test x$GCC = xyes && test "x$GCC_LINK_TEST_OPTIONS" != x -then - ac_link="$ac_link $GCC_LINK_TEST_OPTIONS" -fi - -if test x$GCC = x && test "x$NON_GCC_LINK_TEST_OPTIONS" != x -then - ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" +if test x$GCC = xyes; then + test "x$GCC_LINK_TEST_OPTIONS" != x && \ + ac_link="$ac_link $GCC_LINK_TEST_OPTIONS" +else + test "x$NON_GCC_LINK_TEST_OPTIONS" != x && \ + ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" fi late_LDFLAGS=$LDFLAGS -if test "$GCC" = yes; then +if test x$GCC = xyes; then LDFLAGS="$LDFLAGS -Wl,-znocombreloc" else LDFLAGS="$LDFLAGS -znocombreloc" @@ -5528,7 +5500,14 @@ fi $as_echo_n "checking for -znocombreloc... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -main(){return 0;} + +int +main () +{ + + ; + return 0; +} _ACEOF if ac_fn_c_try_link "$LINENO"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 @@ -5602,7 +5581,7 @@ case "$opsys" in gnu-linux) ## cpp test was "ifdef __mips__", but presumably this is equivalent... - test "$machine" = "mips" && LD_SWITCH_SYSTEM="-G 0" + case $host_cpu in mips*) LD_SWITCH_SYSTEM="-G 0";; esac ;; netbsd) @@ -5639,7 +5618,7 @@ esac 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__" = x""yes; then : +if test "x$ac_cv_have_decl___ELF__" = xyes; then : fi @@ -5652,7 +5631,7 @@ fi if test "x$GCC" = "xyes"; then C_SWITCH_MACHINE="-fno-common" else - as_fn_error "What gives? Fix me if DEC Unix supports ELF now." "$LINENO" 5 + as_fn_error $? "What gives? Fix me if DEC Unix supports ELF now." "$LINENO" 5 fi else UNEXEC_OBJ=unexalpha.o @@ -5709,7 +5688,7 @@ if test "$enable_largefile" != no; then { $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 test "${ac_cv_sys_largefile_CC+set}" = set; then : +if ${ac_cv_sys_largefile_CC+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_sys_largefile_CC=no @@ -5760,7 +5739,7 @@ $as_echo "$ac_cv_sys_largefile_CC" >&6; } { $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 test "${ac_cv_sys_file_offset_bits+set}" = set; then : +if ${ac_cv_sys_file_offset_bits+:} false; then : $as_echo_n "(cached) " >&6 else while :; do @@ -5829,7 +5808,7 @@ rm -rf conftest* 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 test "${ac_cv_sys_large_files+set}" = set; then : +if ${ac_cv_sys_large_files+:} false; then : $as_echo_n "(cached) " >&6 else while :; do @@ -5930,7 +5909,7 @@ else ## Some platforms don't use any of these files, so it is not ## appropriate to put this test outside the if block. test -e $CRT_DIR/crtn.o || test -e $CRT_DIR/crt0.o || \ - as_fn_error "crt*.o not found in specified location." "$LINENO" 5 + as_fn_error $? "crt*.o not found in specified location." "$LINENO" 5 fi @@ -5985,8 +5964,7 @@ if test "${with_sound}" != "no"; then do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -5998,7 +5976,7 @@ done # 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 test "${ac_cv_lib_ossaudio__oss_ioctl+set}" = set; then : +if ${ac_cv_lib_ossaudio__oss_ioctl+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -6032,7 +6010,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_ossaudio__oss_ioctl" = xyes; then : LIBSOUND=-lossaudio else LIBSOUND= @@ -6049,7 +6027,7 @@ fi 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -6177,7 +6155,7 @@ else fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext if test "$emacs_alsa_subdir" != yes; then - as_fn_error "pkg-config found alsa, but it does not compile. See config.log for error messages." "$LINENO" 5 + as_fn_error $? "pkg-config found alsa, but it does not compile. See config.log for error messages." "$LINENO" 5 fi ALSA_CFLAGS="$ALSA_CFLAGS -DALSA_SUBDIR_INCLUDE" fi @@ -6204,16 +6182,15 @@ $as_echo "#define HAVE_SOUND 1" >>confdefs.h 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` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -6254,7 +6231,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_term_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_TERM_H 1 _ACEOF @@ -6265,7 +6242,7 @@ done { $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 test "${ac_cv_header_stdc+set}" = set; then : +if ${ac_cv_header_stdc+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6377,7 +6354,7 @@ fi { $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 test "${ac_cv_header_time+set}" = set; then : +if ${ac_cv_header_time+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6411,7 +6388,7 @@ $as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h 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" = x""yes; then : +if test "x$ac_cv_have_decl_sys_siglist" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -6424,7 +6401,7 @@ _ACEOF 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" = x""yes; then : +if test "x$ac_cv_have_decl___sys_siglist" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -6442,7 +6419,7 @@ $as_echo "#define sys_siglist __sys_siglist" >>confdefs.h 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 test "${ac_cv_header_sys_wait_h+set}" = set; then : +if ${ac_cv_header_sys_wait_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6484,7 +6461,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5 $as_echo_n "checking for struct utimbuf... " >&6; } -if test "${emacs_cv_struct_utimbuf+set}" = set; then : +if ${emacs_cv_struct_utimbuf+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6527,7 +6504,7 @@ fi { $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 test "${ac_cv_type_signal+set}" = set; then : +if ${ac_cv_type_signal+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6561,7 +6538,7 @@ _ACEOF { $as_echo "$as_me:${as_lineno-$LINENO}: checking for speed_t" >&5 $as_echo_n "checking for speed_t... " >&6; } -if test "${emacs_cv_speed_t+set}" = set; then : +if ${emacs_cv_speed_t+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6592,7 +6569,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5 $as_echo_n "checking for struct timeval... " >&6; } -if test "${emacs_cv_struct_timeval+set}" = set; then : +if ${emacs_cv_struct_timeval+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6633,7 +6610,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct exception" >&5 $as_echo_n "checking for struct exception... " >&6; } -if test "${emacs_cv_struct_exception+set}" = set; then : +if ${emacs_cv_struct_exception+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6666,7 +6643,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_sys_socket_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_SOCKET_H 1 _ACEOF @@ -6682,7 +6659,7 @@ do : #include <sys/socket.h> #endif " -if test "x$ac_cv_header_net_if_h" = x""yes; then : +if test "x$ac_cv_header_net_if_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_NET_IF_H 1 _ACEOF @@ -6694,7 +6671,7 @@ done { $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 test "${ac_cv_struct_tm+set}" = set; then : +if ${ac_cv_struct_tm+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6731,7 +6708,7 @@ ac_fn_c_check_member "$LINENO" "struct tm" "tm_zone" "ac_cv_member_struct_tm_tm_ #include <$ac_cv_struct_tm> " -if test "x$ac_cv_member_struct_tm_tm_zone" = x""yes; then : +if test "x$ac_cv_member_struct_tm_tm_zone" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_TM_TM_ZONE 1 @@ -6747,7 +6724,7 @@ $as_echo "#define HAVE_TM_ZONE 1" >>confdefs.h else ac_fn_c_check_decl "$LINENO" "tzname" "ac_cv_have_decl_tzname" "#include <time.h> " -if test "x$ac_cv_have_decl_tzname" = x""yes; then : +if test "x$ac_cv_have_decl_tzname" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -6759,7 +6736,7 @@ _ACEOF { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tzname" >&5 $as_echo_n "checking for tzname... " >&6; } -if test "${ac_cv_var_tzname+set}" = set; then : +if ${ac_cv_var_tzname+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6796,7 +6773,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_member_struct_tm_tm_gmtoff" = xyes; then : $as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h @@ -6810,7 +6787,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_flags" "ac_cv_member_struct_i #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_flags" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_flags" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_FLAGS 1 @@ -6826,7 +6803,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_hwaddr" "ac_cv_member_struct_ #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_hwaddr" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_hwaddr" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_HWADDR 1 @@ -6842,7 +6819,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_netmask" "ac_cv_member_struct #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_netmask" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_netmask" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_NETMASK 1 @@ -6858,7 +6835,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_broadaddr" "ac_cv_member_stru #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_broadaddr" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_broadaddr" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_BROADADDR 1 @@ -6874,7 +6851,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_addr" "ac_cv_member_struct_if #include <net/if.h> #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_addr" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_addr" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_ADDR 1 @@ -6903,7 +6880,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working volatile" >&5 $as_echo_n "checking for working volatile... " >&6; } -if test "${ac_cv_c_volatile+set}" = set; then : +if ${ac_cv_c_volatile+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6937,7 +6914,7 @@ fi { $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 test "${ac_cv_c_const+set}" = set; then : +if ${ac_cv_c_const+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7017,7 +6994,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for void * support" >&5 $as_echo_n "checking for void * support... " >&6; } -if test "${emacs_cv_void_star+set}" = set; then : +if ${emacs_cv_void_star+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7050,7 +7027,7 @@ fi { $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 test "${ac_cv_c_bigendian+set}" = set; then : +if ${ac_cv_c_bigendian+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_c_bigendian=unknown @@ -7268,7 +7245,7 @@ $as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h ;; #( *) - as_fn_error "unknown endianness + as_fn_error $? "unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; esac @@ -7277,7 +7254,7 @@ $as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h $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 { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then : +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF @@ -7285,7 +7262,7 @@ SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; @@ -7365,7 +7342,7 @@ deps_frag=$srcdir/src/$deps_frag { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5 $as_echo_n "checking for long file names... " >&6; } -if test "${ac_cv_sys_long_file_names+set}" = set; then : +if ${ac_cv_sys_long_file_names+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_sys_long_file_names=yes @@ -7421,8 +7398,8 @@ if test "x$with_x" = xno; then have_x=disabled else case $x_includes,$x_libraries in #( - *\'*) as_fn_error "cannot use X directory names containing '" "$LINENO" 5;; #( - *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then : + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( + *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then : $as_echo_n "(cached) " >&6 else # One or both of the vars are not set, and there is no cached value. @@ -7439,7 +7416,7 @@ libdir: @echo libdir='${LIBDIR}' _ACEOF if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then - # GNU make sometimes prints "make[1]: Entering...", which would confuse us. + # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. for ac_var in incroot usrlibdir libdir; do eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" done @@ -7525,7 +7502,7 @@ else fi done fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext fi # $ac_x_includes = no if test "$ac_x_libraries" = no; then @@ -7686,7 +7663,7 @@ if test "${with_ns}" != no; then elif test -f $GNUSTEP_CONFIG_FILE; then NS_IMPL_GNUSTEP=yes ns_appdir=`pwd`/nextstep/Emacs.app - ns_appbindir=${ns_appdir} + ns_appbindir=${ns_appdir}/ ns_appresdir=${ns_appdir}/Resources ns_appsrc=${srcdir}/nextstep/GNUstep/Emacs.base GNUSTEP_SYSTEM_HEADERS="$(. $GNUSTEP_CONFIG_FILE; echo $GNUSTEP_SYSTEM_HEADERS)" @@ -7705,10 +7682,10 @@ if test "${with_ns}" != no; then 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" = x""yes; then : +if test "x$ac_cv_header_AppKit_AppKit_h" = xyes; then : HAVE_NS=yes else - as_fn_error "\`--with-ns' was specified, but the include + as_fn_error $? "\`--with-ns' was specified, but the include files are missing or cannot be compiled." "$LINENO" 5 fi @@ -7787,7 +7764,7 @@ if test "$window_system" = none && test "X$with_x" != "Xno"; then 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 test "${ac_cv_prog_HAVE_XSERVER+set}" = set; then : +if ${ac_cv_prog_HAVE_XSERVER+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$HAVE_XSERVER"; then @@ -7824,7 +7801,7 @@ fi if test "$HAVE_XSERVER" = true || test -n "$DISPLAY" || test "`echo /usr/lib/libX11.*`" != "/usr/lib/libX11.*"; then - as_fn_error "You seem to be running X, but no X development libraries + as_fn_error $? "You seem to be running X, but no X development libraries were found. You should install the relevant development files for X and for the toolkit you want, such as Gtk+, Lesstif or Motif. Also make sure you have development files for image handling, i.e. @@ -7846,14 +7823,14 @@ esac 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" = x""yes; then : +if test "x$ac_cv_func_malloc_get_state" = xyes; 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" = x""yes; then : +if test "x$ac_cv_func_malloc_set_state" = xyes; then : else doug_lea_malloc=no @@ -7861,7 +7838,7 @@ fi { $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 test "${emacs_cv_var___after_morecore_hook+set}" = set; then : +if ${emacs_cv_var___after_morecore_hook+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7947,8 +7924,7 @@ do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default " -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -7967,7 +7943,7 @@ done for ac_func in getpagesize do : ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize" -if test "x$ac_cv_func_getpagesize" = x""yes; then : +if test "x$ac_cv_func_getpagesize" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETPAGESIZE 1 _ACEOF @@ -7977,7 +7953,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5 $as_echo_n "checking for working mmap... " >&6; } -if test "${ac_cv_func_mmap_fixed_mapped+set}" = set; then : +if ${ac_cv_func_mmap_fixed_mapped+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -8054,6 +8030,7 @@ int main () { char *data, *data2, *data3; + const char *cdata2; int i, pagesize; int fd, fd2; @@ -8078,10 +8055,10 @@ main () fd2 = open ("conftest.txt", O_RDWR | O_CREAT | O_TRUNC, 0600); if (fd2 < 0) return 4; - data2 = ""; - if (write (fd2, data2, 1) != 1) + cdata2 = ""; + if (write (fd2, cdata2, 1) != 1) return 5; - data2 = mmap (0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED, fd2, 0L); + data2 = (char *) mmap (0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED, fd2, 0L); if (data2 == MAP_FAILED) return 6; for (i = 0; i < pagesize; ++i) @@ -8151,7 +8128,7 @@ LIBS="$LIBS_SYSTEM $LIBS" { $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 test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then : +if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -8185,7 +8162,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBDNET 1 _ACEOF @@ -8197,7 +8174,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lXbsd" >&5 $as_echo_n "checking for main in -lXbsd... " >&6; } -if test "${ac_cv_lib_Xbsd_main+set}" = set; then : +if ${ac_cv_lib_Xbsd_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -8225,14 +8202,14 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_Xbsd_main" = xyes; 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 test "${ac_cv_lib_pthreads_cma_open+set}" = set; then : +if ${ac_cv_lib_pthreads_cma_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -8266,7 +8243,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_pthreads_cma_open" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBPTHREADS 1 _ACEOF @@ -8293,7 +8270,7 @@ case ${host_os} in aix*) { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -bbigtoc option" >&5 $as_echo_n "checking for -bbigtoc option... " >&6; } -if test "${gdb_cv_bigtoc+set}" = set; then : +if ${gdb_cv_bigtoc+:} false; then : $as_echo_n "(cached) " >&6 else @@ -8454,8 +8431,7 @@ XScreenNumberOfScreen XSetWMProtocols do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -8468,7 +8444,7 @@ fi 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 test "${emacs_cv_x11_version_6+set}" = set; then : + if ${emacs_cv_x11_version_6+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8533,7 +8509,7 @@ if test "${HAVE_X11}" = "yes" || test "${NS_IMPL_GNUSTEP}" = "yes"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -8644,7 +8620,7 @@ if test "${HAVE_X11}" = "yes"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -8743,7 +8719,7 @@ $as_echo "#define HAVE_IMAGEMAGICK 1" >>confdefs.h for ac_func in MagickExportImagePixels do : ac_fn_c_check_func "$LINENO" "MagickExportImagePixels" "ac_cv_func_MagickExportImagePixels" -if test "x$ac_cv_func_MagickExportImagePixels" = x""yes; then : +if test "x$ac_cv_func_MagickExportImagePixels" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MAGICKEXPORTIMAGEPIXELS 1 _ACEOF @@ -8769,7 +8745,7 @@ if test "${with_gtk3}" = "yes"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -8857,7 +8833,7 @@ $as_echo "no" >&6; } fi if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then - as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5 + as_fn_error $? "$GTK_PKG_ERRORS" "$LINENO" 5 fi fi @@ -8875,7 +8851,7 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -8963,7 +8939,7 @@ $as_echo "no" >&6; } fi if test "$pkg_check_gtk" = "no" && test "$USE_X_TOOLKIT" != "maybe"; then - as_fn_error "$GTK_PKG_ERRORS" "$LINENO" 5 + as_fn_error $? "$GTK_PKG_ERRORS" "$LINENO" 5 fi fi fi @@ -8980,7 +8956,7 @@ if test x"$pkg_check_gtk" = xyes; then 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" = x""yes; then : +if test "x$ac_cv_func_gtk_main" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GTK_MAIN 1 _ACEOF @@ -8990,7 +8966,7 @@ done 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 @@ -9028,7 +9004,7 @@ if test "${HAVE_GTK}" = "yes"; then 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" = x""yes; then : +if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = xyes; then : HAVE_GTK_FILE_SELECTION=yes else HAVE_GTK_FILE_SELECTION=no @@ -9038,7 +9014,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_func_gtk_file_selection_new" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GTK_FILE_SELECTION_NEW 1 _ACEOF @@ -9052,7 +9028,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_header_pthread_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_PTHREAD_H 1 _ACEOF @@ -9064,7 +9040,7 @@ done 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 test "${ac_cv_lib_pthread_pthread_self+set}" = set; then : +if ${ac_cv_lib_pthread_pthread_self+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9098,7 +9074,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_pthread_pthread_self" = xyes; then : HAVE_GTK_AND_PTHREAD=yes fi @@ -9120,8 +9096,7 @@ $as_echo "#define HAVE_GTK_AND_PTHREAD 1" >>confdefs.h do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -9142,7 +9117,7 @@ if test "${with_dbus}" = "yes"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9237,7 +9212,7 @@ $as_echo "#define HAVE_DBUS 1" >>confdefs.h 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" = x""yes; then : +if test "x$ac_cv_func_dbus_watch_get_unix_fd" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_DBUS_WATCH_GET_UNIX_FD 1 _ACEOF @@ -9259,7 +9234,7 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9350,6 +9325,17 @@ $as_echo "no" >&6; } $as_echo "#define HAVE_GCONF 1" >>confdefs.h + for ac_func in g_type_init +do : + ac_fn_c_check_func "$LINENO" "g_type_init" "ac_cv_func_g_type_init" +if test "x$ac_cv_func_g_type_init" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_G_TYPE_INIT 1 +_ACEOF + +fi +done + fi fi @@ -9358,7 +9344,7 @@ LIBSELINUX_LIBS= 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 test "${ac_cv_lib_selinux_lgetfilecon+set}" = set; then : +if ${ac_cv_lib_selinux_lgetfilecon+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9392,7 +9378,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_selinux_lgetfilecon" = xyes; then : HAVE_LIBSELINUX=yes else HAVE_LIBSELINUX=no @@ -9416,7 +9402,7 @@ if test "${with_gnutls}" = "yes" ; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9518,7 +9504,7 @@ if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then 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 test "${emacs_cv_xaw3d+set}" = set; then : + if ${emacs_cv_xaw3d+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9560,7 +9546,7 @@ $as_echo "#define HAVE_XAW3D 1" >>confdefs.h $as_echo "no" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libXaw" >&5 $as_echo_n "checking for libXaw... " >&6; } - if test "${emacs_cv_xaw+set}" = set; then : + if ${emacs_cv_xaw+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9591,7 +9577,7 @@ $as_echo "yes; using Lucid toolkit" >&6; } USE_X_TOOLKIT=LUCID LUCID_LIBW=-lXaw elif test x"${USE_X_TOOLKIT}" = xLUCID; then - as_fn_error "Lucid toolkit requires X11/Xaw include files" "$LINENO" 5 + as_fn_error $? "Lucid toolkit requires X11/Xaw include files" "$LINENO" 5 else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no; do not use toolkit by default" >&5 $as_echo "no; do not use toolkit by default" >&6; } @@ -9606,7 +9592,7 @@ LIBXTR6= 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 test "${emacs_cv_x11_toolkit_version_6+set}" = set; then : + if ${emacs_cv_x11_toolkit_version_6+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9657,7 +9643,7 @@ $as_echo "before 6" >&6; } fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuConvertStandardSelection in -lXmu" >&5 $as_echo_n "checking for XmuConvertStandardSelection in -lXmu... " >&6; } -if test "${ac_cv_lib_Xmu_XmuConvertStandardSelection+set}" = set; then : +if ${ac_cv_lib_Xmu_XmuConvertStandardSelection+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9691,7 +9677,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBXMU 1 _ACEOF @@ -9705,8 +9691,8 @@ fi LIBXMU=-lXmu -case "$machine" in - ## These machines don't supply Xmu. +case $opsys in + ## These systems don't supply Xmu. hpux* | aix4-2 ) test "X$ac_cv_lib_Xmu_XmuConvertStandardSelection" != "Xyes" && LIBXMU= ;; @@ -9718,7 +9704,7 @@ if test "${HAVE_X11}" = "yes"; then 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 test "${ac_cv_lib_Xext_XShapeQueryExtension+set}" = set; then : +if ${ac_cv_lib_Xext_XShapeQueryExtension+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9752,7 +9738,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBXEXT 1 _ACEOF @@ -9768,7 +9754,7 @@ LIBXP= 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 test "${emacs_cv_motif_version_2_1+set}" = set; then : +if ${emacs_cv_motif_version_2_1+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9798,7 +9784,7 @@ $as_echo "$emacs_cv_motif_version_2_1" >&6; } 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 test "${ac_cv_lib_Xp_XpCreateContext+set}" = set; then : +if ${ac_cv_lib_Xp_XpCreateContext+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9832,14 +9818,14 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_Xp_XpCreateContext" = xyes; 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 test "${emacs_cv_lesstif+set}" = set; then : +if ${emacs_cv_lesstif+:} false; then : $as_echo_n "(cached) " >&6 else # We put this in CFLAGS temporarily to precede other -I options @@ -9998,7 +9984,7 @@ if test "${HAVE_X11}" = "yes"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10100,7 +10086,7 @@ $as_echo "no" >&6; } 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10192,7 +10178,7 @@ $as_echo "no" >&6; } 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 test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then : +if ${ac_cv_lib_Xrender_XRenderQueryExtension+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10226,7 +10212,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = xyes; then : HAVE_XRENDER=yes fi @@ -10239,10 +10225,10 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_X11_Xft_Xft_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5 $as_echo_n "checking for XftFontOpen in -lXft... " >&6; } -if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then : +if ${ac_cv_lib_Xft_XftFontOpen+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10276,7 +10262,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_Xft_XftFontOpen" = xyes; then : HAVE_XFT=yes fi @@ -10325,7 +10311,7 @@ $as_echo "#define HAVE_FREETYPE 1" >>confdefs.h 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10418,7 +10404,7 @@ $as_echo "#define HAVE_LIBOTF 1" >>confdefs.h { $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 test "${ac_cv_lib_otf_OTF_get_variation_glyphs+set}" = set; then : +if ${ac_cv_lib_otf_OTF_get_variation_glyphs+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10452,7 +10438,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = xyes; then : HAVE_OTF_GET_VARIATION_GLYPHS=yes else HAVE_OTF_GET_VARIATION_GLYPHS=no @@ -10477,7 +10463,7 @@ $as_echo "#define HAVE_OTF_GET_VARIATION_GLYPHS 1" >>confdefs.h 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10595,10 +10581,10 @@ LIBXPM= 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" = x""yes; then : +if test "x$ac_cv_header_X11_xpm_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToPixmap in -lXpm" >&5 $as_echo_n "checking for XpmReadFileToPixmap in -lXpm... " >&6; } -if test "${ac_cv_lib_Xpm_XpmReadFileToPixmap+set}" = set; then : +if ${ac_cv_lib_Xpm_XpmReadFileToPixmap+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10632,7 +10618,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = xyes; then : HAVE_XPM=yes fi @@ -10684,10 +10670,10 @@ LIBJPEG= 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" = x""yes; then : +if test "x$ac_cv_header_jerror_h" = xyes; 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 test "${ac_cv_lib_jpeg_jpeg_destroy_compress+set}" = set; then : +if ${ac_cv_lib_jpeg_jpeg_destroy_compress+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10721,7 +10707,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = xyes; then : HAVE_JPEG=yes fi @@ -10768,8 +10754,7 @@ if test "${HAVE_X11}" = "yes"; then do : as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -eval as_val=\$$as_ac_Header - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF @@ -10781,7 +10766,7 @@ done 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 test "${ac_cv_lib_png_png_get_channels+set}" = set; then : +if ${ac_cv_lib_png_png_get_channels+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10815,7 +10800,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_png_png_get_channels" = xyes; then : HAVE_PNG=yes fi @@ -10837,13 +10822,13 @@ LIBTIFF= 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" = x""yes; then : +if test "x$ac_cv_header_tiffio_h" = xyes; 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 test "${ac_cv_lib_tiff_TIFFGetVersion+set}" = set; then : +if ${ac_cv_lib_tiff_TIFFGetVersion+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10877,7 +10862,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_tiff_TIFFGetVersion" = xyes; then : HAVE_TIFF=yes fi @@ -10900,12 +10885,12 @@ HAVE_GIF=no 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" = x""yes; then : +if test "x$ac_cv_header_gif_lib_h" = xyes; 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 test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then : +if ${ac_cv_lib_gif_EGifPutExtensionLast+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10939,7 +10924,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = xyes; then : HAVE_GIF=yes else HAVE_GIF=maybe @@ -10955,7 +10940,7 @@ fi # 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 test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then : +if ${ac_cv_lib_ungif_EGifPutExtensionLast+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10989,7 +10974,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = xyes; then : HAVE_GIF=yes else HAVE_GIF=no @@ -11021,7 +11006,7 @@ if test "${HAVE_X11}" = "yes"; then MISSING="$MISSING libtiff" && WITH_NO="$WITH_NO --with-tiff=no" if test "X${MISSING}" != X; then - as_fn_error "The following required libraries were not found: + as_fn_error $? "The following required libraries were not found: $MISSING Maybe some development libraries/packages are missing? If you don't want to link with them give @@ -11036,10 +11021,10 @@ LIBGPM= 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" = x""yes; then : +if test "x$ac_cv_header_gpm_h" = xyes; 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 test "${ac_cv_lib_gpm_Gpm_Open+set}" = set; then : +if ${ac_cv_lib_gpm_Gpm_Open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11073,7 +11058,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_gpm_Gpm_Open" = xyes; then : HAVE_GPM=yes fi @@ -11093,7 +11078,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_malloc_malloc_h" = xyes; then : $as_echo "#define HAVE_MALLOC_MALLOC_H 1" >>confdefs.h @@ -11138,10 +11123,10 @@ HAVE_X_SM=no 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" = x""yes; then : +if test "x$ac_cv_header_X11_SM_SMlib_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SmcOpenConnection in -lSM" >&5 $as_echo_n "checking for SmcOpenConnection in -lSM... " >&6; } -if test "${ac_cv_lib_SM_SmcOpenConnection+set}" = set; then : +if ${ac_cv_lib_SM_SmcOpenConnection+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11175,7 +11160,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_SM_SmcOpenConnection" = xyes; then : HAVE_X_SM=yes fi @@ -11206,7 +11191,7 @@ if test "${with_xml2}" != "no"; then 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 test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -11297,7 +11282,7 @@ $as_echo "no" >&6; } 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 test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then : +if ${ac_cv_lib_xml2_htmlReadMemory+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11331,7 +11316,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_xml2_htmlReadMemory" = xyes; then : HAVE_LIBXML2=yes else HAVE_LIBXML2=no @@ -11353,7 +11338,7 @@ fi # 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 test "${emacs_cv_netdb_declares_h_errno+set}" = set; then : +if ${emacs_cv_netdb_declares_h_errno+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11383,11 +11368,22 @@ $as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h 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 test "${ac_cv_working_alloca_h+set}" = set; then : +if ${ac_cv_working_alloca_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11420,7 +11416,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 $as_echo_n "checking for alloca... " >&6; } -if test "${ac_cv_func_alloca_works+set}" = set; then : +if ${ac_cv_func_alloca_works+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11439,7 +11435,7 @@ else #pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ -char *alloca (); +void *alloca (size_t); # endif # endif # endif @@ -11483,7 +11479,7 @@ $as_echo "#define C_ALLOCA 1" >>confdefs.h { $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 test "${ac_cv_os_cray+set}" = set; then : +if ${ac_cv_os_cray+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11510,8 +11506,7 @@ if test $ac_cv_os_cray = yes; then for ac_func in _getb67 GETB67 getb67; do as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define CRAY_STACKSEG_END $ac_func @@ -11525,7 +11520,7 @@ fi { $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 test "${ac_cv_c_stack_direction+set}" = set; then : +if ${ac_cv_c_stack_direction+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -11575,14 +11570,14 @@ fi if test x"$ac_cv_func_alloca_works" != xyes; then - as_fn_error "a system implementation of alloca is required " "$LINENO" 5 + as_fn_error $? "a system implementation of alloca is required " "$LINENO" 5 fi # fmod, logb, and frexp are found in -lm on most systems. # 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 test "${ac_cv_lib_m_sqrt+set}" = set; then : +if ${ac_cv_lib_m_sqrt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11616,7 +11611,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_m_sqrt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF @@ -11630,7 +11625,7 @@ fi # 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 test "${ac_cv_lib_mail_maillock+set}" = set; then : +if ${ac_cv_lib_mail_maillock+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11664,7 +11659,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_mail_maillock" = xyes; then : have_mail=yes else have_mail=no @@ -11681,7 +11676,7 @@ else fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -llockfile" >&5 $as_echo_n "checking for maillock in -llockfile... " >&6; } -if test "${ac_cv_lib_lockfile_maillock+set}" = set; then : +if ${ac_cv_lib_lockfile_maillock+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11715,7 +11710,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_lockfile_maillock" = xyes; then : have_lockfile=yes else have_lockfile=no @@ -11735,7 +11730,7 @@ else 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 test "${ac_cv_prog_liblockfile+set}" = set; then : +if ${ac_cv_prog_liblockfile+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$liblockfile"; then @@ -11771,7 +11766,7 @@ fi if test $ac_cv_prog_liblockfile = yes; then - as_fn_error "Shared liblockfile found but can't link against it. + as_fn_error $? "Shared liblockfile found but can't link against it. This probably means that movemail could lose mail. There may be a \`development' package to install containing liblockfile." "$LINENO" 5 fi @@ -11779,7 +11774,7 @@ fi for ac_func in touchlock do : ac_fn_c_check_func "$LINENO" "touchlock" "ac_cv_func_touchlock" -if test "x$ac_cv_func_touchlock" = x""yes; then : +if test "x$ac_cv_func_touchlock" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_TOUCHLOCK 1 _ACEOF @@ -11790,7 +11785,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_header_maillock_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MAILLOCK_H 1 _ACEOF @@ -11860,8 +11855,7 @@ cfmakeraw cfsetspeed isnan copysign __executable_start do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -11873,7 +11867,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_header_sys_un_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_UN_H 1 _ACEOF @@ -11892,8 +11886,7 @@ done do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -11907,7 +11900,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mktime" >&5 $as_echo_n "checking for working mktime... " >&6; } -if test "${ac_cv_func_working_mktime+set}" = set; then : +if ${ac_cv_func_working_mktime+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -11945,8 +11938,8 @@ static time_t time_t_max; static time_t time_t_min; /* Values we'll use to set the TZ environment variable. */ -static char *tz_strings[] = { - (char *) 0, "TZ=GMT0", "TZ=JST-9", +static const char *tz_strings[] = { + (const char *) 0, "TZ=GMT0", "TZ=JST-9", "TZ=EST+3EDT+2,M10.1.0/00:00:00,M2.3.0/00:00:00" }; #define N_STRINGS (sizeof (tz_strings) / sizeof (tz_strings[0])) @@ -11963,7 +11956,7 @@ spring_forward_gap () instead of "TZ=America/Vancouver" in order to detect the bug even on systems that don't support the Olson extension, or don't have the full zoneinfo tables installed. */ - putenv ("TZ=PST8PDT,M4.1.0,M10.5.0"); + putenv ((char*) "TZ=PST8PDT,M4.1.0,M10.5.0"); tm.tm_year = 98; tm.tm_mon = 3; @@ -11976,16 +11969,14 @@ spring_forward_gap () } static int -mktime_test1 (now) - time_t now; +mktime_test1 (time_t now) { struct tm *lt; return ! (lt = localtime (&now)) || mktime (lt) == now; } static int -mktime_test (now) - time_t now; +mktime_test (time_t now) { return (mktime_test1 (now) && mktime_test1 ((time_t) (time_t_max - now)) @@ -12009,8 +12000,7 @@ irix_6_4_bug () } static int -bigtime_test (j) - int j; +bigtime_test (int j) { struct tm tm; time_t now; @@ -12054,7 +12044,7 @@ year_2050_test () instead of "TZ=America/Vancouver" in order to detect the bug even on systems that don't support the Olson extension, or don't have the full zoneinfo tables installed. */ - putenv ("TZ=PST8PDT,M4.1.0,M10.5.0"); + putenv ((char*) "TZ=PST8PDT,M4.1.0,M10.5.0"); t = mktime (&tm); @@ -12089,7 +12079,7 @@ main () for (i = 0; i < N_STRINGS; i++) { if (tz_strings[i]) - putenv (tz_strings[i]); + putenv ((char*) tz_strings[i]); for (t = 0; t <= time_t_max - delta; t += delta) if (! mktime_test (t)) @@ -12141,13 +12131,13 @@ ac_have_func=no # yes means we've found a way to get the load average. # Make sure getloadavg.c is where it belongs, at configure-time. test -f "$srcdir/$ac_config_libobj_dir/getloadavg.c" || - as_fn_error "$srcdir/$ac_config_libobj_dir/getloadavg.c is missing" "$LINENO" 5 + as_fn_error $? "$srcdir/$ac_config_libobj_dir/getloadavg.c is missing" "$LINENO" 5 ac_save_LIBS=$LIBS # 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" = x""yes; then : +if test "x$ac_cv_func_getloadavg" = xyes; then : exit 0 else exit 1 @@ -12158,7 +12148,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_func_pstat_getdynamic" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_PSTAT_GETDYNAMIC 1 _ACEOF @@ -12170,7 +12160,7 @@ done # 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 test "${ac_cv_lib_kstat_kstat_open+set}" = set; then : +if ${ac_cv_lib_kstat_kstat_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12204,7 +12194,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_kstat_kstat_open" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBKSTAT 1 _ACEOF @@ -12222,7 +12212,7 @@ test $ac_cv_lib_kstat_kstat_open = yes && ac_have_func=yes 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 test "${ac_cv_lib_elf_elf_begin+set}" = set; then : +if ${ac_cv_lib_elf_elf_begin+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12256,7 +12246,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_elf_elf_begin" = xyes; then : LIBS="-lelf $LIBS" fi @@ -12264,7 +12254,7 @@ fi 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 test "${ac_cv_lib_kvm_kvm_open+set}" = set; then : +if ${ac_cv_lib_kvm_kvm_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12298,14 +12288,14 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_kvm_kvm_open" = xyes; 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 test "${ac_cv_lib_util_getloadavg+set}" = set; then : +if ${ac_cv_lib_util_getloadavg+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12339,7 +12329,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_util_getloadavg" = xyes; then : LIBS="-lutil $LIBS" ac_have_func=yes ac_cv_func_getloadavg_setgid=yes fi @@ -12352,7 +12342,7 @@ if test $ac_have_func = no; then 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 test "${ac_cv_lib_getloadavg_getloadavg+set}" = set; then : +if ${ac_cv_lib_getloadavg_getloadavg+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12386,7 +12376,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_getloadavg_getloadavg" = xyes; then : LIBS="-lgetloadavg $LIBS" else LIBS=$ac_getloadavg_LIBS @@ -12399,7 +12389,7 @@ fi for ac_func in getloadavg do : ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = x""yes; then : +if test "x$ac_cv_func_getloadavg" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETLOADAVG 1 _ACEOF @@ -12417,14 +12407,14 @@ $as_echo "#define C_GETLOADAVG 1" >>confdefs.h # 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" = x""yes; then : +if test "x$ac_cv_header_sys_dg_sys_info_h" = xyes; 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 test "${ac_cv_lib_dgc_dg_sys_info+set}" = set; then : +if ${ac_cv_lib_dgc_dg_sys_info+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12458,7 +12448,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_dgc_dg_sys_info" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBDGC 1 _ACEOF @@ -12472,7 +12462,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_locale_h" = xyes; then : fi @@ -12480,7 +12470,7 @@ fi for ac_func in setlocale do : ac_fn_c_check_func "$LINENO" "setlocale" "ac_cv_func_setlocale" -if test "x$ac_cv_func_setlocale" = x""yes; then : +if test "x$ac_cv_func_setlocale" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SETLOCALE 1 _ACEOF @@ -12492,7 +12482,8 @@ done # 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; then +if test $ac_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ + && test "$ac_cv_lib_kvm_kvm_open" = yes; then ac_have_func=yes $as_echo "#define SVR4 1" >>confdefs.h @@ -12501,7 +12492,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_inq_stats_cpustats_h" = xyes; then : ac_have_func=yes $as_echo "#define UMAX 1" >>confdefs.h @@ -12516,7 +12507,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_sys_cpustats_h" = xyes; then : ac_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h fi @@ -12528,7 +12519,7 @@ if test $ac_have_func = no; then 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" = x""yes; then : +if test "x$ac_cv_header_mach_mach_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MACH_MACH_H 1 _ACEOF @@ -12542,13 +12533,13 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_nlist_h" = xyes; 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" = x""yes; then : +if test "x$ac_cv_member_struct_nlist_n_un_n_name" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_NLIST_N_UN_N_NAME 1 @@ -12571,7 +12562,7 @@ done # 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 test "${ac_cv_func_getloadavg_setgid+set}" = set; then : +if ${ac_cv_func_getloadavg_setgid+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -12604,7 +12595,7 @@ fi 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 test "${ac_cv_group_kmem+set}" = set; then : +if ${ac_cv_group_kmem+:} false; then : $as_echo_n "(cached) " >&6 else # On Solaris, /dev/kmem is a symlink. Get info on the real file. @@ -12632,7 +12623,7 @@ LIBS=$ac_save_LIBS { $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 test "${ac_cv_sys_largefile_source+set}" = set; then : +if ${ac_cv_sys_largefile_source+:} false; then : $as_echo_n "(cached) " >&6 else while :; do @@ -12725,7 +12716,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_getopt_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETOPT_H 1 _ACEOF @@ -12740,7 +12731,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_func_getopt_long_only" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETOPT_LONG_ONLY 1 _ACEOF @@ -12755,7 +12746,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_have_decl_optreset" = xyes; then : GETOPT_H=getopt.h fi @@ -12764,13 +12755,13 @@ fi 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 test "${gl_cv_func_gnu_getopt+set}" = set; then : +if ${gl_cv_func_gnu_getopt+:} false; 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" = x""yes; then : +if test "x$ac_cv_have_decl_getopt_clip" = xyes; then : gl_cv_func_gnu_getopt=no else gl_cv_func_gnu_getopt=yes @@ -12831,7 +12822,7 @@ fi { $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 test "${ac_cv_func_getpgrp_void+set}" = set; then : +if ${ac_cv_func_getpgrp_void+:} false; then : $as_echo_n "(cached) " >&6 else # Use it with a single arg. @@ -12866,7 +12857,7 @@ fi for ac_func in strftime do : ac_fn_c_check_func "$LINENO" "strftime" "ac_cv_func_strftime" -if test "x$ac_cv_func_strftime" = x""yes; then : +if test "x$ac_cv_func_strftime" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRFTIME 1 _ACEOF @@ -12875,7 +12866,7 @@ else # 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 test "${ac_cv_lib_intl_strftime+set}" = set; then : +if ${ac_cv_lib_intl_strftime+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12909,7 +12900,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_intl_strftime" = xyes; then : $as_echo "#define HAVE_STRFTIME 1" >>confdefs.h LIBS="-lintl $LIBS" @@ -12923,7 +12914,7 @@ done for ac_func in grantpt do : ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt" -if test "x$ac_cv_func_grantpt" = x""yes; then : +if test "x$ac_cv_func_grantpt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GRANTPT 1 _ACEOF @@ -12936,7 +12927,7 @@ done for ac_func in getpt do : ac_fn_c_check_func "$LINENO" "getpt" "ac_cv_func_getpt" -if test "x$ac_cv_func_getpt" = x""yes; then : +if test "x$ac_cv_func_getpt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETPT 1 _ACEOF @@ -12953,7 +12944,7 @@ done 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 test "${ac_cv_search_tputs+set}" = set; then : +if ${ac_cv_search_tputs+:} false; then : $as_echo_n "(cached) " >&6 else ac_func_search_save_LIBS=$LIBS @@ -12987,11 +12978,11 @@ for ac_lib in '' ncurses terminfo termcap; do fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext - if test "${ac_cv_search_tputs+set}" = set; then : + if ${ac_cv_search_tputs+:} false; then : break fi done -if test "${ac_cv_search_tputs+set}" = set; then : +if ${ac_cv_search_tputs+:} false; then : else ac_cv_search_tputs=no @@ -13010,7 +13001,7 @@ else fi if test "$have_tputs_et_al" != true; then - as_fn_error "I couldn't find termcap functions (tputs and friends). + as_fn_error $? "I couldn't find termcap functions (tputs and friends). Maybe some development libraries/packages are missing? Try installing libncurses-dev(el), libterminfo-dev(el) or similar." "$LINENO" 5 fi @@ -13050,7 +13041,7 @@ case "$opsys" in 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 test "${emacs_cv_freebsd_terminfo+set}" = set; then : + if ${emacs_cv_freebsd_terminfo+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -13192,16 +13183,16 @@ LIBHESIOD= 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" = x""yes; then : +if test "x$ac_cv_func_res_send" = xyes; then : else ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send" -if test "x$ac_cv_func___res_send" = x""yes; then : +if test "x$ac_cv_func___res_send" = xyes; 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 test "${ac_cv_lib_resolv_res_send+set}" = set; then : +if ${ac_cv_lib_resolv_res_send+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13235,12 +13226,12 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_resolv_res_send" = xyes; 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 test "${ac_cv_lib_resolv___res_send+set}" = set; then : +if ${ac_cv_lib_resolv___res_send+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13274,7 +13265,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_resolv___res_send" = xyes; then : resolv=yes fi @@ -13290,12 +13281,12 @@ fi RESOLVLIB= fi ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost" -if test "x$ac_cv_func_hes_getmailhost" = x""yes; then : +if test "x$ac_cv_func_hes_getmailhost" = xyes; 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 test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then : +if ${ac_cv_lib_hesiod_hes_getmailhost+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13329,7 +13320,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_hesiod_hes_getmailhost" = xyes; then : hesiod=yes else : @@ -13368,7 +13359,7 @@ KRB4LIB= 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 test "${ac_cv_lib_com_err_com_err+set}" = set; then : +if ${ac_cv_lib_com_err_com_err+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13402,7 +13393,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_com_err_com_err" = xyes; then : have_com_err=yes else have_com_err=no @@ -13417,7 +13408,7 @@ $as_echo "#define HAVE_LIBCOM_ERR 1" >>confdefs.h 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 test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_crypto_mit_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13451,7 +13442,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = xyes; then : have_crypto=yes else have_crypto=no @@ -13466,7 +13457,7 @@ $as_echo "#define HAVE_LIBCRYPTO 1" >>confdefs.h 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 test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13500,7 +13491,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = xyes; then : have_k5crypto=yes else have_k5crypto=no @@ -13515,7 +13506,7 @@ $as_echo "#define HAVE_LIBK5CRYPTO 1" >>confdefs.h 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 test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then : +if ${ac_cv_lib_krb5_krb5_init_context+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13549,7 +13540,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_krb5_krb5_init_context" = xyes; then : have_krb5=yes else have_krb5=no @@ -13565,7 +13556,7 @@ $as_echo "#define HAVE_LIBKRB5 1" >>confdefs.h 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 test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_des425_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13599,7 +13590,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_des425_des_cbc_encrypt" = xyes; then : have_des425=yes else have_des425=no @@ -13614,7 +13605,7 @@ $as_echo "#define HAVE_LIBDES425 1" >>confdefs.h 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 test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_des_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13648,7 +13639,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_des_des_cbc_encrypt" = xyes; then : have_des=yes else have_des=no @@ -13664,7 +13655,7 @@ $as_echo "#define HAVE_LIBDES 1" >>confdefs.h 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 test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then : +if ${ac_cv_lib_krb4_krb_get_cred+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13698,7 +13689,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_krb4_krb_get_cred" = xyes; then : have_krb4=yes else have_krb4=no @@ -13713,7 +13704,7 @@ $as_echo "#define HAVE_LIBKRB4 1" >>confdefs.h 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 test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then : +if ${ac_cv_lib_krb_krb_get_cred+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13747,7 +13738,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_krb_krb_get_cred" = xyes; then : have_krb=yes else have_krb=no @@ -13767,13 +13758,13 @@ $as_echo "#define HAVE_LIBKRB 1" >>confdefs.h 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" = x""yes; then : +if test "x$ac_cv_header_krb5_h" = xyes; 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" = x""yes; then : +if test "x$ac_cv_member_krb5_error_text" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_ERROR_TEXT 1 @@ -13783,7 +13774,7 @@ _ACEOF 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" = x""yes; then : +if test "x$ac_cv_member_krb5_error_e_text" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_ERROR_E_TEXT 1 @@ -13800,7 +13791,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_header_des_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_DES_H 1 _ACEOF @@ -13809,7 +13800,7 @@ else 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" = x""yes; then : +if test "x$ac_cv_header_kerberosIV_des_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROSIV_DES_H 1 _ACEOF @@ -13818,7 +13809,7 @@ else 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" = x""yes; then : +if test "x$ac_cv_header_kerberos_des_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROS_DES_H 1 _ACEOF @@ -13838,7 +13829,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_header_krb_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB_H 1 _ACEOF @@ -13847,7 +13838,7 @@ else 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" = x""yes; then : +if test "x$ac_cv_header_kerberosIV_krb_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROSIV_KRB_H 1 _ACEOF @@ -13856,7 +13847,7 @@ else 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" = x""yes; then : +if test "x$ac_cv_header_kerberos_krb_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROS_KRB_H 1 _ACEOF @@ -13877,7 +13868,7 @@ done 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" = x""yes; then : +if test "x$ac_cv_header_com_err_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_COM_ERR_H 1 _ACEOF @@ -13898,7 +13889,7 @@ fi # 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 test "${ac_cv_lib_intl_dgettext+set}" = set; then : +if ${ac_cv_lib_intl_dgettext+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13932,7 +13923,7 @@ LIBS=$ac_check_lib_save_LIBS 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" = x""yes; then : +if test "x$ac_cv_lib_intl_dgettext" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBINTL 1 _ACEOF @@ -13944,7 +13935,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5 $as_echo_n "checking whether localtime caches TZ... " >&6; } -if test "${emacs_cv_localtime_cache+set}" = set; then : +if ${emacs_cv_localtime_cache+:} false; then : $as_echo_n "(cached) " >&6 else if test x$ac_cv_func_tzset = xyes; then @@ -13955,14 +13946,6 @@ else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <time.h> -extern char **environ; -unset_TZ () -{ - char **from, **to; - for (to = from = environ; (*to = *from); from++) - if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '=')) - to++; -} char TZ_GMT0[] = "TZ=GMT0"; char TZ_PST8[] = "TZ=PST8"; main() @@ -13972,13 +13955,13 @@ main() if (putenv (TZ_GMT0) != 0) exit (1); hour_GMT0 = localtime (&now)->tm_hour; - unset_TZ (); + unsetenv("TZ"); hour_unset = localtime (&now)->tm_hour; if (putenv (TZ_PST8) != 0) exit (1); if (localtime (&now)->tm_hour == hour_GMT0) exit (1); - unset_TZ (); + unsetenv("TZ"); if (localtime (&now)->tm_hour != hour_unset) exit (1); exit (0); @@ -14011,7 +13994,7 @@ if test "x$HAVE_TIMEVAL" = xyes; then for ac_func in gettimeofday do : ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" -if test "x$ac_cv_func_gettimeofday" = x""yes; then : +if test "x$ac_cv_func_gettimeofday" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETTIMEOFDAY 1 _ACEOF @@ -14022,7 +14005,7 @@ done 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 test "${emacs_cv_gettimeofday_two_arguments+set}" = set; then : +if ${emacs_cv_gettimeofday_two_arguments+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14066,7 +14049,7 @@ fi ok_so_far=yes ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket" -if test "x$ac_cv_func_socket" = x""yes; then : +if test "x$ac_cv_func_socket" = xyes; then : else ok_so_far=no @@ -14074,7 +14057,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_netinet_in_h" = xyes; then : else ok_so_far=no @@ -14084,7 +14067,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_arpa_inet_h" = xyes; then : else ok_so_far=no @@ -14098,19 +14081,6 @@ $as_echo "#define HAVE_INET_SOCKETS 1" >>confdefs.h fi -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" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SYS_IOCTL_H 1 -_ACEOF - -fi - -done - - if test -f /usr/lpp/X11/bin/smt.exp; then $as_echo "#define HAVE_AIX_SMT_EXP 1" >>confdefs.h @@ -14131,7 +14101,7 @@ $as_echo "no" >&6; } 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" = x""yes; then : +if test "x$ac_cv_type_pid_t" = xyes; then : else @@ -14144,7 +14114,7 @@ fi 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" = x""yes; then : +if test "x$ac_cv_header_vfork_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_VFORK_H 1 _ACEOF @@ -14157,8 +14127,7 @@ for ac_func in fork vfork do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -eval as_val=\$$as_ac_var - if test "x$as_val" = x""yes; then : +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF #define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF @@ -14169,7 +14138,7 @@ done 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 test "${ac_cv_func_fork_works+set}" = set; then : +if ${ac_cv_func_fork_works+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -14222,7 +14191,7 @@ ac_cv_func_vfork_works=$ac_cv_func_vfork 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 test "${ac_cv_func_vfork_works+set}" = set; then : +if ${ac_cv_func_vfork_works+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -14358,7 +14327,7 @@ fi { $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 test "${emacs_cv_langinfo_codeset+set}" = set; then : +if ${emacs_cv_langinfo_codeset+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14390,7 +14359,7 @@ $as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h 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" = x""yes; then : +if test "x$ac_cv_type_size_t" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SIZE_T 1 @@ -14402,7 +14371,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5 $as_echo_n "checking for mbstate_t... " >&6; } -if test "${ac_cv_type_mbstate_t+set}" = set; then : +if ${ac_cv_type_mbstate_t+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14438,7 +14407,7 @@ $as_echo "#define mbstate_t int" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restrict keyword" >&5 $as_echo_n "checking for C restrict keyword... " >&6; } -if test "${emacs_cv_c_restrict+set}" = set; then : +if ${emacs_cv_c_restrict+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14492,7 +14461,7 @@ fi { $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 test "${emacs_cv_c_restrict_arr+set}" = set; then : +if ${emacs_cv_c_restrict_arr+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14532,14 +14501,14 @@ if test "x$GCC" = xyes \ && 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. version=`grep 'const char emacs_version' ${srcdir}/src/emacs.c \ | sed -e 's/^[^"]*"\([^"]*\)".*$/\1/'` if test x"${version}" = x; then - as_fn_error "can't find current emacs version in \`${srcdir}/src/emacs.c'." "$LINENO" 5 + as_fn_error $? "can't find current emacs version in \`${srcdir}/src/emacs.c'." "$LINENO" 5 fi if test x"${version}" != x"$PACKAGE_VERSION"; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: version mismatch between \`${srcdir}/configure.in' and \`${srcdir}/src/emacs.c'." >&5 @@ -14580,6 +14549,12 @@ fi ## Used in lwlib/Makefile.in. +if test -n "${machfile}"; then + M_FILE="\$(srcdir)/${machfile}" +else + M_FILE= +fi +S_FILE="\$(srcdir)/${opsysfile}" @@ -14600,11 +14575,13 @@ cat >>confdefs.h <<_ACEOF #define EMACS_CONFIG_OPTIONS "${ac_configure_args}" _ACEOF +if test -n "$machfile"; then cat >>confdefs.h <<_ACEOF #define config_machfile "${machfile}" _ACEOF +fi cat >>confdefs.h <<_ACEOF #define config_opsysfile "${opsysfile}" @@ -14880,16 +14857,18 @@ if test "x$GCC" = "xyes" && test "x$ORDINARY_LINK" != "xyes"; then gnu-*) ## armin76@gentoo.org reported that the lgcc_s flag is necessary to ## build on ARM EABI under GNU/Linux. (Bug#5518) - ## Note that m/arm.h never bothered to undefine LIB_GCC first. - if test "$machine" = "arm"; then + case $host_cpu in + arm*) LIB_GCC="-lgcc_s" - else + ;; + *) ## FIXME? s/gnu-linux.h used to define LIB_GCC as below, then ## immediately undefine it again and redefine it to empty. ## Was the C_SWITCH_X_SITE part really necessary? ## LIB_GCC=`$CC $C_SWITCH_X_SITE -print-libgcc-file-name` LIB_GCC= - fi + ;; + esac ;; ## Ask GCC where to find libgcc.a. @@ -14936,7 +14915,7 @@ Configured for \`${canonical}'. Where should the build process find the source code? ${srcdir} What operating system and machine description files should Emacs use? - \`${opsysfile}' and \`${machfile}' + \`${opsysfile}'${machfile:+ and \`${machfile}'} What compiler should emacs be built with? ${CC} ${CFLAGS} Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason} Should Emacs use a relocating allocator for buffers? ${REL_ALLOC} @@ -14968,7 +14947,7 @@ echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" -echo " Does Emacs use -lgnutls (BROKEN)? ${HAVE_GNUTLS}" +echo " Does Emacs use -lgnutls? ${HAVE_GNUTLS}" echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" @@ -15001,11 +14980,6 @@ to run if these resources are not installed." 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 && @@ -15081,10 +15055,21 @@ $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then - test "x$cache_file" != "x/dev/null" && + if test "x$cache_file" != "x/dev/null"; then { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} - cat confcache >$cache_file + 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 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;} @@ -15100,6 +15085,7 @@ DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= +U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' @@ -15116,7 +15102,7 @@ LTLIBOBJS=$ac_ltlibobjs -: ${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" @@ -15217,6 +15203,7 @@ fi 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 @@ -15262,19 +15249,19 @@ export LANGUAGE (unset CDPATH) >/dev/null 2>&1 && unset CDPATH -# as_fn_error ERROR [LINENO LOG_FD] -# --------------------------------- +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with status $?, using 1 if that was 0. +# script with STATUS, using 1 if that was 0. as_fn_error () { - as_status=$?; test $as_status -eq 0 && as_status=1 - if test "$3"; then - as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi - $as_echo "$as_me: error: $1" >&2 + $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error @@ -15470,7 +15457,7 @@ $as_echo X"$as_dir" | test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p @@ -15524,7 +15511,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by emacs $as_me 24.0.50, which was -generated by GNU Autoconf 2.65. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -15590,10 +15577,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 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.65, +configured by $0, generated by GNU Autoconf 2.68, with options \\"\$ac_cs_config\\" -Copyright (C) 2009 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -15609,11 +15596,16 @@ ac_need_defaults=: while test $# != 0 do case $1 in - --*=*) + --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; *) ac_option=$1 ac_optarg=$2 @@ -15635,6 +15627,7 @@ do $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; @@ -15647,7 +15640,7 @@ do ac_need_defaults=false;; --he | --h) # Conflict between --help and --header - as_fn_error "ambiguous option: \`$1' + as_fn_error $? "ambiguous option: \`$1' Try \`$0 --help' for more information.";; --help | --hel | -h ) $as_echo "$ac_cs_usage"; exit ;; @@ -15656,7 +15649,7 @@ Try \`$0 --help' for more information.";; ac_cs_silent=: ;; # This is an error. - -*) as_fn_error "unrecognized option: \`$1' + -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" @@ -15724,7 +15717,7 @@ do "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 @@ -15747,9 +15740,10 @@ fi # after its creation but before its name has been assigned to `$tmp'. $debug || { - tmp= + tmp= ac_tmp= trap 'exit_status=$? - { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } @@ -15757,12 +15751,13 @@ $debug || { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -n "$tmp" && test -d "$tmp" + test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") -} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5 +} || 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. @@ -15796,24 +15791,24 @@ if test "x$ac_cr" = x; then fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then - ac_cs_awk_cr='\r' + ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi -echo 'BEGIN {' >"$tmp/subs1.awk" && +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF # Create commands to substitute file output variables. { echo "cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1" && - echo 'cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&' && + echo 'cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&' && echo "$ac_subst_files" | sed 's/.*/F["&"]="$&"/' && echo "_ACAWK" && echo "_ACEOF" } >conf$$files.sh && . ./conf$$files.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 rm -f conf$$files.sh { @@ -15821,18 +15816,18 @@ rm -f conf$$files.sh echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 -ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then - as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi @@ -15840,7 +15835,7 @@ done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$tmp/subs1.awk" <<\\_ACAWK && +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h @@ -15888,7 +15883,7 @@ t delim rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK -cat >>"\$tmp/subs1.awk" <<_ACAWK && +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" \$ac_cs_awk_pipe_init @@ -15926,21 +15921,29 @@ if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat -fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ - || as_fn_error "could not setup config files machinery" "$LINENO" 5 +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF -# VPATH may cause trouble with some makes, so we remove $(srcdir), -# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=/{ -s/:*\$(srcdir):*/:/ -s/:*\${srcdir}:*/:/ -s/:*@srcdir@:*/:/ -s/^\([^=]*=[ ]*\):*/\1/ + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// s/^[^=]*=[ ]*$// }' fi @@ -15952,7 +15955,7 @@ fi # test -n "$CONFIG_FILES" # 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 >"$tmp/defines.awk" <<\_ACAWK || +cat >"$ac_tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF @@ -15964,11 +15967,11 @@ _ACEOF # handling of long lines. ac_delim='%!_!# ' for ac_last_try in false false :; do - ac_t=`sed -n "/$ac_delim/p" confdefs.h` - if test -z "$ac_t"; then + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then break elif $ac_last_try; then - as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5 + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi @@ -16053,7 +16056,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - as_fn_error "could not setup config headers machinery" "$LINENO" 5 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 fi # test -n "$CONFIG_HEADERS" @@ -16066,7 +16069,7 @@ do 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 @@ -16085,7 +16088,7 @@ do for ac_f do case $ac_f in - -) ac_f="$tmp/stdin";; + -) ac_f="$ac_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 `:'. @@ -16094,7 +16097,7 @@ do [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error "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'" @@ -16120,8 +16123,8 @@ $as_echo "$as_me: creating $ac_file" >&6;} esac case $ac_tag in - *:-:* | *:-) cat >"$tmp/stdin" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 ;; + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac @@ -16253,26 +16256,27 @@ $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | if $ac_cs_awk_getline; then - $AWK -f "$tmp/subs.awk" + $AWK -f "$ac_tmp/subs.awk" else - $AWK -f "$tmp/subs.awk" | $SHELL -fi >$tmp/out \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 + $AWK -f "$ac_tmp/subs.awk" | $SHELL +fi \ + >$ac_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' "$tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { 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"; } && { $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 +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;} +which seems to be undefined. Please make sure it is defined" >&2;} - rm -f "$tmp/stdin" + rm -f "$ac_tmp/stdin" case $ac_file in - -) cat "$tmp/out" && rm -f "$tmp/out";; - *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; :H) # @@ -16281,21 +16285,21 @@ which seems to be undefined. Please make sure it is defined." >&2;} if test x"$ac_file" != x-; then { $as_echo "/* $configure_input */" \ - && 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" "$tmp/config.h" >/dev/null 2>&1; then + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_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 { $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 "$tmp/config.h" "$ac_file" \ - || as_fn_error "could not create $ac_file" "$LINENO" 5 + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 fi else $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \ - || as_fn_error "could not create -" "$LINENO" 5 + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 fi ;; @@ -16332,7 +16336,7 @@ _ACEOF ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || - as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5 + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. @@ -16353,7 +16357,7 @@ if test "$no_create" != yes; then exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. - $ac_cs_success || as_fn_exit $? + $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 diff --git a/configure.in b/configure.in index 43c0513c22e..ed071b83475 100644 --- a/configure.in +++ b/configure.in @@ -412,13 +412,27 @@ dnl quotation begins machine='' opsys='' unported=no case "${canonical}" in + ## GNU/Linux ports + *-*-linux-gnu*) + opsys=gnu-linux + case ${canonical} in + alpha*) machine=alpha ;; + s390-*) machine=ibms390 ;; + s390x-*) machine=ibms390x ;; + powerpc*) machine=macppc ;; + sparc*) machine=sparc ;; + ia64*) machine=ia64 ;; + m68k*) machine=m68k ;; + x86_64*) machine=amdx86-64 ;; + esac + ;; + ## FreeBSD ports *-*-freebsd* ) opsys=freebsd case "${canonical}" in alpha*) machine=alpha ;; amd64-*|x86_64-*) machine=amdx86-64 ;; - arm*) machine=arm ;; ia64-*) machine=ia64 ;; i[3456]86-*) machine=intel386 ;; powerpc-*) machine=macppc ;; @@ -447,13 +461,9 @@ case "${canonical}" in case "${canonical}" in alpha*) machine=alpha ;; x86_64-*) machine=amdx86-64 ;; - arm-*) machine=arm ;; - hppa-*) machine=hp800 ;; i[3456]86-*) machine=intel386 ;; m68k-*) machine=m68k ;; powerpc-*) machine=macppc ;; - mips-*) machine=mips ;; - mipse[bl]-*) machine=mips ;; sparc*-) machine=sparc ;; vax-*) machine=vax ;; esac @@ -465,8 +475,6 @@ case "${canonical}" in case "${canonical}" in alpha*) machine=alpha ;; x86_64-*) machine=amdx86-64 ;; - arm-*) machine=arm ;; - hppa-*) machine=hp800 ;; i386-*) machine=intel386 ;; powerpc-*) machine=macppc ;; sparc*) machine=sparc ;; @@ -474,14 +482,6 @@ case "${canonical}" in esac ;; - alpha*-*-linux-gnu* ) - machine=alpha opsys=gnu-linux - ;; - - arm*-*-linux-gnu* ) - machine=arm opsys=gnu-linux - ;; - ## Apple Darwin / Mac OS X *-apple-darwin* ) case "${canonical}" in @@ -503,24 +503,14 @@ case "${canonical}" in ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux10.2* ) - machine=hp800 opsys=hpux10-20 + opsys=hpux10-20 ;; hppa*-hp-hpux1[1-9]* ) - machine=hp800 opsys=hpux11 + opsys=hpux11 CFLAGS="-D_INCLUDE__STDC_A1_SOURCE $CFLAGS" ;; - hppa*-*-linux-gnu* ) - machine=hp800 opsys=gnu-linux - ;; - ## IBM machines - s390-*-linux-gnu* ) - machine=ibms390 opsys=gnu-linux - ;; - s390x-*-linux-gnu* ) - machine=ibms390x opsys=gnu-linux - ;; rs6000-ibm-aix4.[23]* ) machine=ibmrs6000 opsys=aix4-2 ;; @@ -534,11 +524,6 @@ case "${canonical}" in machine=ibmrs6000 opsys=aix4-2 ;; - ## Macintosh PowerPC - powerpc*-*-linux-gnu* ) - machine=macppc opsys=gnu-linux - ;; - ## Silicon Graphics machines ## Iris 4D mips-sgi-irix6.5 ) @@ -551,10 +536,6 @@ case "${canonical}" in ;; ## Suns - sparc-*-linux-gnu* | sparc64-*-linux-gnu* ) - machine=sparc opsys=gnu-linux - ;; - *-sun-solaris* \ | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \ | x86_64-*-solaris2* | x86_64-*-sunos5*) @@ -594,11 +575,6 @@ case "${canonical}" in esac ;; - ## IA-64 - ia64*-*-linux* ) - machine=ia64 opsys=gnu-linux - ;; - ## Intel 386 machines where we don't care about the manufacturer. i[3456]86-*-* ) machine=intel386 @@ -607,7 +583,6 @@ case "${canonical}" in *-darwin* ) opsys=darwin CPP="${CC-cc} -E -no-cpp-precomp" ;; - *-linux-gnu* ) opsys=gnu-linux ;; *-sysv4.2uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;; *-sysv5uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;; *-sysv5OpenUNIX* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;; @@ -615,32 +590,6 @@ case "${canonical}" in esac ;; - ## m68k Linux-based GNU system - m68k-*-linux-gnu* ) - machine=m68k opsys=gnu-linux - ;; - - ## Mips Linux-based GNU system - mips-*-linux-gnu* | mipsel-*-linux-gnu* \ - | mips64-*-linux-gnu* | mips64el-*-linux-gnu* ) - machine=mips opsys=gnu-linux - ;; - - ## AMD x86-64 Linux-based GNU system - x86_64-*-linux-gnu* ) - machine=amdx86-64 opsys=gnu-linux - ;; - - ## Tensilica Xtensa Linux-based GNU system - xtensa*-*-linux-gnu* ) - machine=xtensa opsys=gnu-linux - ;; - - ## SuperH Linux-based GNU system - sh[34]*-*-linux-gnu* ) - machine=sh3 opsys=gnu-linux - ;; - * ) unported=yes ;; @@ -669,7 +618,11 @@ if test $unported = yes; then Check `etc/MACHINES' for recognized configuration names.]) fi -machfile="m/${machine}.h" +if test -n "$machine"; then + machfile="m/${machine}.h" +else + machfile= +fi opsysfile="s/${opsys}.h" @@ -869,7 +822,7 @@ else fi AC_MSG_CHECKING([for -znocombreloc]) -AC_LINK_IFELSE([main(){return 0;}], +AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], [AC_MSG_RESULT(yes)], LDFLAGS=$late_LDFLAGS [AC_MSG_RESULT(no)]) @@ -936,7 +889,7 @@ case "$opsys" in gnu-linux) ## cpp test was "ifdef __mips__", but presumably this is equivalent... - test "$machine" = "mips" && LD_SWITCH_SYSTEM="-G 0" + case $host_cpu in mips*) LD_SWITCH_SYSTEM="-G 0";; esac ;; netbsd) @@ -1218,10 +1171,10 @@ if test "${with_sound}" != "no"; then 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) @@ -1498,7 +1451,7 @@ if test "${with_ns}" != no; then elif test -f $GNUSTEP_CONFIG_FILE; then NS_IMPL_GNUSTEP=yes ns_appdir=`pwd`/nextstep/Emacs.app - ns_appbindir=${ns_appdir} + ns_appbindir=${ns_appdir}/ ns_appresdir=${ns_appdir}/Resources ns_appsrc=${srcdir}/nextstep/GNUstep/Emacs.base dnl FIXME sourcing this several times in subshells seems inefficient. @@ -1982,6 +1935,8 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then PKG_CHECK_MODULES(GCONF, gconf-2.0 >= 2.13, HAVE_GCONF=yes, HAVE_GCONF=no) if test "$HAVE_GCONF" = yes; then AC_DEFINE(HAVE_GCONF, 1, [Define to 1 if using GConf.]) + dnl Newer GConf doesn't link with g_objects, so this is not defined. + AC_CHECK_FUNCS([g_type_init]) fi fi @@ -2095,8 +2050,8 @@ AC_SUBST(LIBXTR6) dnl FIXME the logic here seems weird, but this is what cpp was doing. dnl Why not just test for libxmu in the normal way? LIBXMU=-lXmu -case "$machine" in - ## These machines don't supply Xmu. +case $opsys in + ## These systems don't supply Xmu. hpux* | aix4-2 ) test "X$ac_cv_lib_Xmu_XmuConvertStandardSelection" != "Xyes" && LIBXMU= ;; @@ -2952,14 +2907,6 @@ AC_MSG_CHECKING(whether localtime caches TZ) AC_CACHE_VAL(emacs_cv_localtime_cache, [if test x$ac_cv_func_tzset = xyes; then AC_TRY_RUN([#include <time.h> -extern char **environ; -unset_TZ () -{ - char **from, **to; - for (to = from = environ; (*to = *from); from++) - if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '=')) - to++; -} char TZ_GMT0[] = "TZ=GMT0"; char TZ_PST8[] = "TZ=PST8"; main() @@ -2969,13 +2916,13 @@ main() if (putenv (TZ_GMT0) != 0) exit (1); hour_GMT0 = localtime (&now)->tm_hour; - unset_TZ (); + unsetenv("TZ"); hour_unset = localtime (&now)->tm_hour; if (putenv (TZ_PST8) != 0) exit (1); if (localtime (&now)->tm_hour == hour_GMT0) exit (1); - unset_TZ (); + unsetenv("TZ"); if (localtime (&now)->tm_hour != hour_unset) exit (1); exit (0); @@ -3034,8 +2981,6 @@ dnl Fixme: Not used. Should this be HAVE_SOCKETS? [Define to 1 if you have inet sockets.]) fi -AC_CHECK_HEADERS(sys/ioctl.h) - if test -f /usr/lpp/X11/bin/smt.exp; then AC_DEFINE(HAVE_AIX_SMT_EXP, 1, [Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists.]) @@ -3163,8 +3108,14 @@ AC_SUBST(C_SWITCH_X_SYSTEM) AC_SUBST(CFLAGS) ## Used in lwlib/Makefile.in. AC_SUBST(X_TOOLKIT_TYPE) -AC_SUBST(machfile) -AC_SUBST(opsysfile) +if test -n "${machfile}"; then + M_FILE="\$(srcdir)/${machfile}" +else + M_FILE= +fi +S_FILE="\$(srcdir)/${opsysfile}" +AC_SUBST(M_FILE) +AC_SUBST(S_FILE) AC_SUBST(GETLOADAVG_LIBS) AC_SUBST(ns_appdir) AC_SUBST(ns_appbindir) @@ -3177,8 +3128,10 @@ AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "${canonical}", [Define to the canonical Emacs configuration name.]) AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "${ac_configure_args}", [Define to the options passed to configure.]) -AC_DEFINE_UNQUOTED(config_machfile, "${machfile}", - [Define to the used machine dependent file.]) +if test -n "$machfile"; then + AC_DEFINE_UNQUOTED(config_machfile, "${machfile}", + [Define to the used machine dependent file.]) +fi AC_DEFINE_UNQUOTED(config_opsysfile, "${opsysfile}", [Define to the used os dependent file.]) @@ -3442,16 +3395,18 @@ if test "x$GCC" = "xyes" && test "x$ORDINARY_LINK" != "xyes"; then gnu-*) ## armin76@gentoo.org reported that the lgcc_s flag is necessary to ## build on ARM EABI under GNU/Linux. (Bug#5518) - ## Note that m/arm.h never bothered to undefine LIB_GCC first. - if test "$machine" = "arm"; then + case $host_cpu in + arm*) LIB_GCC="-lgcc_s" - else + ;; + *) ## FIXME? s/gnu-linux.h used to define LIB_GCC as below, then ## immediately undefine it again and redefine it to empty. ## Was the C_SWITCH_X_SITE part really necessary? ## LIB_GCC=`$CC $C_SWITCH_X_SITE -print-libgcc-file-name` LIB_GCC= - fi + ;; + esac ;; ## Ask GCC where to find libgcc.a. @@ -3517,7 +3472,7 @@ AH_BOTTOM([ /* Don't try to switch on inline handling as detected by AC_C_INLINE generally, because even if non-gcc compilers accept `inline', they may reject `extern inline'. */ -#if defined (__GNUC__) && defined (OPTIMIZE) +#if defined (__GNUC__) #define INLINE __inline__ #else #define INLINE @@ -3533,7 +3488,9 @@ AH_BOTTOM([ /* Include the os and machine dependent files. */ #include config_opsysfile -#include config_machfile +#ifdef config_machfile +# include config_machfile +#endif /* GNUstep needs a bit more pure memory. Of the existing knobs, SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. @@ -3641,6 +3598,12 @@ typedef unsigned size_t; #define NO_INLINE #endif +#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1)) +#define EXTERNALLY_VISIBLE __attribute__((externally_visible)) +#else +#define EXTERNALLY_VISIBLE +#endif + /* Some versions of GNU/Linux define noinline in their headers. */ #ifdef noinline #undef noinline @@ -3680,7 +3643,7 @@ Configured for \`${canonical}'. Where should the build process find the source code? ${srcdir} What operating system and machine description files should Emacs use? - \`${opsysfile}' and \`${machfile}' + \`${opsysfile}'${machfile:+ and \`${machfile}'} What compiler should emacs be built with? ${CC} ${CFLAGS} Should Emacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason} Should Emacs use a relocating allocator for buffers? ${REL_ALLOC} @@ -3712,7 +3675,7 @@ echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" -echo " Does Emacs use -lgnutls (BROKEN)? ${HAVE_GNUTLS}" +echo " Does Emacs use -lgnutls? ${HAVE_GNUTLS}" echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" @@ -3745,11 +3708,6 @@ to run if these resources are not installed." 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 && diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index e8496be1146..f5920428de8 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,52 @@ +2010-11-27 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> + + * maintaining.texi (VC With A Locking VCS, VC Directory Commands): + * vc1-xtra.texi (Customizing VC, General VC Options): Small fixes. + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * maintaining.texi (Version Control Systems): Fix repeated sentence. + Suggested by Å tÄ›pán NÄ›mec. + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * maintaining.texi (Version Control): Say "commit", not "check in". + (Version Control Systems): Simplify descriptions. + (VCS Merging, VCS Changesets, VCS Repositories): New nodes, split from + VCS Concepts. + (VC Mode Line): Update example. + (Old Revisions): Document revert-buffer for vc-diff. + (Log Buffer): Promote to a subsection. Document header lines. + + * macos.texi (Mac / GNUstep Basics): Document + ns-right-alternate-modifier. + + * emacs.texi (Top): Update node listing. + +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. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index a4751e7f99d..35c41a01097 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -537,6 +537,8 @@ Toggle automatic display of the current line number or column number. 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 @@ additional times, to delete a total of 80 characters, by typing @kbd{C-x 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 diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 3b5e7b0b955..cd08a524f50 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1136,6 +1136,48 @@ prefix these characters with an escape character. 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 diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 1ece1ea6dd8..65a565dbe8e 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -771,6 +771,7 @@ Version Control * Introduction to VC:: How version control works in general. * VC Mode Line:: How the mode line shows version control status. * Basic VC Editing:: How to edit a file under version control. +* Log Buffer:: Features available in log entry buffers. * Old Revisions:: Examining and comparing old versions. * Secondary VC Commands:: The commands used a little less frequently. * VC Directory Mode:: Listing files managed by version control. @@ -785,6 +786,9 @@ Introduction to Version Control * Why Version Control?:: Understanding the problems it addresses. * Version Control Systems:: Supported version control back-end systems. * VCS Concepts:: Words and concepts related to version control. +* VCS Merging:: How file conflicts are handled. +* VCS Changesets:: Changesets in version control. +* VCS Repositories:: Where version control repositories are stored. * Types of Log File:: The VCS log in contrast to the ChangeLog. Basic Editing under Version Control @@ -792,7 +796,6 @@ Basic Editing under Version Control * VC With A Merging VCS:: Without locking: default mode for CVS. * VC With A Locking VCS:: RCS in its default mode, SCCS, and optionally CVS. * Advanced C-x v v:: Advanced features available with a prefix argument. -* Log Buffer:: Features available in log entry buffers. The Secondary Commands of VC diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index 6fa5666ba6f..044a722a07a 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -8,23 +8,22 @@ @cindex Macintosh @cindex GNUstep - This section briefly describes the peculiarities of using Emacs built with -the GNUstep libraries on GNU/Linux or other operating systems, or on Mac OS X -with native window system support. For Mac OS X, Emacs can be built either -without window system support, with X11, or with the Cocoa interface. This -section only applies to the Cocoa build. Emacs 23 does not support Mac OS -Classic. - - Emacs, when built on Mac OS X, uses the Cocoa application interface. For -various historical and technical reasons, Emacs uses the term @samp{Nextstep} -internally, instead of ``Cocoa'' or ``Mac OS X''; for instance, most of the -commands and variables described in the following sections begin with -@samp{ns-}, which is short for @samp{Nextstep}. NeXTstep was an application -interface released by NeXT Inc during the 1980s, of which Cocoa is a direct -descendant. Apart from Cocoa, there is another NeXTstep-style system: -GNUstep, which is free software. As of this writing, the GNUstep support is -alpha status (@pxref{GNUstep Support}), but we hope to improve it in the -future. + This section describes the peculiarities of using Emacs built with +the GNUstep libraries on GNU/Linux or other operating systems, or on +Mac OS X with native window system support. On Mac OS X, Emacs can be +built either without window system support, with X11, or with the +Cocoa interface; this section only applies to the Cocoa build. Emacs +does not support earlier versions of Mac OS. + + For various historical and technical reasons, Emacs uses the term +@samp{Nextstep} internally, instead of ``Cocoa'' or ``Mac OS X''; for +instance, most of the commands and variables described in this section +begin with @samp{ns-}, which is short for @samp{Nextstep}. NeXTstep +was an application interface released by NeXT Inc during the 1980s, of +which Cocoa is a direct descendant. Apart from Cocoa, there is +another NeXTstep-style system: GNUstep, which is free software. As of +this writing, the GNUstep support is alpha status (@pxref{GNUstep +Support}), but we hope to improve it in the future. @menu * Mac / GNUstep Basics:: Basic Emacs usage under GNUstep or Mac OS. @@ -37,19 +36,24 @@ future. @section Basic Emacs usage under Mac OS and GNUstep By default, the @key{alt} and @key{option} keys are the same as -@key{Meta} when running under Mac OS. The Mac @key{Cmd} key is the -same as @key{Super}, and Emacs provides a set of keybindings using -this modifier key that mimic other Mac / GNUstep applications (@pxref{Mac / -GNUstep Events}). You can change these bindings in the usual way (@pxref{Key -Bindings}). - - The standard Mac / GNUstep font and color panels are accessible via Lisp commands. - To use the color panel, drag from it to an Emacs frame to change the -foreground color of the face at that position (if the @key{shift} key -is held down, it changes the background color instead). To discard the -settings, create a new frame and close the altered one. -@c [unclear if the following holds.] -@c To finalize the settings for either color or font, choose @samp{Save Options} in the @samp{Options} menu. +@key{Meta}. The Mac @key{Cmd} key is the same as @key{Super}, and +Emacs provides a set of keybindings using this modifier key that mimic +other Mac / GNUstep applications (@pxref{Mac / GNUstep Events}). You +can change these bindings in the usual way (@pxref{Key Bindings}). + + The variable @code{ns-right-alternate-modifier} controls the +behavior of the right @key{alt} and @key{option} keys. These keys +behave like the left-hand keys if the value is @code{left} (the +default). A value of @code{control}, @code{meta}, @code{alt}, +@code{super}, or @code{hyper} makes them behave like the corresponding +modifier keys; a value of @code{none} tells Emacs to ignore them. + + The standard Mac / GNUstep font and color panels are accessible via +Lisp commands. To use the color panel, drag from it to an Emacs frame +to change the foreground color of the face at that position (if the +@key{shift} key is held down, it changes the background color +instead). To discard the settings, create a new frame and close the +altered one. @key{S-Mouse-1} (i.e., clicking the left mouse button while holding down the @key{Shift} key) adjusts the region to the @@ -58,7 +62,7 @@ it does not pop up a menu for changing the default face, as @key{S-Mouse-1} normally does (@pxref{Temporary Face Changes}). This change makes Emacs behave more like other Mac / GNUstep applications. - When you open or save files using the menus, or using the + When you open or save files using the menus, or using the @key{Cmd-o} and @key{Cmd-S} bindings, Emacs uses graphical file dialogs to read file names. However, if you use the regular Emacs key sequences, such as @key{C-x C-f}, Emacs uses the minibuffer to read @@ -110,7 +114,7 @@ dragging will alter the foreground color. Shift dragging will alter the background color. @c To make the changes permanent select the "Save Options" -@c item in the "Options" menu, or run @code{menu-bar-options-save}. +@c item in the "Options" menu, or run @code{menu-bar-options-save}. Useful in this context is the listing of all faces obtained by @key{M-x} @code{list-faces-display}. @@ -193,7 +197,7 @@ font are stored in the variables @code{ns-input-font} and @code{ns-input-fontsize}, respectively. @item ns-power-off -This event occurs when the user logs out and Emacs is still running, or when +This event occurs when the user logs out and Emacs is still running, or when `Quit Emacs' is chosen from the application menu. The default behavior is to save all file-visiting buffers. @end table @@ -208,26 +212,9 @@ and return the result as a string. You can also use the Lisp function services and receive the results back. Note that you may need to restart Emacs to access newly-available services. - @node GNUstep Support, , Mac / GNUstep Events, Mac OS / GNUstep @section GNUstep Support -Emacs can be built and run under GNUstep, however there are still some +Emacs can be built and run under GNUstep, but there are still some issues to be addressed. Interested developers should contact @email{emacs-devel@@gnu.org}. - -@c Presumably no longer relevant since CANNOT_DUMP removed 2009-05-06: -@ignore -In particular, it may be necessary to run @samp{make bootstrap} with a -plain X configuration, then @samp{make clean} and @samp{./configure ---with-ns} followed by @samp{make install}. - -Currently CANNOT_DUMP is automatically enabled in GNUstep configurations, -because the unex file(s) for GNUstep, mainly @samp{unexelf.c}, have not been -updated yet with the ``zone'' code in and related to @samp{unexmacosx.c}. -@end ignore - - -@ignore - arch-tag: a822c2ab-4273-4997-927e-c153bb71dcf6 -@end ignore diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index b407f5b9c99..cf504b6be2a 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -24,20 +24,20 @@ programs. @section Version Control @cindex version control - A @dfn{version control system} is a package that can record multiple + A @dfn{version control system} is a program that can record multiple versions of a source file, storing information such as the creation -time of each version, who created it, and a description of what was -changed in that version. - - The Emacs version control interface is called VC. Its commands work -with several different version control systems; currently, it supports -GNU Arch, Bazaar, CVS, Git, Mercurial, Monotone, RCS, SCCS/CSSC, and -Subversion. Of these, the GNU project distributes CVS, GNU Arch, RCS, -and Bazaar. - - VC is enabled automatically whenever you visit a file that is -governed by a version control system. To disable VC entirely, set the -customizable variable @code{vc-handled-backends} to @code{nil} +time of each version, who made it, and a description of what was +changed. + + The Emacs version control interface is called @dfn{VC}. VC commands +work with several different version control systems; currently, it +supports GNU Arch, Bazaar, CVS, Git, Mercurial, Monotone, RCS, +SCCS/CSSC, and Subversion. Of these, the GNU project distributes CVS, +Arch, RCS, and Bazaar. + + VC is enabled automatically whenever you visit a file governed by a +version control system. To disable VC entirely, set the customizable +variable @code{vc-handled-backends} to @code{nil} @iftex (@pxref{Customizing VC,,,emacs-xtra, Specialized Emacs Features}). @end iftex @@ -49,6 +49,7 @@ customizable variable @code{vc-handled-backends} to @code{nil} * Introduction to VC:: How version control works in general. * VC Mode Line:: How the mode line shows version control status. * Basic VC Editing:: How to edit a file under version control. +* Log Buffer:: Features available in log entry buffers. * Old Revisions:: Examining and comparing old versions. * Secondary VC Commands:: The commands used a little less frequently. * VC Directory Mode:: Listing files managed by version control. @@ -65,12 +66,13 @@ customizable variable @code{vc-handled-backends} to @code{nil} @subsection Introduction to Version Control VC allows you to use a version control system from within Emacs, -integrating the version control operations smoothly with editing. -Though VC cannot completely bridge the gaps between version control -systems with widely differing capabilities, it does provide a uniform -interface to many version control operations. Regardless of which -version control system is in use, you will be able to do basic -operations in much the same way. +integrating the version control operations smoothly with editing. It +provides a uniform interface for common operations in many version +control operations. + + Some uncommon or intricate version control operations, such as +altering repository settings, are not supported in VC. You should +perform such tasks outside Emacs, e.g. via the command line. This section provides a general overview of version control, and describes the version control systems that VC supports. You can skip @@ -81,6 +83,9 @@ you want to use. * Why Version Control?:: Understanding the problems it addresses. * Version Control Systems:: Supported version control back-end systems. * VCS Concepts:: Words and concepts related to version control. +* VCS Merging:: How file conflicts are handled. +* VCS Changesets:: How changes are grouped. +* VCS Repositories:: Where version control repositories are stored. * Types of Log File:: The VCS log in contrast to the ChangeLog. @end menu @@ -112,8 +117,8 @@ vitally important form of communication among developers. @subsubsection Supported Version Control Systems @cindex back end (version control) - VC currently works with many different version control systems or -@dfn{back ends}: + VC currently works with many different version control systems, +which it refers to as @dfn{back ends}: @itemize @bullet @@ -134,73 +139,60 @@ control system. @cindex RCS @item RCS is the free version control system around which VC was initially -built. Almost everything you can do with RCS can be done through VC. -However, you cannot use RCS over the network, and it only works at the -level of individual files rather than projects. +built. It is relatively primitive: it cannot be used over the +network, and works at the level of individual files. Almost +everything you can do with RCS can be done through VC. @cindex CVS @item CVS is the free version control system that was, until recently (circa 2008), used by the majority of free software projects. Nowadays, it is slowly being superseded by newer systems. CVS allows concurrent -multi-user development either locally or over the network. It lacks -support for atomic commits or file moving/renaming. VC supports all -basic editing operations under CVS. For some less common tasks, you -still need to call CVS from the command line. Note also that before -using CVS you must set up a repository, which is a subject too complex -to treat here. +multi-user development either locally or over the network. Unlike +newer systems, it lacks support for atomic commits and file +moving/renaming. VC supports all basic editing operations under CVS. @cindex SVN @cindex Subversion @item Subversion (SVN) is a free version control system designed to be -similar to CVS but without its problems. It supports atomic commits -of filesets, and versioning of directories, symbolic links, meta-data, -renames, copies, and deletes. +similar to CVS but without its problems (e.g., it supports atomic +commits of filesets, and versioning of directories, symbolic links, +meta-data, renames, copies, and deletes). @cindex GNU Arch @cindex Arch @item -GNU Arch is a version control system designed for distributed work. -It differs in many ways from older systems like CVS and RCS. It -provides different methods for interoperating between users, support -for offline operations, and good branching and merging features. It -also supports atomic commits of filesets and file moving/renaming. VC -does not support all operations provided by GNU Arch, so you must -sometimes invoke it from the command line. +GNU Arch is one of the earliest @dfn{distributed} version control +systems (the other being Monotone). @xref{VCS Concepts}, for a +description of distributed version control systems. It is no longer +under active development, and has been deprecated in favor of Bazaar. @cindex git @item -Git is a distributed version control system invented by Linus Torvalds to support -development of Linux (his kernel). It supports atomic commits of filesets and -file moving/renaming. One significant feature of git is that it -largely abolishes the notion of a single centralized repository; -instead, each working copy of a git project is its own repository and -coordination is done through repository-sync operations. VC supports -most git operations, with the exception of news merges and repository -syncing; these must be done from the command line. +Git is a distributed version control system originally invented by +Linus Torvalds to support development of Linux (his kernel). VC +supports many common git operations, but others, such as repository +syncing, must be done from the command line. @cindex hg @cindex Mercurial @item Mercurial (hg) is a distributed version control system broadly -resembling GNU Arch and git, with atomic fileset commits and file -moving/renaming. Like git, it is fully decentralized. VC supports -most Mercurial commands, with the exception of repository sync -operations; this needs to be done from the command line. +resembling git. VC supports most Mercurial commands, with the +exception of repository sync operations. @cindex bzr @cindex Bazaar @item -Bazaar (bzr) is a distributed version control system that supports both -repository-based and distributed versioning, with atomic fileset -commits and file moving/renaming. VC supports most basic editing -operations under Bazaar. +Bazaar (bzr) is a distributed version control system that supports +both repository-based and distributed versioning. VC supports most +basic editing operations under Bazaar. @end itemize Previous versions of VC supported a version control system known as -Meta-CVS. This support has been dropped because of limited interest -from users and developers. +Meta-CVS. This support was dropped due to limited interest from users +and developers. @node VCS Concepts @subsubsection Concepts of Version Control @@ -216,11 +208,11 @@ as @dfn{log entries} that describe the changes made to each file. @cindex work file @cindex checking out files - A file @dfn{checked out} of a repository is called the @dfn{work -file}. You edit the work file and make changes in it, as you would -with an ordinary file. After you are done with a set of changes, you -@dfn{check in} or @dfn{commit} the file; this records the changes in -the repository, along with a log entry for those changes. + The copy of a version-controlled file that you actually edit is +called the @dfn{work file}. You can change each work file as you +would an ordinary file. After you are done with a set of changes, you +@dfn{commit} (or @dfn{check in}) the changes; this records the changes +in the repository, along with a descriptive log entry. @cindex revision @cindex revision ID @@ -231,12 +223,15 @@ on the version control system; in the simplest case, it is just an integer. To go beyond these basic concepts, you will need to understand three -aspects in which version control systems differ. -They can be locking-based or merging-based; they can be file-based or -changeset-based; and they can be centralized or decentralized. VC -handles all these modes of operation, but it cannot hide the differences. +aspects in which version control systems differ. As explained in the +next three sections, they can be lock-based or merge-based; file-based +or changeset-based; and centralized or decentralized. VC handles all +these modes of operation, but it cannot hide the differences. +@node VCS Merging +@subsubsection Merge-based vs lock-based Version Control @cindex locking versus merging + A version control system typically has some mechanism to coordinate between users who want to change the same file. There are two ways to do this: merging and locking. @@ -244,8 +239,7 @@ do this: merging and locking. In a version control system that uses merging, each user may check out and modify a work file at any time. The system lets you @dfn{merge} your work file, which may contain changes that have not -been checked in, with the latest changes that others have checked into -the repository. +been committed, with the latest changes that others have committed. Older version control systems use a @dfn{locking} scheme instead. Here, work files are normally read-only. To edit a file, you ask the @@ -253,7 +247,7 @@ version control system to make it writable for you by @dfn{locking} it; only one user can lock a given file at any given time. This procedure is analogous to, but different from, the locking that Emacs uses to detect simultaneous editing of ordinary files -(@pxref{Interlocking}). When you check in your changes, that unlocks +(@pxref{Interlocking}). When you commit your changes, that unlocks the file, and the work file becomes read-only again. Other users may then lock the file to make their own changes. @@ -261,8 +255,8 @@ then lock the file to make their own changes. users try to modify the same file at the same time. Locking systems have @dfn{lock conflicts}; a user may try to check a file out and be unable to because it is locked. In merging systems, @dfn{merge -conflicts} happen when you check in a change to a file that conflicts -with a change checked in by someone else after your checkout. Both +conflicts} happen when you commit a change to a file that conflicts +with a change committed by someone else after your checkout. Both kinds of conflict have to be resolved by human judgment and communication. Experience has shown that merging is superior to locking, both in convenience to developers and in minimizing the @@ -275,27 +269,33 @@ Distributed version control systems, such as GNU Arch, git, and Mercurial, are exclusively merging-based. VC mode supports both locking and merging version control. The -terms ``checkin'' and ``checkout'' come from locking-based version -control systems; newer version control systems have slightly different -operations usually called ``commit'' and ``update'', but VC hides the -differences between them as much as possible. +terms ``commit'' and ``update'' are used in newer version control +systems; older lock-based systems use the terms ``check in'' and +``check out''. VC hides the differences between them as much as +possible. + +@node VCS Changesets +@subsubsection Changeset-based vs File-based Version Control -@cindex files versus changesets. +@cindex changesets On SCCS, RCS, CVS, and other early version control systems, version control operations are @dfn{file-based}: each file has its own comment -and revision history separate from that of all other files in the -system. Later systems, beginning with Subversion, are -@dfn{changeset-based}: a checkin may include changes to several files, -and the entire set of changes is treated as a unit by the system. Any -comment associated with the change does not belong to a single file, -but to the changeset itself. +and revision history separate from that of all other files. Newer +systems, beginning with Subversion, are @dfn{changeset-based}: a +checkin may include changes to several files, and the entire set of +changes is handled as a unit. Any comment associated with the change +does not belong to a single file, but to the changeset itself. Changeset-based version control is more flexible and powerful than file-based version control; usually, when a change to multiple files has to be reversed, it's good to be able to easily identify and remove all of it. -@cindex centralized vs. decentralized version control +@node VCS Repositories +@subsubsection Decentralized vs Centralized Repositories + +@cindex centralized version control +@cindex decentralized version control Early version control systems were designed around a @dfn{centralized} model in which each project has only one repository used by all developers. SCCS, RCS, CVS, and Subversion share this @@ -306,14 +306,12 @@ point for reliability and efficiency. control, later implemented in git, Mercurial, and Bazaar. A project may have several different repositories, and these systems support a sort of super-merge between repositories that tries to reconcile their -change histories. At the limit, each developer has his/her own -repository, and repository merges replace checkin/commit operations. +change histories. In effect, there is one repository for each +developer, and repository merges take the place of commit operations. - VC's job is to help you manage the traffic between your personal -workfiles and a repository. Whether that repository is a single -master or one of a network of peer repositories is not something VC -has to care about. Thus, the difference between a centralized and a -decentralized version control system is invisible to VC mode. + VC helps you manage the traffic between your personal workfiles and +a repository. Whether the repository is a single master, or one of a +network of peer repositories, is not something VC has to care about. @node Types of Log File @subsubsection Types of Log File @@ -323,9 +321,9 @@ decentralized version control system is invisible to VC mode. Projects that use a version control system can have two types of log for changes. One is the log maintained by the version control system: -each time you check in a change, you fill out a @dfn{log entry} for -the change (@pxref{Log Buffer}). This is called the @dfn{version -control log}. +each time you commit a change, you fill out a @dfn{log entry} for the +change (@pxref{Log Buffer}). This is called the @dfn{version control +log}. The other kind of log is the file @file{ChangeLog} (@pxref{Change Log}). It provides a chronological record of all changes to a large @@ -365,32 +363,29 @@ change, and later use the @kbd{C-x v a} command to copy it to @cindex VC, mode line indicator When you visit a file that is under version control, Emacs indicates -this on the mode line. For example, @samp{RCS-1.3} says that the RCS -back end is used for that file, and the current version of the file is -1.3. - - The first part of the VC mode-line indicator is the name of the back -end: @samp{RCS}, @samp{CVS}, @samp{Bzr}, etc. The back-end name is -followed by a single character and the version of the file. +this on the mode line. For example, @samp{Bzr-1223} says that Bazaar +is used for that file, and the current revision ID is 1223. The character between the back-end name and the revision ID -indicates the version control status of the file. @samp{-} means that -the work file is not locked (if locking is in use), or not modified (if -locking is not in use). @samp{:} indicates that the file is locked, or -that it is modified. If the file is locked by some other user (for +indicates the status of the work file. In a merge-based version +control system, a @samp{-} character indicates that the work file is +unmodified, and @samp{:} indicates that it has been modified. +@samp{!} indicates that the file contains conflicts as result of a +recent merge operation (@pxref{Merging}), or that the file was removed +from the version control. Finally, @samp{?} means that the file is +under version control, but is missing from the working tree. + + In a lock-based system, @samp{-} indicates an unlocked file, and +@samp{:} a locked file; if the file is locked by another user (for instance, @samp{jim}), that is displayed as @samp{RCS:jim:1.3}. @samp{@@} means that the file was locally added, but not yet committed -to the master repository. @samp{!} indicates that the file contains -conflicts as result of a recent merge operation (@pxref{Merging}), or -that the file was removed from the version control. Finally, @samp{?} -means that the file is under version control, but is missing from the -working tree. +to the master repository. On a graphical display, you can move the mouse over this mode line indicator to pop up a ``tool-tip'', which displays a more verbose description of the version control status. Pressing @kbd{Mouse-1} -over the indicator pops up a menu of VC commands. This menu is -identical to the @samp{Tools / Version Control} menu item. +over the indicator pops up a menu of VC commands, identical to +@samp{Tools / Version Control} on the menu bar. @vindex auto-revert-check-vc-info When Auto Revert mode (@pxref{Reverting}) reverts a buffer that is @@ -442,12 +437,6 @@ command line. All files in a VC fileset must be under the same version control system; if they are not, Emacs signals an error when you attempt to execute a command on the fileset. - Support for VC filesets and changeset-based version control systems -is the main improvement to VC in Emacs 23. When you mark multi-file -VC in a VC Directory buffer, VC operations treat them as a VC fileset, -and operate on them all at once if the version control system is -changeset-based. @xref{VC Directory Mode}. - VC filesets are distinct from the ``named filesets'' used for viewing and visiting files in functional groups (@pxref{Filesets}). Unlike named filesets, VC filesets are not named and don't persist @@ -457,7 +446,6 @@ across sessions. * VC With A Merging VCS:: Without locking: default mode for CVS. * VC With A Locking VCS:: RCS in its default mode, SCCS, and optionally CVS. * Advanced C-x v v:: Advanced features available with a prefix argument. -* Log Buffer:: Features available in log entry buffers. @end menu @node VC With A Merging VCS @@ -490,9 +478,9 @@ If you have not changed the work file, but some other user has checked in changes to the repository, merge those changes into the work file. @item -If you have made modifications to the work file, attempts to check in -your changes. To do this, Emacs first reads the log entry for the new -revision (@pxref{Log Buffer}). If some other user has checked in +If you have made modifications to the work file, attempt to commit +the changes. To do this, Emacs first reads the log entry for the new +revision (@pxref{Log Buffer}). If some other user has committed changes to the repository since you last checked it out, the checkin fails. In that case, type @kbd{C-x v v} again to merge those changes into your own work file; this puts the work file into a ``conflicted'' @@ -507,8 +495,8 @@ trying to commit your own changes, type @kbd{C-x v m @key{RET}}. These rules also apply when you use RCS in its ``non-locking'' mode, except that changes are not automatically merged from the repository. -Nothing informs you if another user has checked in changes in the same -file since you began editing it; when you check in your revision, his +Nothing informs you if another user has committed changes in the same +file since you began editing it; when you commit your revision, his changes are removed (however, they remain in the repository and are thus not irrevocably lost). Therefore, you must verify that the current revision is unchanged before checking in your changes. In @@ -528,7 +516,7 @@ If the file is not locked, lock it and make it writable, so that you can change it. @item -If the file is locked by you, and contains changes, check in the +If the file is locked by you, and contains changes, commit the changes. In order to do this, Emacs first reads the log entry for the new revision. @xref{Log Buffer}. @@ -544,12 +532,12 @@ locked the file, to inform him of what has happened. @end itemize These rules also apply when you use CVS in locking mode, except -that there is no such thing as stealing a lock. +that CVS does not support stealing a lock. @node Advanced C-x v v @subsubsection Advanced Control in @kbd{C-x v v} -@cindex revision ID to check in/out +@cindex revision ID in version control When you give a prefix argument to @code{vc-next-action} (@kbd{C-u C-x v v}), it still performs the next logical version control operation, but accepts additional arguments to specify precisely how @@ -558,8 +546,8 @@ to do the operation. @itemize @bullet @item If the file is modified (or locked), you can specify the revision ID -to use for the new version that you check in. This is one way -to create a new branch (@pxref{Branches}). +to use for the new version that you commit. This is one way to create +a new branch (@pxref{Branches}). @item If the file is not modified (and unlocked), you can specify the @@ -585,34 +573,53 @@ Features}). @end itemize @node Log Buffer -@subsubsection Features of the Log Entry Buffer +@subsection Features of the Log Entry Buffer + + When you tell VC to commit a change, it pops up a buffer called +@samp{*VC-Log*}. In this buffer, you should write a @dfn{log entry} +describing the changes you have made (@pxref{Why Version Control?}). +After you are done, type @kbd{C-c C-c}; this exits the buffer and +commits the change, together with your log entry. + + While in the @samp{*VC-Log*} buffer, you can write one or more +@dfn{header lines}, specifying additional information to be supplied +to the version control system. Each header line must occupy a single +line at the top of the buffer; the first line that is not a header +line is treated as the start of the log entry. For example, the +following header line states that the present change was not written +by you, but by another developer: - When you check in changes, Emacs pops up a buffer called -@samp{*VC-Log*} for you to enter a log entry. +@smallexample +Author: J. R. Hacker <jrh@@example.com> +@end smallexample - After you have finished editing the log message, type @kbd{C-c C-c} -to exit the buffer and commit the change. +@noindent +Apart from the @samp{Author} header, Emacs recognizes the headers +@samp{Date} (a manually-specified commit time) and @samp{Fixes} (a +reference to a bug fixed by the change). Not all version control +systems recognize all headers: Bazaar recognizes all three headers, +while git, Mercurial, and Monotone recognizes only @samp{Author} and +@samp{Summary}. If you specify a header for a version control that +does not support it, the header is treated as part of the log entry. @findex log-edit-show-files @findex log-edit-show-diff - In the @samp{*VC-Log*} buffer, typing @kbd{C-c C-f} -(@code{log-edit-show-files}) displays a list of files in the VC -fileset you are committing. If you called @kbd{C-x v v} directly from -a work file, the VC fileset consists of that single file, so this -command is not very useful. If you called @kbd{C-x v v} from a VC -directory buffer, the VC fileset may consist of multiple files -(@pxref{VC Directory Mode}). + Type @kbd{C-c C-f} (@code{log-edit-show-files}) to display a list of +files in the current VC fileset. If you called @kbd{C-x v v} directly +from a work file, the fileset consists of that single file; if you +called @kbd{C-x v v} from a VC directory buffer (@pxref{VC Directory +Mode}), the fileset may consist of multiple files. @findex log-edit-insert-changelog - Type @kbd{C-c C-d} (@code{log-edit-show-diff}) to show a ``diff'' of -the changes you have made (i.e., the differences between the work file -and the repository revision from which you started editing the file). -The diff is displayed in a special buffer in another window. -@xref{Comparing Files}. - - If you have written an entry in the @file{ChangeLog} (@pxref{Change -Log}), type @kbd{C-c C-a} (@code{log-edit-insert-changelog}) to pull -it into the @samp{*VC-Log*} buffer. If the topmost item in the + Type @kbd{C-c C-d} (@code{log-edit-show-diff}) to show a @dfn{diff} +of the changes you have made (i.e., the differences between the work +file and the repository revision from which you started editing). +@xref{Old Revisions}. + + If the current VC fileset includes one or more @file{ChangeLog} +files (@pxref{Change Log}), type @kbd{C-c C-a} +(@code{log-edit-insert-changelog}) to pull the relevant entries into +the @samp{*VC-Log*} buffer. If the topmost item in each @file{ChangeLog} was made under your user name on the current date, this command searches that item for entries that match the file(s) to be committed; if found, these entries are inserted. @@ -627,7 +634,7 @@ the revision control log. To abort a check-in, just @strong{don't} type @kbd{C-c C-c} in that buffer. You can switch buffers and do other editing. As long as you -don't try to check in another file, the entry you were editing remains +don't try to commit another file, the entry you were editing remains in the @samp{*VC-Log*} buffer, and you can go back to that buffer at any time to complete the check-in. @@ -636,7 +643,7 @@ convenient to specify the same log entry for many of the files. (This is the normal way to do things on a changeset-oriented system, where comments are attached to changesets rather than the history of individual files.) The most convenient way to do this is to mark all -the files in VC Directory Mode and check in from there; the log buffer +the files in VC Directory Mode and commit from there; the log buffer will carry the fileset information with it and do a group commit when you type @kbd{C-c C-c}. @@ -648,7 +655,7 @@ work just like the minibuffer history commands (except that these versions are used outside the minibuffer). @vindex vc-log-mode-hook - Each time you check in a change, the log entry buffer is put into VC + Each time you commit a change, the log entry buffer is put into VC Log Edit mode, which involves running two hooks: @code{text-mode-hook} and @code{vc-log-mode-hook}. @xref{Hooks}. @@ -700,8 +707,12 @@ buffer in a separate window. @kbd{C-x v =} (@code{vc-diff}) compares each file in the current VC fileset (saving them if necessary) with the repository revision(s) from which you started editing. Note that the latter may or may not -be the latest revision of the file(s). The diff is displayed in a -special buffer in another window. @xref{Comparing Files}. +be the latest revision of the file(s). + + The diff is displayed in another window, in a Diff mode buffer +(@pxref{Diff Mode}) named @file{*vc-diff*}. In this buffer, the +@kbd{g} (@code{revert-buffer}) command performs the file comparison +again, generating a new diff. @findex vc-diff @kindex C-u C-x v = @@ -1008,7 +1019,7 @@ then decide not to change it. @kindex C-x v c @findex vc-rollback - To cancel a change that you already checked in, use @kbd{C-x v c} + To cancel a change that you already committed, use @kbd{C-x v c} (@code{vc-rollback}). This command discards all record of the most recent checked-in revision, but only if your work file corresponds to that revision---you cannot use @kbd{C-x v c} to cancel a revision that @@ -1075,8 +1086,8 @@ output is used. Here is an example using CVS: @noindent In this example, @samp{file1.c} is modified with respect to the repository, and @samp{file2.c} is not. @samp{file3.c} is modified, -but other changes have also been checked in to the repository---you -need to merge them with the work file before you can check it in. +but other changes have also been committed---you need to merge them +with the work file before you can check it in. @vindex vc-stay-local @vindex vc-cvs-stay-local @@ -1114,7 +1125,7 @@ this includes Version Control subdirectories such as @samp{RCS} and VC Directory mode has a full set of navigation and marking commands for picking out filesets. Some of these are also available in a -context menu invoked by the @kbd{mouse-2} button. +context menu invoked by @kbd{mouse-2}. Up- and down-arrow keys move in the buffer; @kbd{n} and @kbd{p} also move vertically as in other list-browsing modes. @key{SPC} and @@ -1158,7 +1169,8 @@ directory buffer will be used. @kbd{M-s a C-s} does an incremental search on the marked files. - @kbd{M-s a C-M-s} does an incremental search on the marked files. + @kbd{M-s a C-M-s} does an incremental regular expression search +on the marked files. @cindex stashes in version control @cindex shelves in version control @@ -1174,11 +1186,11 @@ buffers. Some single-key shortcuts are available as well; @kbd{=}, @kbd{+}, @kbd{l}, @kbd{i}, and @kbd{v} behave as through prefixed with @kbd{C-x v}. - The command @kbd{C-x v v} (@code{vc-next-action}) operates on all the -marked files, so that you can check in several files at once. -If the underlying VC supports atomic commits of multiple-file -changesets, @kbd{C-x v v} with a selected set of modified but not -committed files will commit all of them at once as a single changeset. + The command @kbd{C-x v v} (@code{vc-next-action}) operates on all +the marked files, so that you can commit several files at once. If +the underlying VC supports atomic commits of multiple-file changesets, +@kbd{C-x v v} with a selected set of modified but not committed files +will commit all of them at once as a single changeset. When @kbd{C-x v v} (@code{vc-next-action}) operates on multiple files, all of those files must be either in the same state or in @@ -1261,15 +1273,15 @@ other branch. @node Creating Branches @subsubsection Creating New Branches - To create a new branch from a head revision (one that is the latest in -the branch that contains it), first select that revision if necessary, -lock it with @kbd{C-x v v}, and make whatever changes you want. Then, -when you check in the changes, use @kbd{C-u C-x v v}. This lets you -specify the revision ID for the new revision. You should specify a -suitable branch ID for a branch starting at the current revision. -For example, if the current revision is 2.5, the branch ID should be -2.5.1, 2.5.2, and so on, depending on the number of existing branches at -that point. + To create a new branch from a head revision (one that is the latest +in the branch that contains it), first select that revision if +necessary, lock it with @kbd{C-x v v}, and make whatever changes you +want. Then, when you commit the changes, use @kbd{C-u C-x v v}. This +lets you specify the revision ID for the new revision. You should +specify a suitable branch ID for a branch starting at the current +revision. For example, if the current revision is 2.5, the branch ID +should be 2.5.1, 2.5.2, and so on, depending on the number of existing +branches at that point. To create a new branch at an older revision (one that is no longer the head of a branch), first select that revision (@pxref{Switching @@ -1282,11 +1294,11 @@ revision, that you really mean to create a new branch---if you say no, you'll be offered a chance to lock the latest revision instead. On a merging-based VCS you will skip this step. - Then make your changes and type @kbd{C-x v v} again to check in a new + Then make your changes and type @kbd{C-x v v} again to commit a new revision. This automatically creates a new branch starting from the -selected revision. You need not specially request a new branch, because -that's the only way to add a new revision at a point that is not the head -of a branch. +selected revision. You need not specially request a new branch, +because that's the only way to add a new revision at a point that is +not the head of a branch. After the branch is created, you ``stay'' on it. That means that subsequent check-ins create new revisions on that branch. To leave the @@ -1334,11 +1346,11 @@ type @kbd{C-x v v} to lock revision 1.5 so that you can change it. Next, type @kbd{C-x v m 1.3.1 @key{RET}}. This takes the entire set of changes on branch 1.3.1 (relative to revision 1.3, where the branch started, up to the last revision on the branch) and merges it into the current revision -of the work file. You can now check in the changed file, thus creating +of the work file. You can now commit the changed file, thus creating revision 1.6 containing the changes from the branch. It is possible to do further editing after merging the branch, before -the next check-in. But it is usually wiser to check in the merged +the next check-in. But it is usually wiser to commit the merged revision, then lock it and make the further changes. This will keep a better record of the history of changes. @@ -1374,7 +1386,7 @@ master file revision with user B's changes in it is 1.11. Then you can resolve the conflicts by editing the file manually. Or you can type @code{M-x vc-resolve-conflicts} after visiting the file. This starts an Ediff session, as described above. Don't forget to -check in the merged version afterwards. +commit the merged version afterwards. @node Multi-User Branching @subsubsection Multi-User Branching diff --git a/doc/emacs/msdog.texi b/doc/emacs/msdog.texi index a44438bf81f..4be67aa31de 100644 --- a/doc/emacs/msdog.texi +++ b/doc/emacs/msdog.texi @@ -31,7 +31,8 @@ here. * 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 @@ on Windows, since many users of Emacs on those platforms prefer the @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 @@ names, which might cause misalignment of columns in Dired display. @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 @@ names, the Windows port of Emacs supports an alternative name @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 @@ click-to-focus policy. @include msdog-xtra.texi @end ifnottex -@ignore - arch-tag: f39d2590-5dcc-4318-88d9-0eb73ca10fa2 -@end ignore diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 9fdef175826..c8846b35e4b 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -351,10 +351,11 @@ which prefers Cyrillic characters and files encoded in Windows-1255). @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 @@ characters the font does not cover. The standard fontset is only used if 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 diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index d477ca73c46..ddf68e62bbf 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1192,7 +1192,8 @@ specification, or because the specification was inaccurate. For 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 diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 5095c3f4764..04d37719013 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -594,7 +594,7 @@ headers. @vindex vc-handled-backends The variable @code{vc-handled-backends} determines which version control systems VC should handle. The default value is @code{(RCS CVS -SVN SCCS BZR GIT HG Arch)}, so it contains all the version systems +SVN SCCS Bzr Git Hg Mtn Arch)}, so it contains all the version systems that are currently supported. If you want VC to ignore one or more of these systems, exclude its name from the list. To disable VC entirely, set this variable to @code{nil}. @@ -657,8 +657,8 @@ variable does not affect @kbd{C-x v c}; that operation is so drastic that it should always ask for confirmation.) @vindex vc-command-messages - VC mode does much of its work by running the shell commands for RCS, -CVS and SCCS. If @code{vc-command-messages} is non-@code{nil}, VC + VC mode does much of its work by running the shell commands for the +appropriate backend. If @code{vc-command-messages} is non-@code{nil}, VC displays messages to indicate which shell commands it runs, and additional messages when the commands finish. diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog index 101e5b1d8b7..d75bb003279 100644 --- a/doc/lispintro/ChangeLog +++ b/doc/lispintro/ChangeLog @@ -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. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index dfba68cc911..50b11a62fa0 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -704,23 +704,25 @@ Regular Expression Searches * 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 +The @code{@value{COUNT-WORDS}} Function -* Design count-words-region:: The definition using a @code{while} loop. -* Whitespace Bug:: The Whitespace Bug in @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}}. 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 @@ word count commands using @code{while} loops and recursion. @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 +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{count-words-region} Function -@findex count-words-region +@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 @@ command to count the number of words in a complete buffer. However, 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 @@ region. This means that word counting is ideally suited to recursion 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}. +* 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 count-words-region, Whitespace Bug, count-words-region, count-words-region +@node Design @value{COUNT-WORDS}, Whitespace Bug, @value{COUNT-WORDS}, @value{COUNT-WORDS} @ifnottex -@unnumberedsubsec Designing @code{count-words-region} +@unnumberedsubsec Designing @code{@value{COUNT-WORDS}} @end ifnottex First, we will implement the word count command with a @code{while} @@ -13905,7 +13909,9 @@ What we need to do is fill in the slots. 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 @@ first, to set up conditions under which the @code{while} loop can 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 @@ All this leads to the following function definition: @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 @@ table determines which characters these are." @noindent As written, the function works, but not in all circumstances. -@node Whitespace Bug, , Design count-words-region, count-words-region +@node Whitespace Bug, , Design @value{COUNT-WORDS}, @value{COUNT-WORDS} @comment node-name, next, previous, up -@subsection The Whitespace Bug in @code{count-words-region} +@subsection The Whitespace Bug in @code{@value{COUNT-WORDS}} -The @code{count-words-region} command described in the preceding +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 @@ parenthesis and type @kbd{C-x C-e} to install it. @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 @@ syntax table determines which characters these are." 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 @@ Emacs will tell you, correctly, that the region has three words. 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 @@ For the third test, copy the sample line to the end of the @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 @@ The two bugs stem from the same problem. 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 @@ an error if the search fails. The optional fourth argument is a 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 @@ to the regular expression search expression: (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 @@ true-or-false-test tests true because the value of point is still less 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 @@ succeeds and as a side effect moves point. Consequently, as words are 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 @@ Here is what it looks like: @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 @@ Here is what it looks like: 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 @@ other. One function will set up the conditions and display the 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 @@ previous versions: @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 @@ Using @code{let}, the function definition looks like this: @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 @@ Thus, the do-again-test should look like this: 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 @@ The wrapper: @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 @@ exclamation mark, and question mark. Do the same using recursion. 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 @@ and this will tell. * 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 @@ of ten words and symbols. @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 @@ connectors: @samp{multiply-by-seven} is counted as if it were written @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 @@ Syntax tables specify which characters belong to which categories. 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 @@ most common character within symbols that is not typically a word 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 @@ Here is the full regular expression: @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 @@ Put together, the @code{count-words-in-defun} definition looks like this: 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 @@ Lisp Reference Manual}. @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 @@ Overview, , Command Loop Overview, elisp, The GNU Emacs Lisp Reference 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 @@ for commands made outside of the Edebug debugging buffer.) @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 @@ airplane. @bye -@ignore - arch-tag: da1a2154-531f-43a8-8e33-fc7faad10acf -@end ignore diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 7cee5368fda..46a2de9aec8 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,77 @@ +2010-12-08 Glenn Morris <rgm@gnu.org> + + * buffers.texi (Modification Time): + verify-visited-file-modtime now defaults to the current buffer. + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * nonascii.texi (Converting Representations): Document byte-to-string. + + * strings.texi (Creating Strings): Don't mention semi-obsolete + function char-to-string. + (String Conversion): Shorten discussion of semi-obsolete function + string-to-char. Link to Converting Representations. + + * objects.texi (Symbol Type): + * text.texi (Near Point): + * help.texi (Help Functions): + * functions.texi (Mapping Functions): Use string instead of + char-to-string in examples. + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * text.texi (Kill Functions, Kill Functions) + (Low-Level Kill Ring, Low-Level Kill Ring): Remove obsolete + YANK-HANDLER args. + + * symbols.texi (Creating Symbols): Using unintern without an + obarray arg is now obsolete. + + * numbers.texi (Float Basics): Document float-e and float-pi. + + * variables.texi (Defining Variables): Change "pi" example to + "float-pi". + +2010-11-26 Eli Zaretskii <eliz@gnu.org> + + * commands.texi (Click Events): Document the values of X, Y and + COL, ROW in the event's position, when the click is on the header + or mode line, on the fringes, or in the margins. + +2010-11-17 Eli Zaretskii <eliz@gnu.org> + + * customize.texi (Composite Types): Lower-case index entry. + + * loading.texi (How Programs Do Loading): Document + load-file-name. (Bug#7346) + +2010-11-17 Glenn Morris <rgm@gnu.org> + + * text.texi (Kill Functions, Low-Level Kill Ring): Small fixes. + +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. + +2010-10-28 Glenn Morris <rgm@gnu.org> + + * Makefile.in (elisp.dvi, elisp.pdf): Also include $emacsdir. + +2010-10-24 Eli Zaretskii <eliz@gnu.org> + + * display.texi (Window Systems): Deprecate use of window-system as + a predicate. + +2010-10-23 Glenn Morris <rgm@gnu.org> + + * help.texi (Documentation Basics): Remove mentions of digest-doc and + sorted-doc. + 2010-10-15 Eli Zaretskii <eliz@gnu.org> * os.texi (Dynamic Libraries): New node, with slightly modified diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index f1caa9abfa2..be8b6ca2c9e 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -109,7 +109,7 @@ $(infodir)/elisp: $(srcs) $(MAKEINFO) -o $@ $< elisp.dvi: $(srcs) - $(TEXI2DVI) -I $(srcdir) -I $(texinfodir) $< + $(TEXI2DVI) -I $(srcdir) -I $(texinfodir) -I $(emacsdir) $< elisp.html: $(srcs) $(MAKEINFO) --html -o $@ $< @@ -118,7 +118,7 @@ elisp.ps: elisp.dvi $(DVIPS) -o $@ $< elisp.pdf: $(srcs) - $(TEXI2PDF) -I $(srcdir) -I $(texinfodir) $< + $(TEXI2PDF) -I $(srcdir) -I $(texinfodir) -I $(emacsdir) $< .PHONY: mostlyclean clean distclean maintainer-clean infoclean diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 2a7a603e733..8811178fe92 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -1,7 +1,8 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2001, 2002, -@c 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +@c 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +@c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../../info/buffers @node Buffers, Windows, Backups and Auto-Saving, Top @@ -594,12 +595,12 @@ therefore checks the file's modification time using the functions described below before saving the file. (@xref{File Attributes}, for how to examine a file's modification time.) -@defun verify-visited-file-modtime buffer -This function compares what @var{buffer} has recorded for the -modification time of its visited file against the actual modification -time of the file as recorded by the operating system. The two should be -the same unless some other process has written the file since Emacs -visited or saved it. +@defun verify-visited-file-modtime &optional buffer +This function compares what @var{buffer} (by default, the +current-buffer) has recorded for the modification time of its visited +file against the actual modification time of the file as recorded by the +operating system. The two should be the same unless some other process +has written the file since Emacs visited or saved it. The function returns @code{t} if the last actual modification time and Emacs's recorded modification time are the same, @code{nil} otherwise. @@ -1223,6 +1224,3 @@ This function returns the current gap position in the current buffer. This function returns the current gap size of the current buffer. @end defun -@ignore - arch-tag: 2e53cfab-5691-41f6-b5a8-9c6a3462399c -@end ignore diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 17cfcc0def8..d83396750ca 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1285,8 +1285,12 @@ input stream. @xref{Key Sequence Input}. @item @var{x}, @var{y} These are the pixel coordinates of the click, relative to the top left corner of @var{window}, which is @code{(0 . 0)}. -For the mode or header line, @var{y} does not have meaningful data. -For the vertical line, @var{x} does not have meaningful data. +For a click on text, these are relative to the top left corner of +the window's text area. For the mode or header line, they are +relative to the top left window edge. For fringes, margins, and the +vertical border, @var{x} does not have meaningful data. For fringes +and margins, @var{y} is relative to the bottom edge of the header +line. @item @var{timestamp} This is the time at which the event occurred, in milliseconds. @@ -1316,7 +1320,12 @@ the window. @item @var{col}, @var{row} These are the actual coordinates of the glyph under the @var{x}, @var{y} position, possibly padded with default character width -glyphs if @var{x} is beyond the last glyph on the line. +glyphs if @var{x} is beyond the last glyph on the line. For clicks on +the header or mode line, these are measured from the top left edge of +the header or mode line. For clicks on the fringes and on the +vertical border, these have no meaningful data. For clicks on the +margins, @var{col} is measured from the left edge of the margin area +and @var{row} is measured from the top of the margin area. @item @var{image} This is the image object on which the click occurred. It is either @@ -1333,7 +1342,7 @@ left corner of the character glyph clicked on. These are the pixel width and height of @var{object} or, if this is @code{nil}, those of the character glyph clicked on. @end table - + @sp 1 For mouse clicks on a scroll-bar, @var{position} has this form: diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 4b620049b04..bfd45518bc8 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -733,7 +733,7 @@ The value must be a valid color name, and you can do completion with @node Composite Types @subsection Composite Types -@cindex Composite Types (customization) +@cindex composite types (customization) When none of the simple types is appropriate, you can use composite types, which build new types from other types or from specified data. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index f4092cfa7ea..6e872ad4233 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5579,9 +5579,9 @@ digit characters representing the character code in octal. (A display 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 @@ -5928,6 +5928,14 @@ selected frame). The list of possible symbols it returns is the same one documented for the variable @code{window-system} above. @end defun + Do @emph{not} use @code{window-system} and +@code{initial-window-system} as predicates or boolean flag variables, +if you want to write code that works differently on text terminals and +graphic displays. That is because @code{window-system} is not a good +indicator of Emacs capabilities on a given display type. Instead, use +@code{display-graphic-p} or any of the other @code{display-*-p} +predicates described in @ref{Display Feature Testing}. + @defvar window-setup-hook This variable is a normal hook which Emacs runs after handling the initialization files. Emacs runs this hook after it has completed diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index d27010d2096..4c44d0a6439 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1748,6 +1748,15 @@ If @var{frame} is not visible, this function does nothing. The return value is not significant. @end defun +@defun frame-pointer-visible-p &optional frame +This predicate function returns non-@code{nil} if the mouse pointer +displayed on @var{frame} is visible; otherwise it returns @code{nil}. +@var{frame} omitted or @code{nil} means the selected frame. This is +useful when @code{make-pointer-invisible} is set to @code{t}: it +allows to know if the pointer has been hidden. +@xref{Mouse Avoidance,,,emacs}. +@end defun + @need 3000 @node Pop-Up Menus diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index d5c89dd7cf3..e9003601516 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -843,7 +843,7 @@ length of @var{sequence}. For example: @result{} (a c e) (mapcar '1+ [1 2 3]) @result{} (2 3 4) -(mapcar 'char-to-string "abc") +(mapcar 'string "abc") @result{} ("a" "b" "c") @end group diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 026258f2472..f21e16e104a 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -1,7 +1,8 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2001, -@c 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +@c 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +@c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../../info/help @node Documentation, Files, Modes, Top @@ -106,12 +107,6 @@ documentation string. The functions @code{documentation} and documentation string from the appropriate file; this is transparent to the user. -@c Wordy to prevent overfull hbox. --rjc 15mar92 - The @file{emacs/lib-src} directory contains two utilities that you can -use to print nice-looking hardcopy for the file -@file{emacs/etc/DOC-@var{version}}. These are @file{sorted-doc} and -@file{digest-doc}. - @node Accessing Documentation @section Access to Documentation Strings @@ -551,7 +546,7 @@ follows: @smallexample @group -(define-key global-map (char-to-string help-char) 'help-command) +(define-key global-map (string help-char) 'help-command) (fset 'help-command help-map) @end group @end smallexample @@ -701,6 +696,3 @@ echo area at first, and display the longer @var{help-text} strings only if the user types the help character again. @end defopt -@ignore - arch-tag: ba36b4c2-e60f-49e2-bc25-61158fdcd815 -@end ignore diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index dee2a0252eb..05d836140c7 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -107,6 +107,10 @@ in @code{load-path}, where @code{nil} stands for the default directory. @code{load-path}, then all three suffixes in the second directory, and so on. @xref{Library Search}. +Whatever the name under which the file is eventually found, and the +directory where Emacs found it, Emacs sets the value of the variable +@code{load-file-name} to that file's name. + If you get a warning that @file{foo.elc} is older than @file{foo.el}, it means you should consider recompiling @file{foo.el}. @xref{Byte Compilation}. @@ -157,6 +161,12 @@ This variable is non-@code{nil} if Emacs is in the process of loading a file, and it is @code{nil} otherwise. @end defvar +@defvar load-file-name +When Emacs is in the process of loading a file, this variable's value +is the name of that file, as Emacs found it during the search +described earlier in this section. +@end defvar + @defvar load-read-function @anchor{Definition of load-read-function} @c do not allow page break at anchor; work around Texinfo deficiency. diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi index a5b126afcb2..4b416a82d64 100644 --- a/doc/lispref/maps.texi +++ b/doc/lispref/maps.texi @@ -1,7 +1,8 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. @c Copyright (C) 1990, 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, -@c 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +@c 2005, 2006, 2007, 2008, 2009, 2010 +@c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../../info/maps @node Standard Keymaps, Standard Hooks, Standard Buffer-Local Variables, Top @@ -183,9 +184,9 @@ A sparse keymap used by Lisp mode. @vindex menu-bar-edit-menu The keymap which displays the Edit menu in the menu bar. -@item menu-bar-files-menu -@vindex menu-bar-files-menu -The keymap which displays the Files menu in the menu bar. +@item menu-bar-file-menu +@vindex menu-bar-file-menu +The keymap which displays the File menu in the menu bar. @item menu-bar-help-menu @vindex menu-bar-help-menu @@ -239,6 +240,3 @@ The keymap defining the contents of the tool bar. A full keymap used by View mode. @end table -@ignore - arch-tag: b741253c-7e23-4a02-b3fa-cffd9e4d72b9 -@end ignore diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 40c78d97da7..1c196c93f27 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -199,6 +199,13 @@ unibyte string, it is returned unchanged. Use this function for characters. @end defun +@defun byte-to-string byte +@cindex byte to string +This function returns a unibyte string containing a single byte of +character data, @var{character}. It signals a error if +@var{character} is not an integer between 0 and 255. +@end defun + @defun multibyte-char-to-unibyte char This converts the multibyte character @var{char} to a unibyte character, and returns that character. If @var{char} is neither diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 62b4796350e..e83da348e05 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -224,6 +224,14 @@ down to an integer. @end example @end defun +@defvar float-e +The mathematical constant @math{e} (2.71828@dots{}). +@end defvar + +@defvar float-pi +The mathematical constant @math{pi} (3.14159@dots{}). +@end defvar + @node Predicates on Numbers @section Type Predicates for Numbers @cindex predicates for numbers diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index b0b0e1d0042..93776f3b4f0 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -582,7 +582,6 @@ makes it invalid as a number. @group foo ; @r{A symbol named @samp{foo}.} FOO ; @r{A symbol named @samp{FOO}, different from @samp{foo}.} -char-to-string ; @r{A symbol named @samp{char-to-string}.} @end group @group 1+ ; @r{A symbol named @samp{1+}} diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 1128ca87d8a..94d2765a833 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -126,9 +126,8 @@ This function returns a string made up of @var{count} repetitions of @result{} "" @end example - Other functions to compare with this one include @code{char-to-string} -(@pxref{String Conversion}), @code{make-vector} (@pxref{Vectors}), and -@code{make-list} (@pxref{Building Lists}). + Other functions to compare with this one include @code{make-vector} +(@pxref{Vectors}) and @code{make-list} (@pxref{Building Lists}). @end defun @defun string &rest characters @@ -565,38 +564,6 @@ of text characters and general input events (@code{single-key-description} and @code{text-char-description}). These are used primarily for making help messages. -@defun char-to-string character -@cindex character to string -This function returns a new string containing one character, -@var{character}. This function is semi-obsolete because the function -@code{string} is more general. @xref{Creating Strings}. -@end defun - -@defun string-to-char string -@cindex string to character - This function returns the first character in @var{string}. If the -string is empty, the function returns 0. The value is also 0 when the -first character of @var{string} is the null character, @acronym{ASCII} code -0. - -@example -(string-to-char "ABC") - @result{} 65 - -(string-to-char "xyz") - @result{} 120 -(string-to-char "") - @result{} 0 -@group -(string-to-char "\000") - @result{} 0 -@end group -@end example - -This function may be eliminated in the future if it does not seem useful -enough to retain. -@end defun - @defun number-to-string number @cindex integer to string @cindex integer to decimal @@ -659,19 +626,39 @@ this function returns 0. @code{string-to-int} is an obsolete alias for this function. @end defun +@defun char-to-string character +@cindex character to string +This function returns a new string containing one character, +@var{character}. This function is semi-obsolete because the function +@code{string} is more general. @xref{Creating Strings}. +@end defun + +@defun string-to-char string + This function returns the first character in @var{string}. This +mostly identical to @code{(aref string 0)}, except that it returns 0 +if the string is empty. (The value is also 0 when the first character +of @var{string} is the null character, @acronym{ASCII} code 0.) This +function may be eliminated in the future if it does not seem useful +enough to retain. +@end defun + Here are some other functions that can convert to or from a string: @table @code @item concat -@code{concat} can convert a vector or a list into a string. +This function converts a vector or a list into a string. @xref{Creating Strings}. @item vconcat -@code{vconcat} can convert a string into a vector. @xref{Vector +This function converts a string into a vector. @xref{Vector Functions}. @item append -@code{append} can convert a string into a list. @xref{Building Lists}. +This function converts a string into a list. @xref{Building Lists}. + +@item byte-to-string +This function converts a byte of character data into a unibyte string. +@xref{Converting Representations}. @end table @node Formatting Strings diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 5bb44ff9675..ccf90e33cd0 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -383,7 +383,7 @@ See @code{documentation} in @ref{Accessing Documentation}, for another example using @code{mapatoms}. @end defun -@defun unintern symbol &optional obarray +@defun unintern symbol obarray This function deletes @var{symbol} from the obarray @var{obarray}. If @code{symbol} is not actually in the obarray, @code{unintern} does nothing. If @var{obarray} is @code{nil}, the current obarray is used. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 04e1e714133..45d358366de 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -87,7 +87,7 @@ buffer is @samp{@@}: @example @group -(char-to-string (char-after 1)) +(string (char-after 1)) @result{} "@@" @end group @end example @@ -122,9 +122,9 @@ but there is no peace. @end group @group -(char-to-string (preceding-char)) +(string (preceding-char)) @result{} "a" -(char-to-string (following-char)) +(string (following-char)) @result{} "c" @end group @end example @@ -866,7 +866,7 @@ adds it to the most recent element. It determines automatically (using @code{last-command}) whether the previous command was a kill command, and if so appends the killed text to the most recent entry. -@deffn Command kill-region start end &optional yank-handler +@deffn Command kill-region start end This function kills the text in the region defined by @var{start} and @var{end}. The text is deleted but saved in the kill ring, along with its text properties. The value is always @code{nil}. @@ -874,17 +874,10 @@ its text properties. The value is always @code{nil}. In an interactive call, @var{start} and @var{end} are point and the mark. -@c Emacs 19 feature If the buffer or text is read-only, @code{kill-region} modifies the kill ring just the same, then signals an error without modifying the buffer. This is convenient because it lets the user use a series of kill commands to copy text from a read-only buffer into the kill ring. - -If @var{yank-handler} is non-@code{nil}, this puts that value onto -the string of killed text, as a @code{yank-handler} text property. -@xref{Yanking}. Note that if @var{yank-handler} is @code{nil}, any -@code{yank-handler} properties present on the killed text are copied -onto the kill ring, like other text properties. @end deffn @defopt kill-read-only-ok @@ -901,10 +894,10 @@ from the buffer. It returns @code{nil}. The command does not set @code{this-command} to @code{kill-region}, so a subsequent kill command does not append to the same kill ring entry. -Don't call @code{copy-region-as-kill} in Lisp programs unless you aim to -support Emacs 18. For newer Emacs versions, it is better to use -@code{kill-new} or @code{kill-append} instead. @xref{Low-Level Kill -Ring}. +@c FIXME Why is it better? Why isn't copy-region-as-kill obsolete then? +@c Why is it used in many places in Emacs? +In Lisp programs, it is better to use @code{kill-new} or +@code{kill-append} instead of this command. @xref{Low-Level Kill Ring}. @end deffn @node Yanking @@ -1042,8 +1035,8 @@ text property, if there is one. @subsection Low-Level Kill Ring These functions and variables provide access to the kill ring at a -lower level, but still convenient for use in Lisp programs, because they -take care of interaction with window system selections +lower level, but are still convenient for use in Lisp programs, +because they take care of interaction with window system selections (@pxref{Window System Selections}). @defun current-kill n &optional do-not-move @@ -1069,7 +1062,7 @@ it returns the entry pointed at by the yanking pointer and does not move the yanking pointer. @end defun -@defun kill-new string &optional replace yank-handler +@defun kill-new string &optional replace This function pushes the text @var{string} onto the kill ring and makes the yanking pointer point to it. It discards the oldest entry if appropriate. It also invokes the value of @@ -1078,25 +1071,15 @@ if appropriate. It also invokes the value of If @var{replace} is non-@code{nil}, then @code{kill-new} replaces the first element of the kill ring with @var{string}, rather than pushing @var{string} onto the kill ring. - -If @var{yank-handler} is non-@code{nil}, this puts that value onto -the string of killed text, as a @code{yank-handler} property. -@xref{Yanking}. Note that if @var{yank-handler} is @code{nil}, then -@code{kill-new} copies any @code{yank-handler} properties present on -@var{string} onto the kill ring, as it does with other text properties. @end defun -@defun kill-append string before-p &optional yank-handler +@defun kill-append string before-p This function appends the text @var{string} to the first entry in the kill ring and makes the yanking pointer point to the combined entry. Normally @var{string} goes at the end of the entry, but if @var{before-p} is non-@code{nil}, it goes at the beginning. This function also invokes the value of @code{interprogram-cut-function} -(see below). This handles @var{yank-handler} just like -@code{kill-new}, except that if @var{yank-handler} is different from -the @code{yank-handler} property of the first entry of the kill ring, -@code{kill-append} pushes the concatenated string onto the kill ring, -instead of replacing the original first entry with it. +(see below). @end defun @defvar interprogram-paste-function @@ -4324,6 +4307,4 @@ code that is itself run from a modification hook, then rebind locally @code{inhibit-modification-hooks} to @code{nil}. @end defvar -@ignore - arch-tag: 3721e738-a1cb-4085-bc1a-6cb8d8e1d32b -@end ignore + diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index a3a550868f5..20fe4dbc9fa 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -544,21 +544,23 @@ not the buffer-local value. (But you should not be making buffer-local bindings for a symbol that is defined with @code{defconst}.) -Here, @code{pi} is a constant that presumably ought not to be changed -by anyone (attempts by the Indiana State Legislature notwithstanding). -As the second form illustrates, however, this is only advisory. +An example of the use of @code{defconst} is Emacs' definition of +@code{float-pi}---the mathematical constant @math{pi}, which ought not +to be changed by anyone (attempts by the Indiana State Legislature +notwithstanding). As the second form illustrates, however, +@code{defconst} is only advisory. @example @group -(defconst pi 3.1415 "Pi to five places.") - @result{} pi +(defconst float-pi 3.141592653589793 "The value of Pi.") + @result{} float-pi @end group @group -(setq pi 3) - @result{} pi +(setq float-pi 3) + @result{} float-pi @end group @group -pi +float-pi @result{} 3 @end group @end example diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index b556a5ff31d..6db4c966d75 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,311 @@ +2010-12-06 Tassilo Horn <tassilo@member.fsf.org> + + * gnus.texi (Server Commands): Point to the rest of the server + commands. + +2010-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Paging the Article): Note the reverse meanings of `C-u C-u + g'. + +2010-12-02 Julien Danjou <julien@danjou.info> + + * gnus.texi (Archived Messages): Remove gnus-outgoing-message-group. + +2010-11-28 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Customizing the IMAP Connection): Note the new defaults. + (Direct Functions): Note the STARTTLS upgrade. + +2010-11-27 Glenn Morris <rgm@gnu.org> + James Clark <none@example.com> + + * nxml-mode.texi (Introduction): New section. + +2010-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Server Commands): Document gnus-server-show-server. + +2010-11-20 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.2.0. + + * trampver.texi: Update release number. + +2010-11-19 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi (TeX and LaTeX Language Modes, Predefined Units): + Mention that the TeX specific units won't use the `tex' prefix + in TeX mode. + +2010-11-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (Misc Article): Document gnus-inhibit-images. + +2010-11-17 Glenn Morris <rgm@gnu.org> + + * edt.texi: Remove information about Emacs 19. + +2010-11-17 Michael Albinus <michael.albinus@gmx.de> + + * trampver.texi: Update release number. + +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, + since that works by default. + +2010-11-03 Kan-Ru Chen <kanru@kanru.info> (tiny change) + + * gnus.texi (Customizing the IMAP Connection): Document + `nnimap-expunge' and remove `nnimap-expunge-inbox' from example. + +2010-11-04 Michael Albinus <michael.albinus@gmx.de> + + * tramp.texi (Remote shell setup): New item "Interactive shell + prompt". Reported by Christian Millour <cm@abtela.com>. + (Remote shell setup, Remote processes): Use @code{} for + environment variables. + +2010-11-03 Glenn Morris <rgm@gnu.org> + + * ediff.texi (Quick Help Commands, Miscellaneous): + * gnus.texi (Agent Variables, Configuring nnmairix): Spelling fix. + +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Paging the Article): Document C-u g/C-u C-u g. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * mh-e.texi (Preface, From Bill Wohler): Change 23 to past tense. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * cc-mode.texi: Remove reference to defunct viewcvs URL. + +2010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Client-Side IMAP Splitting): Mention + nnimap-unsplittable-articles. + +2010-10-29 Julien Danjou <julien@danjou.info> + + * gnus.texi (Finding the News): Remove references to obsoletes + variables `gnus-nntp-server' and `gnus-secondary-servers'. + +2010-10-29 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (MAKEINFO): Add -I$(emacsdir). + (ENVADD): Remove extra -I$(emacsdir), included in $(MAKEINFO). + ($(infodir)/efaq): Remove -I$(emacsdir), included in $(MAKEINFO). + ($(infodir)/calc, calc.dvi): Depend on $(emacsdir)/emacsver.texi. + +2010-10-28 Glenn Morris <rgm@gnu.org> + + * Makefile.in (MAKEINFO, ENVADD): Add $emacsdir to include path. + (($(infodir)/calc, calc.dvi, calc.pdf): Depend on emacsver.texi. + ($(infodir)/efaq): Remove -I option now in $MAKEINFO. + +2010-10-25 Daiki Ueno <ueno@unixuser.org> + + * epa.texi (Mail-mode integration): Add alternative key bindings + for epa-mail commands; escape comma. + Don't use the word "PGP", since it is a non-free program. + +2010-10-24 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi: Use emacsver.texi to determine Emacs version. + +2010-10-24 Juanma Barranquero <lekktu@gmail.com> + + * gnus.texi (Group Parameters, Buttons): Fix typos. + +2010-10-22 Tassilo Horn <tassilo@member.fsf.org> + + * gnus.texi (Subscription Commands): Mention that you can also + subscribe to new groups via the Server buffer, which is probably more + convenient when subscribing to many groups. + +2010-10-21 Julien Danjou <julien@danjou.info> + + * message.texi (Message Headers): Allow message-default-headers to be a + function. + +2010-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-news.texi: Mention new archive defaults. + +2010-10-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (RSS): Remove nnrss-wash-html-in-text-plain-parts. + +2010-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (HTML): Document the function value of + gnus-blocked-images. + (Article Washing): shr and gnus-w3m, not the direct function names. + +2010-10-20 Julien Danjou <julien@danjou.info> + + * emacs-mime.texi (Flowed text): Add a note about mml-enable-flowed + variable. + +2010-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Customizing the IMAP Connection): The port strings are + strings. + (Document Groups): Mention git. + +2010-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-coding.texi (Gnus Maintainance Guide): Update to mention Emacs + bzr/Gnus git sync. + 2010-10-15 Eli Zaretskii <eliz@gnu.org> * auth.texi (GnuPG and EasyPG Assistant Configuration): Fix last diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index d5afabd0374..deeafa2c1b2 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -37,12 +37,12 @@ VPATH=@srcdir@ ## Note that the setfilename command in the .texi files assumes this. infodir=../../info ## Directory with emacsver.texi. -## Currently only used by efaq; could be added to MAKEINFO. +## Currently only used by efaq and calc. emacsdir = $(srcdir)/../emacs # The makeinfo program is part of the Texinfo distribution. # Use --force so that it generates output even if there are errors. -MAKEINFO = makeinfo --force +MAKEINFO = makeinfo --force -I$(emacsdir) # Also add new entries to INFO_FILES in the top-level Makefile.in. INFO_TARGETS = \ @@ -198,7 +198,7 @@ PDF_TARGETS = \ TEXI2DVI = texi2dvi TEXI2PDF = texi2pdf -ENVADD = TEXINPUTS="$(srcdir):$(TEXINPUTS)" MAKEINFO="$(MAKEINFO) -I$(srcdir)" +ENVADD = TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" MAKEINFO="$(MAKEINFO) -I$(srcdir)" mkinfodir = @cd ${srcdir}; test -d ${infodir} || mkdir ${infodir} || test -d ${infodir} @@ -244,12 +244,12 @@ autotype.pdf: ${srcdir}/autotype.texi $(ENVADD) $(TEXI2PDF) $< calc : $(infodir)/calc -$(infodir)/calc: calc.texi +$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi $(mkinfodir) cd $(srcdir); $(MAKEINFO) $< -calc.dvi: ${srcdir}/calc.texi +calc.dvi: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $< -calc.pdf: ${srcdir}/calc.texi +calc.pdf: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2PDF) $< ccmode : $(infodir)/ccmode @@ -381,7 +381,7 @@ eudc.pdf: ${srcdir}/eudc.texi efaq : $(infodir)/efaq $(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi $(mkinfodir) - cd $(srcdir); $(MAKEINFO) -I $(emacsdir) $< + cd $(srcdir); $(MAKEINFO) $< faq.dvi: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $< faq.pdf: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index f0b79e95dc8..58de84b8194 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -7,6 +7,8 @@ @setchapternewpage odd @comment %**end of header (This is for running Texinfo on a region.) +@include emacsver.texi + @c The following macros are used for conditional output for single lines. @c @texline foo @c `foo' will appear only in TeX output @@ -88,7 +90,8 @@ This file documents Calc, the GNU Emacs calculator. @end ifinfo @ifnotinfo -This file documents Calc, the GNU Emacs calculator, included with GNU Emacs 23.1. +This file documents Calc, the GNU Emacs calculator, included with +GNU Emacs @value{EMACSVER}. @end ifnotinfo Copyright @copyright{} 1990, 1991, 2001, 2002, 2003, 2004, @@ -14119,6 +14122,10 @@ but @texline @math{\sin(2 + x)}. @infoline @expr{sin(2 + x)}. +The @TeX{} specific unit names (@pxref{Predefined Units}) will not use +the @samp{tex} prefix; the unit name for a @TeX{} point will be +@samp{pt} instead of @samp{texpt}, for example. + Function and variable names not treated specially by @TeX{} and La@TeX{} are simply written out as-is, which will cause them to come out in italic letters in the printed document. If you invoke @kbd{d T} or @@ -27987,6 +27994,14 @@ than the point used by @TeX{}), @code{texdd} (a Didot point), @code{texcc} (a Cicero) and @code{texsp} (a scaled @TeX{} point, all dimensions representable in @TeX{} are multiples of this value). +When Calc is using the @TeX{} or La@TeX{} language mode (@pxref{TeX +and LaTeX Language Modes}), the @TeX{} specific unit names will not +use the @samp{tex} prefix; the unit name for a @TeX{} point will be +@samp{pt} instead of @samp{texpt}, for example. To avoid conflicts, +the unit names for pint and parsec will simply be @samp{pint} and +@samp{parsec} instead of @samp{pt} and @samp{pc}. + + The unit @code{e} stands for the elementary (electron) unit of charge; because algebra command could mistake this for the special constant @expr{e}, Calc provides the alternate unit name @code{ech} which is @@ -36582,7 +36597,3 @@ the corresponding full Lisp name is derived by adding a prefix of @bye - -@ignore - arch-tag: 77a71809-fa4d-40be-b2cc-da3e8fb137c0 -@end ignore diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 73ee0e107d3..da8e7082909 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -160,7 +160,8 @@ CC Mode This manual is for CC Mode in Emacs. Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -201,9 +202,8 @@ developing GNU and promoting software freedom.'' @vskip 0pt plus 1filll @insertcopying -This manual was generated from cc-mode.texi, which can be downloaded -from -@url{http://cvs.savannah.gnu.org/viewcvs/emacs/emacs/doc/misc/cc-mode.texi}. +This manual was generated from cc-mode.texi, which is distributed with Emacs, +or can be downloaded from @url{http://savannah.gnu.org/projects/emacs/}. @end titlepage @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -7015,6 +7015,3 @@ Since most @ccmode{} variables are prepended with the string @bye -@ignore - arch-tag: c4cab162-5e57-4366-bdce-4a9db2fc97f0 -@end ignore diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index f4f96d55391..6f6a897e6dc 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -890,7 +890,8 @@ symbol can be preceeded to the corresponding Lisp object. Basic D-Bus 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 @@ objects. @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 @@ objects. @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 diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 4259fccb390..c2897e185bf 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -759,7 +759,7 @@ Displays a list of currently active Ediff sessions---the Ediff Registry. You can then restart any of these sessions by either clicking on a session record or by putting the cursor over it and then typing the return key. -(Some poor souls leave so many active Ediff sessions around that they loose +(Some poor souls leave so many active Ediff sessions around that they lose track of them completely... The `R' command is designed to save these people from the recently discovered Ediff Proficiency Syndrome.) @@ -2315,7 +2315,7 @@ other behavior. However, Ediff temporarily resets this variable to @code{t} if it is invoked via one of the "buffer" jobs, such as @code{ediff-buffers}. -This is because it is all too easy to loose day's work otherwise. +This is because it is all too easy to lose a day's work otherwise. Besides, in a "buffer" job, the variant buffers have already been loaded prior to starting Ediff, so Ediff just preserves status quo here. @@ -2542,6 +2542,3 @@ Eli Zaretskii (eliz at is.elta.co.il) @bye -@ignore - arch-tag: 165ecb88-d03c-44b1-a921-b93f50b05b46 -@end ignore diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi index d394137d76b..f3d0eacc0f3 100644 --- a/doc/misc/edt.texi +++ b/doc/misc/edt.texi @@ -63,8 +63,8 @@ of DEC's EDT editor. @node Overview @chapter Overview of the EDT Package -This manual describes version 4.0 of the EDT Emulation for Emacs 19 and -above. It comes with special functions which replicate nearly all of +This manual describes 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 provided so that users may reconfigure most keypad and function key bindings to @@ -152,9 +152,8 @@ You can also invoke @code{edt-set-scroll-margins} interactively while EDT Emulation is active to change the settings for that session. @strong{Please 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: @code{edt-top-scroll-margin} and -@code{edt-bottom-scroll-margin}. +the Emacs customization feature to set the following two variables +directly: @code{edt-top-scroll-margin} and @code{edt-bottom-scroll-margin}. Enter the Emacs @code{customize} command. First select the @samp{Editing} group and then select the @samp{Emulations} group. @@ -239,8 +238,7 @@ Provide an easy way to restore @strong{all} original Emacs key bindings, just as they existed before the EDT emulation was first invoked. @item -Support GNU Emacs 19 and higher. (GNU Emacs 18 and below is no longer -supported.) XEmacs 19, and above, is also supported. +Support GNU Emacs 19 and higher. XEmacs 19, and above, is also supported. @item Supports highlighting of marked text within the EDT emulation on all @@ -933,9 +931,8 @@ You can also invoke @code{edt-set-scroll-margins} interactively while EDT Emulation is active to change the settings for that session. @strong{Please 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: @code{edt-top-scroll-margin} and -@code{edt-bottom-scroll-margin}. +the Emacs customization feature to set the following two variables +directly: @code{edt-top-scroll-margin} and @code{edt-bottom-scroll-margin}. Enter the Emacs @code{customize} command. First select the @samp{Editing} group and then select the @samp{Emulations} group. @@ -946,7 +943,3 @@ Finally, select the @samp{Edt} group and follow the directions. @include doclicense.texi @bye - -@ignore - arch-tag: 1b7ebe01-754b-4834-a12b-f152ef7db9e0 -@end ignore diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 475ce2bb53f..9511f6d10c0 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -1040,6 +1040,10 @@ flowed text, the default is to wrap after 66 characters. If hard newline characters are not present in the buffer, no flow encoding occurs. +You can customize the value of the @code{mml-enable-flowed} variable +to enable or disable the flowed encoding usage when newline +characteres are present in the buffer. + On decoding flowed text, lines with soft newline characters are filled together and wrapped after the column decided by @code{fill-flowed-display-column}. The default is to wrap after diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index 32bf9e7fe1d..7afe9c0c9b8 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -306,14 +306,14 @@ Encrypt marked files. @section Mail-mode integration EasyPG Assistant provides a minor mode @code{epa-mail-mode} to help -user compose inline PGP messages. Inline PGP is a traditional style -of sending signed/encrypted emails by embedding raw OpenPGP blobs -inside a message body, not using modern MIME format. +user compose inline OpenPGP messages. Inline OpenPGP is a traditional +style of sending signed/encrypted emails by embedding raw OpenPGP +blobs inside a message body, not using modern MIME format. -NOTE: Inline PGP is not recommended and you should consider to use +NOTE: Inline OpenPGP is not recommended and you should consider to use PGP/MIME. See @uref{http://josefsson.org/inline-openpgp-considered-harmful.html, -Inline PGP in E-mail is bad, Mm'kay?}. +Inline OpenPGP in E-mail is bad@comma{} Mm'kay?}. @noindent Once @code{epa-mail-mode} is enabled, the following keys are assigned. @@ -321,22 +321,26 @@ You can do it by @kbd{C-u 1 M-x epa-mail-mode} or through the Customize interface. Try @kbd{M-x customize-variable epa-global-mail-mode}. @table @kbd -@item C-c C-e d +@item C-c C-e C-d and C-c C-e d +@kindex @kbd{C-c C-e C-d} @kindex @kbd{C-c C-e d} @findex epa-mail-decrypt Decrypt OpenPGP armors in the current buffer. -@item C-c C-e v +@item C-c C-e C-v and C-c C-e v +@kindex @kbd{C-c C-e C-v} @kindex @kbd{C-c C-e v} @findex epa-mail-verify Verify OpenPGP cleartext signed messages in the current buffer. -@item C-c C-e s +@item C-c C-e C-s and C-c C-e s +@kindex @kbd{C-c C-e C-s} @kindex @kbd{C-c C-e s} @findex epa-mail-sign Compose a signed message from the current buffer. -@item C-c C-e e +@item C-c C-e C-e and C-c C-e e +@kindex @kbd{C-c C-e C-e} @kindex @kbd{C-c C-e e} @findex epa-mail-encrypt Compose an encrypted message from the current buffer. diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi index 22b74c900b0..f513bc15a24 100644 --- a/doc/misc/gnus-coding.texi +++ b/doc/misc/gnus-coding.texi @@ -288,14 +288,21 @@ Emacs repository might have been lost. With the inclusion of Gnus 5.10, Miles Bader has set up an Emacs-Gnus gateway to ensure the bug fixes from Emacs CVS are propagated to Gnus -CVS semi-automatically. These bug fixes are installed on the stable -branch and on the trunk. Basically the idea is that the gateway will -cause all common files in Emacs and Gnus v5-10 to be identical except -when there's a very good reason (e.g., the Gnus version string in Emacs -says @samp{5.11}, but the v5-10 version string remains @samp{5.10.x}). -Furthermore, all changes in these files in either Emacs or the v5-10 -branch will be installed into the Gnus CVS trunk, again except where -there's a good reason. +CVS semi-automatically. + +After Emacs moved to bzr and Gnus moved to git, Katsumi Yamaoka has +taken over the chore of keeping Emacs and Gnus in sync. In general, +changes made to one repository will usually be replicated in the other +within a few days. + +Basically the idea is that the gateway will cause all common files in +Emacs and Gnus v5-13 to be identical except when there's a very good +reason (e.g., the Gnus version string in Emacs says @samp{5.11}, but +the v5-13 version string remains @samp{5.13.x}). Furthermore, all +changes in these files in either Emacs or the v5-13 branch will be +installed into the Gnus git trunk, again except where there's a good +reason. + @c (typically so far the only exception has been that the changes @c already exist in the trunk in modified form). Because of this, when the next major version of Gnus will be included in @@ -311,9 +318,9 @@ If it's a file which is thought of as being outside of Gnus (e.g., the new @file{encrypt.el}), you should probably make the change in the Emacs tree, and it will show up in the Gnus tree a few days later. -If you don't have Emacs CVS access (or it's inconvenient), you can +If you don't have Emacs bzr access (or it's inconvenient), you can change such a file in the v5-10 branch, and it should propagate to Emacs -CVS -- however, it will get some extra scrutiny (by Miles) to see if the +bzr -- however, it will get some extra scrutiny (by Miles) to see if the changes are possibly controversial and need discussion on the mailing list. Many changes are obvious bug-fixes however, so often there won't be any problem. @@ -321,12 +328,12 @@ be any problem. @item If it's to a Gnus file, and it's important enough that it should be part of Emacs and the v5-10 branch, then you can make the change on the v5-10 -branch, and it will go into Emacs CVS and the Gnus CVS trunk (a few days +branch, and it will go into Emacs bzr and the Gnus git trunk (a few days later). The most prominent examples for such changes are bug-fixed including improvements on the documentation. If you know that there will be conflicts (perhaps because the affected -source code is different in v5-10 and the Gnus CVS trunk), then you can +source code is different in v5-10 and the Gnus git trunk), then you can install your change in both places, and when I try to sync them, there will be a conflict -- however, since in most such cases there would be a conflict @emph{anyway}, it's often easier for me to resolve it simply if @@ -338,9 +345,6 @@ For general Gnus development changes, of course you just make the change on the Gnus Git trunk and it goes into Emacs a few years later... :-) -With the new Git repository, we'll probably set up something to -automatically synchronize with Emacs when possible. CVS was much less -powerful for this kind of synchronization. @end itemize Of course in any case, if you just can't wait for me to sync your diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index 1136d52e51d..6037a979acb 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -124,6 +124,9 @@ Customization}. @itemize @bullet +@item There's now only one variable that determines how @acronym{HTML} +is rendered: @code{mm-text-html-renderer}. + @item Gnus now supports sticky article buffers. Those are article buffers that are not reused when you select another article. @xref{Sticky Articles}. @@ -221,6 +224,9 @@ that are accessible from the article buffer. @item Changes in Message mode @itemize @bullet +@item Gnus now defaults to saving all outgoing messages in per-month +nnfolder archives. + @item Gnus now supports the ``hashcash'' client puzzle anti-spam mechanism. Use @code{(setq message-generate-hashcash t)} to enable. @xref{Hashcash}. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 1a1f0d48eb9..2df6d90cc07 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -1020,22 +1020,6 @@ Gnus will see whether @code{gnus-nntpserver-file} If that fails as well, Gnus will try to use the machine running Emacs as an @acronym{NNTP} server. That's a long shot, though. -@vindex gnus-nntp-server -If @code{gnus-nntp-server} is set, this variable will override -@code{gnus-select-method}. You should therefore set -@code{gnus-nntp-server} to @code{nil}, which is what it is by default. - -@vindex gnus-secondary-servers -@vindex gnus-nntp-server -You can also make Gnus prompt you interactively for the name of an -@acronym{NNTP} server. If you give a non-numerical prefix to @code{gnus} -(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers -in the @code{gnus-secondary-servers} list (if any). You can also just -type in the name of any server you feel like visiting. (Note that this -will set @code{gnus-nntp-server}, which means that if you then @kbd{M-x -gnus} later in the same Emacs session, Gnus will contact the same -server.) - @findex gnus-group-browse-foreign-server @kindex B (Group) However, if you use one @acronym{NNTP} server regularly and are just @@ -2211,6 +2195,12 @@ selected. @section Subscription Commands @cindex subscription +The following commands allow for managing your subscriptions in the +Group buffer. If you want to subscribe to many groups, it's probably +more convenient to go to the @ref{Server Buffer}, and choose the +server there using @kbd{RET} or @kbd{SPC}. Then you'll have the +commands listed in @ref{Browse Foreign Server} at hand. + @table @kbd @item S t @@ -2409,6 +2399,9 @@ one with the best level. All groups with a level less than or equal to @code{gnus-group-default-list-level} will be listed in the group buffer by default. +This variable can also be a function. In that case, that function will +be called and the result will be used as value. + @vindex gnus-group-list-inactive-groups If @code{gnus-group-list-inactive-groups} is non-@code{nil}, non-active @@ -3085,8 +3078,8 @@ The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve, Top, sieve, Emacs Sieve}. @item (agent parameters) -If the agent has been enabled, you can set any of the its parameters -to control the behavior of the agent in individual groups. See Agent +If the agent has been enabled, you can set any of its parameters to +control the behavior of the agent in individual groups. See Agent Parameters in @ref{Category Syntax}. Most users will choose to set agent parameters in either an agent category or group topic to minimize the configuration effort. @@ -4563,7 +4556,7 @@ However, you can also create e.g. a new @code{nnmaildir} or @code{nnml} server exclusively for @code{nnmairix} in your secondary select methods (@pxref{Finding the News}). If you use a secondary @code{nnml} server just for mairix, make sure that you explicitly set the server variable -@code{nnml-get-new-mail} to @code{nil}, or you might loose mail +@code{nnml-get-new-mail} to @code{nil}, or you might lose mail (@pxref{nnmairix caveats}). If you want to use mairix remotely on an @acronym{IMAP} server, you have to choose the corresponding @code{nnimap} server here. @@ -5195,24 +5188,6 @@ used for fetching the file. If fetching from the first site is unsuccessful, Gnus will attempt to go through @code{gnus-group-faq-directory} and try to open them one by one. -@item H C -@kindex H C (Group) -@findex gnus-group-fetch-control -@vindex gnus-group-fetch-control-use-browse-url -@cindex control message -Fetch the control messages for the group from the archive at -@code{ftp.isc.org} (@code{gnus-group-fetch-control}). Query for a -group if given a prefix argument. - -If @code{gnus-group-fetch-control-use-browse-url} is non-@code{nil}, -Gnus will open the control messages in a browser using -@code{browse-url}. Otherwise they are fetched using @code{ange-ftp} -and displayed in an ephemeral group. - -Note that the control messages are compressed. To use this command -you need to turn on @code{auto-compression-mode} (@pxref{Compressed -Files, ,Compressed Files, emacs, The Emacs Manual}). - @item H d @itemx C-c C-d @c @icon{gnus-group-describe-group} @@ -6177,9 +6152,10 @@ Scroll the current article one line backward @findex gnus-summary-show-article @vindex gnus-summary-show-article-charset-alist (Re)fetch the current article (@code{gnus-summary-show-article}). If -given a prefix, fetch the current article, but don't run any of the -article treatment functions. This will give you a ``raw'' article, just -the way it came from the server. +given a prefix, show a completely ``raw'' article, just the way it +came from the server. If given a prefix twice (i.e., @kbd{C-u C-u +g'}), fetch the current article, but don't run any of the article +treatment functions. @cindex charset, view article with different charset If given a numerical prefix, you can do semi-manual charset stuff. @@ -9688,6 +9664,17 @@ an attempt to provide more quoting characters. If you see something 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 @@ -9803,19 +9790,16 @@ If a prefix is given, a charset will be asked for. If it is a number, the charset defined in @code{gnus-summary-show-article-charset-alist} (@pxref{Paging the Article}) will be used. -@vindex gnus-article-wash-function The default is to use the function specified by @code{mm-text-html-renderer} (@pxref{Display Customization, ,Display Customization, emacs-mime, The Emacs MIME Manual}) to convert the -@acronym{HTML}, but this is controlled by the -@code{gnus-article-wash-function} variable. Pre-defined functions you -can use include: +@acronym{HTML}. Pre-defined functions you can use include: @table @code -@item mm-shr +@item shr Use Gnus simple html renderer. -@item gnus-article-html +@item gnus-w3m Use Gnus rendered based on w3m. @item w3 @@ -12462,15 +12446,22 @@ that's based on @code{w3m}. @item gnus-blocked-images @vindex gnus-blocked-images -Images that have @acronym{URL}s that match this regexp won't be -fetched and displayed. For instance, do block all @acronym{URL}s that -have the string ``ads'' in them, do the following: +External images that have @acronym{URL}s that match this regexp won't +be fetched and displayed. For instance, do block all @acronym{URL}s +that have the string ``ads'' in them, do the following: @lisp (setq gnus-blocked-images "ads") @end lisp -The default is to block all external images. +This can also be a function to be evaluated. If so, it will be +called with the group name as the parameter. The default value is +@code{gnus-block-private-groups}, which will return @samp{"."} for +anything that isn't a newsgroup. This means that no external images +will be fetched as a result of reading mail, so that nobody can use +web bugs (and the like) to track whether you've read email. + +Also @pxref{Misc Article} for @code{gnus-inhibit-images}. @item gnus-html-cache-directory @vindex gnus-html-cache-directory @@ -12952,6 +12943,15 @@ for how to compose such messages. This requires @uref{http://www.gnu.org/software/libidn/, GNU Libidn}, and this variable is only enabled if you have installed it. +@vindex gnus-inhibit-images +@item gnus-inhibit-images +If this is non-@code{nil}, inhibit displaying of images inline in the +article body. It is effective to images that are in articles as +@acronym{MIME} parts, and images in @acronym{HTML} articles rendered +when @code{mm-text-html-renderer} (@pxref{Display Customization, +,Display Customization, emacs-mime, The Emacs MIME Manual}) is +@code{shr} or @code{gnus-w3m}. + @end table @@ -13342,21 +13342,6 @@ case you should set @code{gnus-message-archive-group} to @code{nil}; this will disable archiving. @table @code -@item gnus-outgoing-message-group -@vindex gnus-outgoing-message-group -All outgoing messages will be put in this group. If you want to store -all your outgoing mail and articles in the group @samp{nnml:archive}, -you set this variable to that value. This variable can also be a list of -group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names). - -This variable can be used instead of @code{gnus-message-archive-group}, -but the latter is the preferred method. - @item gnus-gcc-mark-as-read @vindex gnus-gcc-mark-as-read If non-@code{nil}, automatically mark @code{Gcc} articles as read. @@ -13451,14 +13436,20 @@ the headers of the article; if the value is @code{nil}, the header name will be removed. If the attribute name is @code{eval}, the form is evaluated, and the result is thrown away. -The attribute value can be a string (used verbatim), a function with -zero arguments (the return value will be used), a variable (its value -will be used) or a list (it will be @code{eval}ed and the return value -will be used). The functions and sexps are called/@code{eval}ed in the -message buffer that is being set up. The headers of the current article -are available through the @code{message-reply-headers} variable, which -is a vector of the following headers: number subject from date id -references chars lines xref extra. +The attribute value can be a string, a function with zero arguments +(the return value will be used), a variable (its value will be used) +or a list (it will be @code{eval}ed and the return value will be +used). The functions and sexps are called/@code{eval}ed in the +message buffer that is being set up. The headers of the current +article are available through the @code{message-reply-headers} +variable, which is a vector of the following headers: number subject +from date id references chars lines xref extra. + +In the case of a string value, if the @code{match} is a regular +expression, a @samp{gnus-match-substitute-replacement} is proceed on +the value to replace the positional parameters @samp{\@var{n}} by the +corresponding parenthetical matches (see @xref{Replacing the Text that +Matched, , Text Replacement, elisp, The Emacs Lisp Reference Manual}.) @vindex message-reply-headers @@ -13834,6 +13825,11 @@ Add a new server (@code{gnus-server-add-server}). @findex gnus-server-edit-server Edit a server (@code{gnus-server-edit-server}). +@item S +@kindex S (Server) +@findex gnus-server-show-server +Show the definition of a server (@code{gnus-server-show-server}). + @item SPACE @kindex SPACE (Server) @findex gnus-server-read-server @@ -13889,6 +13885,9 @@ hence getting a correct total article count. @end table +Some more commands for closing, disabling, and re-opening servers are +listed in @ref{Unavailable Servers}. + @node Example Methods @subsection Example Methods @@ -14442,7 +14441,9 @@ functions is also affected by commonly understood variables @findex nntp-open-network-stream @item nntp-open-network-stream This is the default, and simply connects to some port or other on the -remote system. +remote system. If both Emacs and the server supports it, the +connection will be upgraded to an encrypted @acronym{STARTTLS} +connection automatically. @findex nntp-open-tls-stream @item nntp-open-tls-stream @@ -14861,9 +14862,7 @@ Here's an example method that's more complex: (nnimap-inbox "INBOX") (nnimap-split-methods default) (nnimap-expunge t) - (nnimap-stream ssl) - (nnir-search-engine imap) - (nnimap-expunge-inbox t)) + (nnimap-stream ssl)) @end example @table @code @@ -14872,18 +14871,23 @@ The address of the server, like @samp{imap.gmail.com}. @item nnimap-server-port If the server uses a non-standard port, that can be specified here. A -typical port would be @samp{imap} or @samp{imaps}. +typical port would be @code{"imap"} or @code{"imaps"}. @item nnimap-stream How @code{nnimap} should connect to the server. Possible values are: @table @code +@item undecided +This is the default, and this first tries the @code{ssl} setting, and +then tries the @code{network} setting. + @item ssl -This is the default, and this uses standard -@acronym{TLS}/@acronym{SSL} connection. +This uses standard @acronym{TLS}/@acronym{SSL} connections. @item network -Non-encrypted and unsafe straight socket connection. +Non-encrypted and unsafe straight socket connection, but will upgrade +to encrypted @acronym{STARTTLS} if both Emacs and the server +supports it. @item starttls Encrypted @acronym{STARTTLS} over the normal @acronym{IMAP} port. @@ -14899,6 +14903,11 @@ what you need. Some @acronym{IMAP} servers allow anonymous logins. In that case, this should be set to @code{anonymous}. +@item nnimap-expunge +If non-@code{nil}, expunge articles after deleting them. This is always done +if the server supports UID EXPUNGE, but it's not done by default on +servers that doesn't support that command. + @item nnimap-streaming Virtually all @code{IMAP} server support fast streaming of data. If you have problems connecting to the server, try setting this to @code{nil}. @@ -14934,6 +14943,11 @@ use the value of the @code{nnmail-split-methods} variable. @item nnimap-split-fancy Uses the same syntax as @code{nnmail-split-fancy}. +@item nnimap-unsplittable-articles +List of flag symbols to ignore when doing splitting. That is, +articles that have these flags won't be considered when splitting. +The default is @samp{(%Deleted %Seen)}. + @end table @@ -17711,15 +17725,6 @@ If you set @code{nnrss-use-local} to @code{t}, @code{nnrss} will read the feeds from local files in @code{nnrss-directory}. You can use the command @code{nnrss-generate-download-script} to generate a download script using @command{wget}. - -@item nnrss-wash-html-in-text-plain-parts -Non-@code{nil} means that @code{nnrss} renders text in @samp{text/plain} -parts as @acronym{HTML}. The function specified by the -@code{mm-text-html-renderer} variable (@pxref{Display Customization, -,Display Customization, emacs-mime, The Emacs MIME Manual}) will be used -to render text. If it is @code{nil}, which is the default, text will -simply be folded. Leave it @code{nil} if you prefer to see -@samp{text/html} parts. @end table The following code may be helpful, if you want to show the description in @@ -17969,6 +17974,10 @@ A @acronym{MIME} digest of messages. @item lanl-gov-announce Announcement messages from LANL Gov Announce. +@cindex git commit messages +@item git +@code{git} commit messages. + @cindex forwarded messages @item rfc822-forward A message forwarded according to RFC822. @@ -19856,7 +19865,7 @@ limit to control how often the cycling occurs. A large value improves performance. A small value minimizes the time lost should the connection be lost while fetching (You may need to run @code{gnus-agent-regenerate-group} to update the group's state. -However, all articles parsed prior to loosing the connection will be +However, all articles parsed prior to losing the connection will be available while unplugged). The default is 10M so it is unusual to see any cycling. @@ -30096,11 +30105,11 @@ that means: (setq gnus-read-active-file 'some) @end lisp -On the other hand, if the manual says ``set @code{gnus-nntp-server} to -@samp{nntp.ifi.uio.no}'', that means: +On the other hand, if the manual says ``set @code{gnus-nntp-server-file} to +@samp{/etc/nntpserver}'', that means: @lisp -(setq gnus-nntp-server "nntp.ifi.uio.no") +(setq gnus-nntp-server-file "/etc/nntpserver") @end lisp So be careful not to mix up strings (the latter) with symbols (the diff --git a/doc/misc/makefile.w32-in b/doc/misc/makefile.w32-in index f4887738411..fd3b1476b55 100644 --- a/doc/misc/makefile.w32-in +++ b/doc/misc/makefile.w32-in @@ -32,7 +32,7 @@ infodir = $(srcdir)/../../info emacsdir = $(srcdir)/../emacs # The makeinfo program is part of the Texinfo distribution. -MAKEINFO = makeinfo --force +MAKEINFO = makeinfo --force -I$(emacsdir) MULTI_INSTALL_INFO = $(srcdir)\..\..\nt\multi-install-info.bat INFO_TARGETS = $(infodir)/ccmode \ $(infodir)/cl $(infodir)/dbus $(infodir)/dired-x \ @@ -70,7 +70,7 @@ INFOSOURCES = info.texi TEXI2DVI = texi2dvi ENVADD = $(srcdir)\..\..\nt\envadd.bat "TEXINPUTS=$(srcdir);$(TEXINPUTS)" \ - "MAKEINFO=$(MAKEINFO) -I$(srcdir) -I$(emacsdir)" /C + "MAKEINFO=$(MAKEINFO) -I$(srcdir)" /C info: $(INFO_TARGETS) @@ -218,7 +218,7 @@ widget.dvi: widget.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/widget.texi $(infodir)/efaq: faq.texi $(emacsdir)/emacsver.texi - $(MAKEINFO) -I$(emacsdir) faq.texi + $(MAKEINFO) faq.texi faq.dvi: faq.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/faq.texi @@ -227,10 +227,10 @@ $(infodir)/autotype: autotype.texi autotype.dvi: autotype.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/autotype.texi -$(infodir)/calc: calc.texi +$(infodir)/calc: calc.texi $(emacsdir)/emacsver.texi $(MAKEINFO) calc.texi -calc.dvi: calc.texi +calc.dvi: calc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/calc.texi # This is produced with --no-split to avoid making files whose diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 8e9eca55177..1fec34f147b 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -1450,8 +1450,10 @@ Allegedly. @item message-default-headers @vindex message-default-headers -This string is inserted at the end of the headers in all message -buffers. +Header lines to be inserted in outgoing messages before you edit the +message, so you can edit or delete their lines. If set to a string, it +is directly inserted. If set to a function, it is called and its +result is inserted. @item message-subject-re-regexp @vindex message-subject-re-regexp diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index ed64f91ac39..a06a7231112 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -213,7 +213,7 @@ more niceties about GNU Emacs and MH@. Now I'm fully hooked on both of them. The MH-E package is distributed with GNU Emacs@footnote{Version -@value{VERSION} of MH-E will appear in GNU Emacs 23.1. It is supported +@value{VERSION} of MH-E appeared in GNU Emacs 23.1. It is supported in GNU Emacs 21 and 22, as well as XEmacs 21 (except for versions 21.5.9-21.5.16). It is compatible with MH versions 6.8.4 and higher, all versions of nmh, and GNU mailutils 1.0 and higher.}, so you @@ -8951,8 +8951,8 @@ files that were already part of Emacs) and the software was completely reorganized to push back two decades of entropy. Version 8 appeared in Emacs 22.1 in 2006. -Development was then quiet for a couple of years. Emacs 23.1, which is -due out in 2009, will contain version 8.1. This version includes a few +Development was then quiet for a couple of years. Emacs 23.1, released +in June 2009, contains version 8.2. This version includes a few new features and several bug fixes. Bill Wohler, August 2008 @@ -9061,6 +9061,4 @@ Bill Wohler, August 2008 @c sentence-end-double-space: nil @c End: -@ignore - arch-tag: b778477d-1a10-4a99-84de-f877a2ea6bef -@end ignore + diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi index 423bdc85a24..d076f0dd820 100644 --- a/doc/misc/nxml-mode.texi +++ b/doc/misc/nxml-mode.texi @@ -8,7 +8,8 @@ This manual documents nxml-mode, an Emacs major mode for editing XML with RELAX NG support. -Copyright @copyright{} 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +Copyright @copyright{} 2007, 2008, 2009, 2010 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -43,6 +44,7 @@ license to the document, as described in section 6 of the license. This manual is not yet complete. @menu +* Introduction:: * Completion:: * Inserting end-tags:: * Paragraphs:: @@ -52,6 +54,58 @@ This manual is not yet complete. * Limitations:: @end menu +@node Introduction +@chapter Introduction + +nXML mode is an Emacs major-mode for editing XML documents. It supports +editing well-formed XML documents, and provides schema-sensitive editing +using RELAX NG Compact Syntax. To get started, visit a file containing an +XML document, and, if necessary, use @kbd{M-x nxml-mode} to switch to nXML +mode. By default, @code{auto-mode-alist} and @code{magic-fallback-alist} +put buffers in nXML mode if they have recognizable XML content or file +extensions. You may wish to customize the settings, for example to +recognize different file extensions. + +Once in nXML mode, you can type @kbd{C-h m} for basic information on the +mode. + +The @file{etc/nxml} directory in the Emacs distribution contains some data +files used by nXML mode, and includes two files (@file{test.valid.xml} and +@file{test.invalid.xml}) that provide examples of valid and invalid XML +documents. + +To get validation and schema-sensitive editing, you need a RELAX NG Compact +Syntax (RNC) schema for your document (@pxref{Locating a schema}). The +@file{etc/schema} directory includes some schemas for popular document +types. See @url{http://relaxng.org/} for more information on RELAX NG. +You can use the @samp{Trang} program from +@url{http://www.thaiopensource.com/relaxng/trang.html} to +automatically create RNC schemas. This program can: + +@itemize @bullet +@item +infer an RNC schema from an instance document; +@item +convert a DTD to an RNC schema; +@item +convert a RELAX NG XML syntax schema to an RNC schema. +@end itemize + +@noindent To convert a RELAX NG XML syntax (@samp{.rng}) schema to a RNC +one, you can also use the XSLT stylesheet from +@url{http://www.pantor.com/download.html}. + +To convert a W3C XML Schema to an RNC schema, you need first to convert it +to RELAX NG XML syntax using the RELAX NG converter tool @code{rngconv} +(built on top of MSV). See @url{https://github.com/kohsuke/msv} +and @url{https://msv.dev.java.net/}. + +For historical discussions only, see the mailing list archives at +@url{http://groups.yahoo.com/group/emacs-nxml-mode/}. Please make all new +discussions on the @samp{help-gnu-emacs} and @samp{emacs-devel} mailing +lists. Report any bugs with @kbd{M-x report-emacs-bug}. + + @node Completion @chapter Completion @@ -855,6 +909,3 @@ specification are not enforced. @bye -@ignore - arch-tag: 3b6e8ac2-ae8d-4f38-bd43-ce9f80be04d6 -@end ignore diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 97b8d3ebc03..af7a4b48032 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -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 @@ with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, * 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 @@ Dates and times * 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 @@ HTML export * 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 @@ Using header arguments * 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 @@ Specific header arguments * 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 @@ step for this directory: (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 @@ active region by using the mouse to select a region, or pressing 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 @@ about: @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 @@ Org uses just two commands, bound to @key{TAB} and @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 @@ argument (@kbd{C-u @key{TAB}}), global cycling is invoked. @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 @@ CONTENTS view up to headlines of level N will be shown. Note that inside 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 @@ Furthermore, any entries with a @samp{VISIBILITY} property (@pxref{Properties 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 @@ entries. @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 @@ See also the variable @code{org-goto-interface}. @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 @@ the content of that line is made the new heading. If the command is 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 @@ previously visible. Any prefix argument to this command will force a normal 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 @@ of a property. Reverse sorting is possible as well. You can also supply 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 @@ and you will see immediately how it works. 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 @@ part of the document and print the resulting file. @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 @@ visually indistinguishable from true headlines. In short: even though @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 @@ Here is an example: + 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 @@ XEmacs, you should use Kyle E. Jones' @file{filladapt.el}. To turn this on, 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). +@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 @kbd -@kindex @key{TAB} -@item @key{TAB} +@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 @@ the cursor is on a plain list item. For more details, see the variable 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 @@ Decrease/increase the indentation of an item, leaving children alone. @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 @@ unpredictable for you, configure the variables @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 @@ table. But it's easier just to start typing, like @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 @@ on a per-file basis with: @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 @@ text before the first headline is usually not exported, so the first such 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 @@ variable @code{org-display-internal-link-with-indirect-buffer}}. @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 @@ letters, numbers, @samp{-}, and @samp{_}. Abbreviations are resolved 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 @@ be called with the tag as the only argument to create the link. 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 @@ The habit is a TODO, with a TODO keyword representing an open state. @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 @@ placing a @emph{priority cookie} into the headline of a TODO item, like this @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}. +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 tree entries; they do not need -to be TODO items. +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 @@ large number of subtasks (@pxref{Checkboxes}). @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 @@ optional. The individual parts have the following meaning: @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 @@ optional. The individual parts have the following meaning: @{: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 @@ Be aware that you can only have one summary type for any property you 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 @@ is used in a much wider sense. * 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. All commands listed below produce timestamps in the correct 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 @@ Like @kbd{C-c .} and @kbd{C-c !}, but use the alternative format which 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 @@ The function understands English month and weekday abbreviations. If 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 @@ Cancel the current clock. This is useful if a clock was started by 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 @@ with the @kbd{/} key in the agenda (@pxref{Agenda commands}). If you have 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 @@ by a certain amount. This can be used to fix timer strings if the timer was 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 @@ The following customization sets a default target file for notes, and defines 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 @@ process, so that you can resume your work without further distraction. @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 @@ Text to be inserted as it is. @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 @@ with the capture. @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 @@ similar way.}: @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 @@ associated with the item. @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 @@ Go to today. @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 @@ very fast, so that you can switch quickly between different filters without 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 @@ You may also define additional attributes for the figure. As this is 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 @@ Here is an example @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 @@ is a macro system based on Donald E. Knuth's @TeX{} system. Many of the 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 @@ La@TeX{}, see the variable @code{org-entities} for the complete list. @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 @@ convention, or use, on a per-file basis: #+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 @@ format sub- and superscripts in a WYSIWYM way. @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 @@ If you need any of the delimiter ASCII sequences for other purposes, you 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 @@ some aspects of the preview. In particular, the @code{:scale} (and for HTML 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 @@ tags: @r{turn on/off inclusion of tags, may also be @code{not-in-toc}} <: @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 @@ language, but with additional support for tables. * 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 @@ tables, place something like the following before the table: #+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 @@ support text viewers and accessibility, and align it to the right. @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 @@ For longer style definitions, you can use several such lines. You could also 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 @@ different level - then the hierarchy above frames will produce the sectioning 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 @@ environment or the @code{BEAMER_col} property. 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 @@ Export only the visible part of the document. @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 @@ to set the start and due dates for the TODO entry@footnote{See the variables @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 @@ variable, called @code{org-publish-project-alist}. Each element of the list 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 @@ possibly transformed in the process. The default transformation is to export 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 @@ e.g. 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 @@ The structure of code blocks is as follows: #+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 @@ Include the code block in the tangled output to file @samp{filename}. @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 @@ Code blocks defined in the ``Library of Babel'' can be called remotely as if 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 @@ describes each header argument in detail. @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 @@ specific (and having higher priority) than the last. * 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 @@ Properties defined in this way override the properties set in @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 0 = 1 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 @@ The following header arguments are defined: 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 @@ -11842,10 +11991,25 @@ basename}. @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 @@ interpreted language. 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 @@ Setting the @code{:shebang} header argument to a string value 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 @@ Be sure to adjust the paths to fit your system. #!/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 @@ emacsclient \ (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 @@ emacsclient \ @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 @@ emacsclient \ @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 @@ Elsewhere, complete dictionary words using Ispell. @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 @@ with the cursor at the beginning of a headline. @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 @@ Code evaluation can happen under the following circumstances: @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 @@ When set to t user is queried before code block evaluation @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 @@ Function to queries user about shell link execution. 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 @@ variable is @code{org-startup-align-all-tables}, with a default value 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 @@ Also the @kbd{M-cursor} and @kbd{M-S-cursor} keys have this property. 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 @@ written in a way such that it does nothing in buffers that are not in @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 @@ in-buffer settings, but it will understand the logistics of TODO state @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 @@ can be included by customizing @code{org-mobiles-files}. File names will be 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 @@ this flagged entry is finished. @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 @@ around a match in a hidden outline tree. @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 @@ and contributed various ideas and code snippets. @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 @@ org-customize @key{RET}} and then click yourself through the tree. @c Local variables: @c fill-column: 77 +@c indent-tabs-mode: nil @c End: diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 2c82becf6ae..6a77c138404 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1942,7 +1942,7 @@ understand this syntax and will emit a syntax error when it reaches this line. Another example is the tilde (@code{~}) character, say when adding -@file{~/bin} to @code{$PATH}. Many Bourne shells will not expand this +@file{~/bin} to @code{PATH}. Many Bourne shells will not expand this character, and since there is usually no directory whose name consists of the single character tilde, strange things will happen. @@ -1969,6 +1969,38 @@ shell is Bourne-ish already, then it might be prudent to omit the @command{exec /bin/sh} step. But how to find out if the shell is Bourne-ish? + +@item Interactive shell prompt + +@value{tramp} redefines the shell prompt in order to parse the shell's +output robustly. When calling an interactive shell by @kbd{M-x +shell}, this doesn't look nice. + +You can redefine the shell prompt by checking the environment variable +@code{INSIDE_EMACS}, which is set by @value{tramp}, in your startup +script @file{~/.emacs_SHELLNAME}. @code{SHELLNAME} might be the string +@code{bash} or similar, in case of doubt you could set it the +environment variable @code{ESHELL} in your @file{.emacs}: + +@lisp +(setenv "ESHELL" "bash") +@end lisp + +Your file @file{~/.emacs_SHELLNAME} could contain code like + +@example +# Reset the prompt for remote Tramp shells. +if [ "$@{INSIDE_EMACS/*tramp*/tramp@}" == "tramp" ] ; then + PS1="[\u@@\h \w]$ " +fi +@end example + +@ifinfo +@ifset emacs +@xref{Interactive Shell, , , @value{emacsdir}}. +@end ifset +@end ifinfo + @end table @@ -2493,7 +2525,7 @@ Adding an entry can be performed via @code{add-to-list}: Changing or removing an existing entry is not encouraged. The default values are chosen for proper @value{tramp} work. Nevertheless, if for example a paranoid system administrator disallows changing the -@var{$HISTORY} environment variable, you can customize +@code{HISTORY} environment variable, you can customize @code{tramp-remote-process-environment}, or you can apply the following code in your @file{.emacs}: @@ -2512,7 +2544,7 @@ integrate them as well. @xref{Bug Reports}. If you want to run a remote program, which shall connect the X11 server you are using with your local host, you can set the -@var{$DISPLAY} environment variable on the remote host: +@code{DISPLAY} environment variable on the remote host: @lisp (add-to-list 'tramp-remote-process-environment diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 107e4d70aa3..38758d39bc9 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -9,7 +9,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.2.0-pre +@set trampver 2.2.0 @c Other flags from configuration @set instprefix /usr/local @@ -73,7 +73,3 @@ @set emacsotherdir emacs @set emacsotherfilename tramp-emacs.html @end ifset - -@ignore - arch-tag: e0fe322c-e06b-46eb-bb5b-d091b521f41c -@end ignore diff --git a/etc/ChangeLog b/etc/ChangeLog index 17c815763b1..41a16854a06 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,41 @@ +2010-11-27 Ulrich Mueller <ulm@gentoo.org> + + * HELLO: Add ancient Greek (Bug#7418). + +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 + * images/checked.xpm, images/unchecked.xpm: Add copyright. + +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + * images/checked.xpm: + * images/unchecked.xpm: New images. + +2010-10-24 Richard Stallman <rms@gnu.org> + + * DISTRIB: Update donation section. + +2010-10-24 Glenn Morris <rgm@gnu.org> + + * DISTRIB: Small updates. + +2010-10-19 Julien Danjou <julien@danjou.info> + + * tutorials/TUTORIAL: Don't mention mode-line end dashes. + +2010-10-16 Chong Yidong <cyd@stupidchicken.com> + + * themes: New directory for custom theme files, moved from lisp/. + 2010-10-14 Juanma Barranquero <lekktu@gmail.com> * tutorials/TUTORIAL.es: Fix typos. @@ -3325,7 +3363,7 @@ * NEWS: Mention the thumbs.el package. -2004-08-14 Eric Hanchrow <offby1@blarg.net> (tiny change) +2004-08-14 Eric Hanchrow <offby1@blarg.net> * TUTORIAL.es: Replace actual whitespace with the magic string that causes help-with-tutorial to automatically insert the correct @@ -5078,12 +5116,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. @@ -5099,5 +5136,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 diff --git a/etc/DISTRIB b/etc/DISTRIB index ba80f754b87..61434b6edd1 100644 --- a/etc/DISTRIB +++ b/etc/DISTRIB @@ -1,12 +1,9 @@ -*- text -*- -For an order form for all Emacs and FSF distributions deliverable from -the USA, see http://www.gnu.org/order/order.html. - - GNU Emacs availability information, October 2000 + GNU Emacs availability information Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, - 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, + 2010 Free Software Foundation, Inc. See the end of the file for license conditions. @@ -29,31 +26,17 @@ are designed to make sure that everyone who has a copy of GNU Emacs (including modified versions) has the freedom to redistribute and change it. -If you do not know anyone to get a copy of GNU Emacs from, you can -order a cd-rom from the Free Software Foundation. We distribute -several Emacs versions. We also distribute nicely typeset copies of -the Emacs user manual, Emacs Lisp Reference Manual, the Emacs -reference card, etc. See http://www.gnu.org/order/order.html. - -If you have Internet access, you can copy the latest Emacs -distribution from hosts, such as ftp.gnu.org. There are several ways -to do this; see http://www.gnu.org/software/software.html for more -information. +For information on how to get GNU software, see +http://www.gnu.org/software/software.html. Printed copies of GNU +manuals, including the Emacs manual, are available from the FSF's +online store at http://shop.fsf.org. Emacs has been run on GNU/Linux, FreeBSD, NetBSD, OpenBSD, and on many Unix systems, on a variety of types of cpu, as well as on MSDOS, -Windows and MacOS. It also formerly worked on VMS and on Apollo -computers, though with some deficiencies that reflect problems in -these operating systems. See the file `MACHINES' in this directory -(see above) for a full list of machines that GNU Emacs has been tested +Windows and MacOS. See the file `etc/MACHINES' in the Emacs +distribution for a full list of machines that GNU Emacs has been tested on, with machine-specific installation notes and warnings. -Note that there is significant variation between Unix systems -supposedly running the same version of Unix; it is possible that what -works in GNU Emacs for me does not work on your system due to such an -incompatibility. Since I must avoid reading Unix source code, I -cannot even guess what such problems may exist. - GNU Emacs is distributed with no warranty (see the General Public License for full details, in the file `COPYING' in this directory (see above)), and neither I nor the Free Software Foundation promises any @@ -62,14 +45,13 @@ of people who are willing to offer support and assistance for hire. See http://www.gnu.org/help/gethelp.html. However, we plan to continue to improve GNU Emacs and keep it -reliable, so please send me any complaints and suggestions you have. -I will probably fix anything that I consider a malfunction. I may -make improvements that are suggested, but I may choose not to. +reliable, so please send us any complaints and suggestions you have. +We will probably fix anything that we consider a malfunction. We may +make improvements that are suggested, but we may choose not to. -If you are on the Internet, report bugs to bug-gnu-emacs@gnu.org. You -can use the Emacs command M-x report-bug RET to mail a bug report. -Please read the Bugs section of the Emacs manual before reporting -bugs. +If you are on the Internet, report bugs to bug-gnu-emacs@gnu.org. +You can use the Emacs command M-x report-bug RET to mail a bug report. +Please read the Bugs section of the Emacs manual before reporting bugs. General questions about the GNU Project can be asked of gnu@gnu.org. @@ -80,12 +62,14 @@ You should consider making a donation to help support the GNU project; if you estimate what it would cost to distribute some commercial product and divide it by five, that is a good amount. -If you like GNU Emacs, please express your satisfaction with a -donation: send me or the Foundation what you feel Emacs has been worth -to you. If you are glad that I developed GNU Emacs and distribute it -as free software, rather than following the obstructive and antisocial -practices typical of software developers, reward me. If you would -like the Foundation to develop more free software, contribute. +If you like GNU Emacs, please express your satisfaction with a donation: +send me (please email me about how) or the Foundation +(https://my.fsf.org/donate) what you feel Emacs has been worth to you. +If you are glad that I developed GNU Emacs and distribute it as free +software, rather than following the obstructive and antisocial +practices of proprietary software, you can reward me. If you would +like the Foundation to do more to forward the cause of free software, +you can contribute. Your donations will help to support the development of additional GNU software. GNU/Linux systems (variants of GNU, based on the kernel diff --git a/etc/HELLO b/etc/HELLO index f7320f7301f..5461d4cd7ef 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -33,6 +33,7 @@ French (fran,Ag(Bais) Bonjour / Salut Georgian ($,1JEJ0J@J7J5J4J:J8(B) $,1J2J0J;J0J@JOJ=J1J0(B German (Deutsch) Guten Tag / Gr,A|_(B Gott Greek (,Fekkgmij\(B) ,FCei\(B ,Fsar(B +Greek, ancient ($,1p1,Fkkgmij^(B) ,FO$,1pv,Fk](B ,Fte(B ,Fja$,1q6(B ,Fl]ca(B ,Fwa$,1r6,Fqe(B Gujarati ($,19W:!9\9p9~9d: (B) $,19h9n9x:-9d:'(B Hebrew $,1ro(B($,1-",q-(,y-*(B) ,Hylem(B Hungarian (magyar) Sz,Bi(Bp j,Bs(B napot! diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS index 1141b9dd3fa..f4bf030eb32 100644 --- a/etc/MH-E-NEWS +++ b/etc/MH-E-NEWS @@ -1,13 +1,13 @@ * COPYRIGHT -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. See the end of the file for license conditions. * Changes in MH-E 8.2 -Version 8.2 of MH-E will appear in GNU Emacs 23.1. This is a small +Version 8.2 of MH-E appeared in GNU Emacs 23.1. This is a small release that includes internal changes from the Emacs team. A new hook, `mh-pack-folder-hook', has been added. @@ -231,7 +231,7 @@ gatewayed at gmane.org (closes SF #979308). If you want to see the release notes for the alpha and beta releases leading up this release, please see: - http://cvs.savannah.gnu.org/viewcvs/emacs/etc/MH-E-NEWS?rev=1.25&root=emacs&view=markup + http://cvs.savannah.gnu.org/viewvc/emacs/emacs/etc/MH-E-NEWS?revision=1.25&view=markup @@ -38,10 +38,6 @@ These provide no new functionality, they just remove the need to edit lib-src/Makefile by hand in order to use the associated features. --- -** There is a new configure option --with-crt-dir. -This is only useful if your crt*.o files are in a non-standard location. - ---- ** Emacs can be compiled against Gtk+ 3.0 if you pass --with-x-toolkit=gtk3 to configure. Note that other libraries used by Emacs, RSVG and GConf, also depend on Gtk+. You can disable them with --without-rsvg and @@ -60,8 +56,8 @@ automatically select it. * Startup Changes in Emacs 24.1 ** The --unibyte, --multibyte, --no-multibyte, and --no-unibyte -command line arguments no longer have any effect. (They were declared -obsolete in Emacs 23.) +command line arguments, and the EMACS_UNIBYTE environment variable, no +longer have any effect. (They were declared obsolete in Emacs 23.) * Changes in Emacs 24.1 @@ -138,7 +134,23 @@ theme when Emacs is built with GTK. off by customizing x-gtk-use-system-tooltips. ** Lucid menus and dialogs can display antialiased fonts if Emacs is built -with Xft. +with Xft. To change font, use X resource faceName, for example: +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. This requires Emacs to be linked with libselinux at build time. @@ -183,7 +195,7 @@ for `list-colors-display'. ** An Emacs Lisp package manager is now included. This is a convenient way to download and install additional packages, -from elpa.gnu.org. +from a package repository at elpa.gnu.org. *** `M-x list-packages' shows a list of packages, which can be selected for installation. @@ -199,13 +211,26 @@ loaded, customize `package-load-list'. *** `M-x customize-themes' lists Custom themes which can be enabled. +*** New option `custom-theme-load-path' is the load path for themes. +Emacs no longer looks for custom themes in `load-path'. The default +is to search in `custom-theme-directory', followed by a built-in theme +directory named "themes/" in `data-directory'. + ** The user option `remote-file-name-inhibit-cache' controls whether the remote file-name cache is used for read access. +** The standalone programs lib-src/digest-doc and sorted-doc have been +replaced with Lisp commands `doc-file-to-man' and `doc-file-to-info'. + * Editing Changes in Emacs 24.1 -** completion-at-point is now an alias for complete-symbol. ++++ +** There is a new command `count-words-region', which does what you expect. + +** completion-at-point now handles tags and semantic completion. + +** The default value of `backup-by-copying-when-mismatch' is now t. ** Deletion changes @@ -215,8 +240,8 @@ and no prefix argument is given. If set to `kill', these commands kill instead. *** New command `delete-forward-char', bound to C-d and [delete]. -This is meant for interactive use, and obeys `delete-active-region'; -delete-char, meant for Lisp, does not obey `delete-active-region'. +This is meant for interactive use, and obeys `delete-active-region'. +The command `delete-char' does not obey `delete-active-region'. *** `delete-backward-char' is now a Lisp function. Apart from obeying `delete-active-region', its behavior is unchanged. @@ -228,76 +253,73 @@ should use delete-char with a negative argument instead. ** Selection changes. The default handling of clipboard and primary selections has been -changed to conform with other X applications. - -The new behavior is that by default Emacs does not put text into the -clipboard, and does not add it to kill-ring, merely because the text -was selected. Only commands that kill text or copy it to the -kill-ring (C-w, M-w, C-k, etc.) put the killed text into the -clipboard. Selected text is put into the primary selection (on -systems, such as X, that support the primary selection separately from -the clipboard). - -Similarly, Emacs by default does not retrieve text from the clipboard -when the mouse (e.g., mouse-2) is used for pasting text selected in -another application. Text from the clipboard is retrieved only by -C-y, M-y and other commands that yank text from the kill-ring. Mouse -commands that paste text retrieve text from the primary selection, on -systems that support it separately from the clipboard. - -In other words, the default behavior is that mouse gestures that -select and paste text work with the primary selection, while keyboard -commands that kill/copy and paste text work with the clipboard. - -This change also means that the "Copy", "Cut", and "Paste" items of -the menu-bar "Edit" menu are now exactly equivalent to, respectively -M-w, C-w, and C-y. - -To get back the previous behavior, whereby mouse gestures set the -clipboard and retrieve text from there, customize the variables -`mouse-drag-copy-region' and (on X only) `x-select-enable-primary'. -If you don't want Emacs to put the text into the clipboard, only to -the primary selection, additionally customize -`x-select-enable-clipboard' to nil. - -These changes in the default behavior are reflected in the default -values of several variables: - -*** `select-active-regions' now defaults to t, so active regions set -the primary selection. It was nil in previous versions. +changed to conform with other X applications. The exact changes are +described below; in short, mouse commands to select and paste text now +use the primary selection, while all other commands for killing and +yanking text now use the clipboard. + +*** Merely selecting text (e.g. with drag-mouse-1) does not add it to +the kill-ring. On systems with a primary selection separate from the +clipboard (such as X), the selected text is put in the primary +selection. +*** mouse-2 is now bound to `mouse-yank-primary', which pastes from +the primary selection regardless of the contents of the kill-ring. + +*** Commands that kill text or copy it to the kill-ring (M-w, C-w, +C-k, etc.) also put the killed text into the clipboard. This change +also means that the "Copy", "Cut", and "Paste" items in the "Edit" +menu are now exactly equivalent to, respectively M-w, C-w, and C-y. + +*** Yank commands, such as C-y and M-y, retrieve text from the +clipboard if it is available. + +*** The above changes are reflected in the following new defaults: + +**** `select-active-regions' now defaults to t. It also accepts a new value, `only', which means to only set the primary selection for temporarily active regions (usually made by mouse-dragging or shift-selection). -*** `mouse-2' is now bound to `mouse-yank-primary'. +**** `mouse-2' is now bound to `mouse-yank-primary'. Previously, it was bound to `mouse-yank-at-click' (which is now -unbound by default. +unbound by default). -*** `x-select-enable-clipboard' now defaults to t on all platforms. -Thus, killing and yanking now use the clipboard (in addition to the -kill ring). Note that this variable was already non-nil by default on -MS-Windows, which does not support the primary selection between -applications. +**** `x-select-enable-clipboard' now defaults to t on all platforms. +Note that this variable was already non-nil by default on MS-Windows, +which does not support the primary selection between applications. -*** `x-select-enable-primary' now defaults to nil. +**** `x-select-enable-primary' now defaults to nil. This variable exists only on X; its default value was t in previous versions. -*** `mouse-drag-copy-region' now defaults to nil. -Its previous default value was t. +**** `mouse-drag-copy-region' now defaults to nil. + +*** To return to the previous behavior, where mouse commands use the +clipboard, change `mouse-drag-copy-region' and (on X only) +`x-select-enable-primary' to t. If you don't want Emacs to put the +text into the clipboard, only to the primary selection, additionally +set `x-select-enable-clipboard' to nil. *** Support for X cut buffers has been removed. * 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. ** Archive Mode has basic support to browse 7z archives. +** browse-url has gotten a new variable that is used for mailto: URLs, + `browse-url-mailto-function', which defaults to `browse-url-mail'. + ** ERC changes *** New vars `erc-autojoin-timing' and `erc-autojoin-delay'. @@ -306,6 +328,11 @@ successful NickServ identification, or after `erc-autojoin-delay' seconds. The default value, 'ident, means to autojoin immediately after connecting. +*** New variable `erc-coding-system-precedence': If we use `undecided' +as the server coding system, this variable will then be consulted. +The default is to decode strings that can be decoded as utf-8 as +utf-8, and do the normal `undecided' decoding for the rest. + ** In ido-mode, C-v is no longer bound to ido-toggle-vc. The reason is that this interferes with cua-mode. @@ -316,6 +343,8 @@ You can get a comparable behavior with: ** mpc.el: Can use pseudo tags of the form tag1|tag2 as a union of two tags. +** server can listen on a specific port using the server-port option. + ** Calendar, Diary, and Appt --- @@ -335,7 +364,7 @@ view-diary-entries, list-diary-entries, show-all-diary-entries *** Customize buffers now contain a search field. The search is performed using `customize-apropos'. -To turn off the search field, set custom-search-field to nil . +To turn off the search field, set custom-search-field to nil. *** Custom options now start out hidden if at their default values. Use the arrow to the left of the option name to toggle visibility. @@ -350,41 +379,6 @@ choose a color via list-colors-display. *** dired-jump and dired-jump-other-window called with a prefix argument read a file name from the minibuffer instead of using buffer-file-name. -** VC and related modes - -*** New VC commands: vc-log-incoming, vc-log-outgoing, vc-find-conflicted-file. - -**** vc-log-incoming for Git runs "git fetch" so that the necessary -data is available locally. - -**** vc-log-incoming and vc-log-outgoing for Git require version 1.7 (or newer). - -*** New key bindings: C-x v I and C-x v O bound to vc-log-incoming and -vc-log-outgoing, respectively. - -*** The 'g' key in VC diff, log, log-incoming and log-outgoing buffers -reruns the corresponding VC command to compute an up to date version -of the buffer. - -*** vc-dir for Bzr supports viewing shelve contents and shelving snapshots. - -*** Special markup can be added to log-edit buffers. -The log-edit buffers are expected to have a format similar to email messages -with headers of the form: - Author: <author of this change> - Summary: <one line summary of this change> - Fixes: <reference to the bug fixed by this change> -Some backends handle some of those headers specially, but any unknown header -is just left as is in the message, so it is not lost. - -**** vc-git handles Author: and Date: -**** vc-hg handles Author: and Date: -**** vc-bzr handles Author:, Date: and Fixes: -**** vc-mtn handles Author: and Date: - -*** Pressing g in a *vc-diff* buffer reruns vc-diff, so it will -produce an up to date diff. - ** Directory local variables can apply to file-less buffers. For example, adding "(diff-mode . ((mode . whitespace)))" to your .dir-locals.el file, will turn on `whitespace-mode' for *vc-diff* buffers. @@ -551,15 +545,32 @@ system or session bus. *** The following access methods are discontinued: "ssh1_old", "ssh2_old", "scp1_old", "scp2_old" and "fish". +** VC and related modes + +*** Support for pulling on distributed version control systems. +The vc-update command now runs a "pull" operation, if it is supported. +This updates the current branch from upstream. A prefix argument +means to prompt the user for command specifics, e.g. a pull location. + +**** vc-pull is an alias for vc-update. + +**** Currently supported by Bzr. + +*** Support for merging on distributed version control systems. +The vc-merge command now runs a "merge" operation, if it is supported. +This merges another branch into the current one. A prefix argument +means to prompt the user for command specifics, e.g. a merge location. + +**** Currently supported by Bzr. + * 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 @@ -572,6 +583,13 @@ Notifications API. It requires D-Bus for communication. * 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. ** Test for special mode-class was moved from view-file to view-buffer. @@ -615,6 +633,8 @@ font-lock-defaults-alist ** The following files, obsolete since at least Emacs 21.1, have been removed: sc.el, x-menu.el, rnews.el, rnewspost.el +** FIXME finder-inf.el changes. + * Lisp changes in Emacs 24.1 @@ -650,6 +670,12 @@ argument is supplied (see Trash changes, above). ** New completion style `substring'. +** `facemenu-read-color' is now an alias for `read-color'. +The command `read-color' now requires a match for a color name or RGB +triplet, instead of signalling an error if the user provides a invalid +input. + + ** Image API *** When the image type is one of listed in `image-animated-types' diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17 index 122c634b0f2..b45ddedbe28 100644 --- a/etc/NEWS.1-17 +++ b/etc/NEWS.1-17 @@ -235,7 +235,7 @@ Various new commands and features exist; see the Emacs manual. * Nroff mode and TeX mode. -The are two new major modes for editing nroff input and TeX input. +There are two new major modes for editing nroff input and TeX input. See the Emacs manual for full information. * New C indentation style variable `c-brace-imaginary-offset'. diff --git a/etc/NEWS.23 b/etc/NEWS.23 index e1e7ba79d41..0608286e6d5 100644 --- a/etc/NEWS.23 +++ b/etc/NEWS.23 @@ -21,9 +21,6 @@ with a prefix argument or by typing C-u C-h C-n. * Changes in Emacs 23.3 -** The nextstep port can have different modifiers for the left and right -alt/option key by customizing the value for ns-right-alternate-modifier. - * Editing Changes in Emacs 23.3 @@ -34,6 +31,42 @@ alt/option key by customizing the value for ns-right-alternate-modifier. ** The appt-add command takes an optional argument for the warning time. This can be used in place of the default appt-message-warning-time. +--- +** You can allow inferior Python processes to load modules from the +current directory by setting `python-remove-cwd-from-path' to nil. + +** VC and related modes + +*** New VC command `vc-log-incoming', bound to `C-x v I'. +This shows a log of changes to be received with a pull operation. +For Git, this runs "git fetch" to make the necessary data available +locally; this requires version 1.7 or newer. + +*** New VC command `vc-log-outgoing', bound to `C-x v O'. +This shows a log of changes to be sent in the next commit. + +*** New VC command vc-find-conflicted-file. + ++++ +*** The 'g' key in VC diff, log, log-incoming and log-outgoing buffers +reruns the corresponding VC command to compute an up to date version +of the buffer. + +*** vc-dir for Bzr supports viewing shelve contents and shelving snapshots. + ++++ +*** Special markup can be added to log-edit buffers. +You can add headers specifying additional information to be supplied +to the version control system. For example: + + Author: J. R. Hacker <jrh@example.com> + Fixes: 4204 + Actual text of log entry... + +Bazaar recognizes the headers "Author", "Date" and "Fixes". +Git, Mercurial, and Monotone recognize "Author" and "Date". +Any unknown header is left as is in the message, so it is not lost. + ** Obsolete packages +++ @@ -42,21 +75,44 @@ This can be used in place of the default appt-message-warning-time. * 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 +** posn-col-row now excludes the header line from the row count +If the frame has a header line, posn-col-row will count row numbers +starting from the first line of text below the header line. + * Lisp changes in Emacs 23.3 ++++ ** `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 use of unintern without an obarray arg is now obsolete. + +--- +** The function `princ-list' is now obsolete. + ++++ +** The yank-handler argument to kill-region and friends is now obsolete. + ++++ ** New function byte-to-string, like char-to-string but for bytes. * Changes in Emacs 23.3 on non-free operating systems ++++ +** The nextstep port can have different modifiers for the left and right +alt/option key by customizing the value for ns-right-alternate-modifier. + * Installation Changes in Emacs 23.2 diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 093d815bd81..7090b225d7e 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -235,19 +235,18 @@ necessary but missing, please report it via M-x report-emacs-bug. On platforms such as Solaris, you can also work around this problem by configuring your compiler to use the native linker instead of GNU ld. -** Emacs compiled with Gtk+ crashes when closing a display (x-close-connection). +** When Emacs is compiled with Gtk+, closing a display kills Emacs. -This happens because of bugs in Gtk+. Gtk+ 2.10 seems to be OK. See bug -http://bugzilla.gnome.org/show_bug.cgi?id=85715. +There is a long-standing bug in GTK that prevents it from recovering +from disconnects: http://bugzilla.gnome.org/show_bug.cgi?id=85715. -** Emacs compiled with Gtk+ may loop forever if a display crashes. +Thus, for instance, when Emacs is run as a server on a text terminal, +and an X frame is created, and the X server for that frame crashes or +exits unexpectedly, Emacs must exit to prevent a GTK error that would +result in an endless loop. -This is related to the bug above. A scenario for this is when emacs is run -as a server, and an X frame is created. If the X server for the frame -crashes or exits unexpectedly and an attempt is made to create a new -frame on another X display, then a Gtk+ error happens in the emacs -server that results in an endless loop. This is not fixed in any known -Gtk+ version (2.14.4 being current). +If you need Emacs to be able to recover from closing displays, compile +it with the Lucid toolkit instead of GTK. * General runtime problems diff --git a/etc/images/README b/etc/images/README index 8956288f109..7adb3c7eb85 100644 --- a/etc/images/README +++ b/etc/images/README @@ -35,6 +35,10 @@ Files: splash.png, splash.svg Author: Francesc Rocher <rocher@member.fsf.org> Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. +Files: checked.xpm, unchecked.xpm + Author: Chong Yidong <cyd@stupidchicken.com> + Copyright (C) 2010 Free Software Foundation, Inc. + * The following icons are from GTK+ 2.x. They are not part of Emacs, but are distributed and used by Emacs. They are licensed under the diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm new file mode 100644 index 00000000000..e0152594836 --- /dev/null +++ b/etc/images/checked.xpm @@ -0,0 +1,39 @@ +/* XPM */ +/* Copyright (C) 2010 Free Software Foundation, Inc. + * + * Author: Chong Yidong <cyd@stupidchicken.com> + * + * 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/>. + */ +static char * checked_xpm[] = { +"12 12 5 1", +" c None", +". c gray20", +"+ c white", +"@ c gray70", +"# c black", +"............", +"............", +"..@@@@@@##+.", +"..@@@@@@##+.", +"..#@@@@##@+.", +"..##@@@##@+.", +"..###@##@@+.", +"..@#####@@+.", +"..@@###@@@+.", +"..@++##++++.", +".@+++++++++.", +"............"}; diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm new file mode 100644 index 00000000000..ad01824d222 --- /dev/null +++ b/etc/images/unchecked.xpm @@ -0,0 +1,39 @@ +/* XPM */ +/* Copyright (C) 2010 Free Software Foundation, Inc. + * + * Author: Chong Yidong <cyd@stupidchicken.com> + * + * 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/>. + */ +static char * unchecked_xpm[] = { +"12 12 5 1", +" c None", +". c gray20", +"+ c white", +"@ c gray70", +"# c black", +"............", +"............", +"..@@@@@@@@+.", +"..@@@@@@@@+.", +"..@@@@@@@@+.", +"..@@@@@@@@+.", +"..@@@@@@@@+.", +"..@@@@@@@@+.", +"..@@@@@@@@+.", +"..@++++++++.", +".@+++++++++.", +"............"}; diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index c1f604a64dd..cd1a2d9c1a4 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -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 @@ formula, \kbd{:=} a field formula. \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} diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml index 099df6b9436..314bdf1145f 100644 --- a/etc/schema/schemas.xml +++ b/etc/schema/schemas.xml @@ -22,7 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. --> <uri pattern="*.html" typeId="XHTML"/> <uri pattern="*.rng" typeId="RELAX NG"/> <uri pattern="*.rdf" typeId="RDF"/> - + <namespace ns="http://www.w3.org/1999/XSL/Transform" typeId="XSLT"/> <namespace ns="http://www.w3.org/1999/02/22-rdf-syntax-ns#" typeId="RDF"/> <namespace ns="http://www.w3.org/1999/xhtml" typeId="XHTML"/> @@ -39,10 +39,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. --> <documentElement prefix="" localName="article" typeId="DocBook"/> <documentElement prefix="" localName="book" typeId="DocBook"/> + <documentElement prefix="" localName="chapter" typeId="DocBook"/> + <documentElement prefix="" localName="part" typeId="DocBook"/> + <documentElement prefix="" localName="refentry" typeId="DocBook"/> + <documentElement prefix="" localName="section" typeId="DocBook"/> <documentElement localName="RDF" typeId="RDF"/> <documentElement prefix="rdf" typeId="RDF"/> - + <documentElement localName="locatingRules" uri="locate.rnc"/> <typeId id="XSLT" uri="xslt.rnc"/> diff --git a/lisp/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index f63440b4ea7..f63440b4ea7 100644 --- a/lisp/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el diff --git a/lisp/themes/tango-theme.el b/etc/themes/tango-theme.el index f0492c048af..f0492c048af 100644 --- a/lisp/themes/tango-theme.el +++ b/etc/themes/tango-theme.el diff --git a/lisp/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el index 848e5e95073..848e5e95073 100644 --- a/lisp/themes/wheatgrass-theme.el +++ b/etc/themes/wheatgrass-theme.el diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index 1d80f4e1191..f566df9735d 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -498,12 +498,12 @@ you save, Emacs leaves the original file under a changed name in case you later decide that your changes were a mistake. If you look near the bottom of the screen you will see a line that -begins and ends with dashes, and starts with "--:--- TUTORIAL" or -something like that. This part of the screen normally shows the name -of the file that you are visiting. Right now, you are visiting a file -called "TUTORIAL" which is your personal scratch copy of the Emacs -tutorial. When you find a file with Emacs, that file's name will -appear in that precise spot. +begins with dashes, and starts with "--:--- TUTORIAL" or something +like that. This part of the screen normally shows the name of the +file that you are visiting. Right now, you are visiting a file called +"TUTORIAL" which is your personal scratch copy of the Emacs tutorial. +When you find a file with Emacs, that file's name will appear in that +precise spot. One special thing about the command for finding a file is that you have to say what file name you want. We say the command "reads an diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index ddcdf4127ef..4cb4f2159a5 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,33 @@ +2010-11-27 Joe Matarazzo <joe.matarazzo@gmail.com> (tiny change) + + * ebrowse.c (yylex): If end of input buffer encountered while + searching for a newline after "//", return YYEOF. (Bug#7446) + +2010-11-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * emacsclient.c (set_local_socket) [DARWIN_OS]: Add fall-back + definition of _CS_DARWIN_USER_TEMP_DIR for Mac OS X 10.4 and older. + +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. + +2010-10-23 Glenn Morris <rgm@gnu.org> + + * digest-doc.c, sorted-doc.c: Remove files. + * Makefile.in (UTILITIES): Remove digest-doc and sorted-doc. + (digest-doc${EXEEXT}, sorted-doc${EXEEXT}): Remove rules. + * makefile.w32-in (ALL): Remove digest-doc and sorted-doc. + ($(BLD)/sorted-doc.exe, $(BLD)/digest-doc.exe, sorted-doc, digest-doc) + ($(BLD)/digest-doc.$(O), $(BLD)/sorted-doc.$(O)): Remove rules. + (install): Don't install digest-doc.exe or sorted-doc.exe. + 2010-10-10 Dan Nicolaescu <dann@ics.uci.edu> * Makefile.in (PROFILING_LDFLAGS): Remove, not needed. @@ -5376,10 +5406,10 @@ (main): Improve usage message. (error): Write to stderr, not stdout. - * b2m.c cvtmail.c digest-doc.c emacsclient.c emacsserver.c etags.c - fakemail.c hexl.c make-docfile.c profile.c sorted-doc.c test-distrib.c - timer.c wakeup.c yow.c: Eliminate some -Wall warnings from unused - variables and implicitly declared functions. + * b2m.c, cvtmail.c, digest-doc.c, emacsclient.c, emacsserver.c: + * etags.c, fakemail.c, hexl.c, make-docfile.c, profile.c, sorted-doc.c: + * test-distrib.c, timer.c, wakeup.c, yow.c: Eliminate some -Wall + warnings from unused variables and implicitly declared functions. 1994-10-11 Richard Stallman <rms@mole.gnu.ai.mit.edu> diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index b90b19b69b6..b9eea846dc8 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -118,8 +118,7 @@ STAMP_INST_SCRIPTS = stamp-rcs-checkin stamp-grep-changelog # Things that Emacs runs internally, or during the build process, # which should not be installed in bindir. -UTILITIES = profile${EXEEXT} digest-doc${EXEEXT} sorted-doc${EXEEXT} \ - movemail${EXEEXT} fakemail${EXEEXT} \ +UTILITIES = profile${EXEEXT} movemail${EXEEXT} fakemail${EXEEXT} \ hexl${EXEEXT} update-game-score${EXEEXT} DONT_INSTALL= test-distrib${EXEEXT} make-docfile${EXEEXT} @@ -353,12 +352,6 @@ make-docfile${EXEEXT}: ${srcdir}/make-docfile.c ../src/config.h $(CC) ${ALL_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) \ -o make-docfile -digest-doc${EXEEXT}: ${srcdir}/digest-doc.c - $(CC) ${ALL_CFLAGS} ${srcdir}/digest-doc.c $(LOADLIBES) -o digest-doc - -sorted-doc${EXEEXT}: ${srcdir}/sorted-doc.c - $(CC) ${ALL_CFLAGS} ${srcdir}/sorted-doc.c $(LOADLIBES) -o sorted-doc - movemail${EXEEXT}: movemail.o pop.o $(GETOPTDEPS) $(CC) ${LINK_CFLAGS} ${MOVE_FLAGS} movemail.o pop.o \ $(GETOPTOBJS) $(LOADLIBES) $(LIBS_MOVE) -o movemail diff --git a/lib-src/digest-doc.c b/lib-src/digest-doc.c deleted file mode 100644 index b3cb58e6d99..00000000000 --- a/lib-src/digest-doc.c +++ /dev/null @@ -1,81 +0,0 @@ -/* Give this program DOC-mm.nn.oo as standard input and it outputs to - standard output a file of nroff output containing the doc strings. - -Copyright (C) 1987, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, - 2008, 2009, 2010 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 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/>. - - -See also sorted-doc.c, which produces similar output -but in texinfo format and sorted by function/variable name. */ - -#include <stdio.h> - -#ifdef DOS_NT -#include <fcntl.h> /* for O_BINARY */ -#include <io.h> /* for setmode */ -#endif - -int -main (void) -{ - register int ch; - register int notfirst = 0; - -#ifdef DOS_NT - /* DOC is a binary file. */ - if (!isatty (fileno (stdin))) - setmode (fileno (stdin), O_BINARY); -#endif - - printf (".TL\n"); - printf ("Command Summary for GNU Emacs\n"); - printf (".AU\nRichard M. Stallman\n"); - while ((ch = getchar ()) != EOF) - { - if (ch == '\037') - { - if (notfirst) - printf ("\n.DE"); - else - notfirst = 1; - - printf ("\n.SH\n"); - - ch = getchar (); - printf (ch == 'F' ? "Function " : "Variable "); - - while ((ch = getchar ()) != '\n') /* Changed this line */ - { - if (ch != EOF) - putchar (ch); - else - { - ungetc (ch, stdin); - break; - } - } - printf ("\n.DS L\n"); - } - else - putchar (ch); - } - return 0; -} - -/* arch-tag: 2ba2c9b0-4157-4eba-bd9f-967e3677e35f - (do not change this comment) */ diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 1fcbb8662f5..81067a90819 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -1700,6 +1700,11 @@ yylex (void) case '/': while (GET (c) && c != '\n') ; + /* Don't try to read past the end of the input buffer if + the file ends in a C++ comment without a newline. */ + if (c == 0) + return YYEOF; + INCREMENT_LINENO; break; diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index b60b2661805..48ea3d22dc9 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1225,6 +1225,9 @@ set_local_socket (void) if (!tmpdir) { #ifdef DARWIN_OS +#ifndef _CS_DARWIN_USER_TEMP_DIR +#define _CS_DARWIN_USER_TEMP_DIR 65537 +#endif size_t n = confstr (_CS_DARWIN_USER_TEMP_DIR, NULL, (size_t) 0); if (n > 0) { diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index 25fb499cf3b..5591f0edbed 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -18,7 +18,7 @@ # along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -ALL = make-docfile hexl ctags etags movemail ebrowse sorted-doc digest-doc emacsclient +ALL = make-docfile hexl ctags etags movemail ebrowse emacsclient .PHONY: $(ALL) @@ -36,10 +36,6 @@ $(BLD)/hexl.exe: $(BLD)/hexl.$(O) $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/hexl.$(O) $(LIBS) $(BLD)/fakemail.exe: $(BLD)/fakemail.$(O) $(BLD)/ntlib.$(O) $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/fakemail.$(O) $(BLD)/ntlib.$(O) $(LIBS) -$(BLD)/sorted-doc.exe: $(BLD)/sorted-doc.$(O) - $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/sorted-doc.$(O) $(LIBS) -$(BLD)/digest-doc.exe: $(BLD)/digest-doc.$(O) - $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/digest-doc.$(O) $(LIBS) $(BLD)/test-distrib.exe: $(BLD)/test-distrib.$(O) $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/test-distrib.$(O) $(LIBS) @@ -50,8 +46,6 @@ ebrowse: stamp_BLD $(BLD)/ebrowse.exe hexl: stamp_BLD $(BLD)/hexl.exe movemail: stamp_BLD $(BLD)/movemail.exe fakemail: stamp_BLD $(BLD)/fakemail.exe -sorted-doc: stamp_BLD $(BLD)/sorted-doc.exe -digest-doc: stamp_BLD $(BLD)/digest-doc.exe emacsclient: stamp_BLD $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe test-distrib: stamp_BLD $(BLD)/test-distrib.exe @@ -195,7 +189,6 @@ OTHER_PLATFORM_SUPPORT = \ $(lispsource)term/pc-win.elc \ $(lispsource)x-dnd.elc \ $(lispsource)term/x-win.elc \ - $(lispsource)emacs-lisp/easymenu.elc \ $(lispsource)term/ns-win.elc @@ -335,8 +328,6 @@ install: $(INSTALL_FILES) $(CP) $(BLD)/ctags.exe $(INSTALL_DIR)/bin $(CP) $(BLD)/hexl.exe $(INSTALL_DIR)/bin $(CP) $(BLD)/movemail.exe $(INSTALL_DIR)/bin - $(CP) $(BLD)/sorted-doc.exe $(INSTALL_DIR)/bin - $(CP) $(BLD)/digest-doc.exe $(INSTALL_DIR)/bin $(CP) $(BLD)/emacsclient.exe $(INSTALL_DIR)/bin $(CP) $(BLD)/emacsclientw.exe $(INSTALL_DIR)/bin - mkdir "$(INSTALL_DIR)/etc" @@ -404,9 +395,6 @@ $(BLD)/ctags.$(O) : \ $(SRC)/ntlib.h \ $(SRC)/getopt.h -$(BLD)/digest-doc.$(O) : \ - $(SRC)/digest-doc.c - $(BLD)/emacsclient.$(O) : \ $(SRC)/emacsclient.c \ $(EMACS_ROOT)/src/s/ms-w32.h \ @@ -496,12 +484,6 @@ $(BLD)/profile.$(O) : \ $(BLD)/qsort.$(O) : \ $(SRC)/qsort.c -$(BLD)/sorted-doc.$(O) : \ - $(SRC)/sorted-doc.c \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/m/intel386.h \ - $(EMACS_ROOT)/src/config.h - $(BLD)/tcp.$(O) : \ $(SRC)/tcp.c @@ -519,8 +501,6 @@ $(BLD)/timer.$(O) : \ # $(BLD)/make-docfile.$(O) $(BLD)/hexl.$(O) $(BLD)/fakemail.$(O): stamp_BLD -$(BLD)/sorted-doc.$(O) $(BLD)/digest-doc.$(O): stamp_BLD - $(BLD)/test-distrib.$(O) $(GETOPTOBJS) $(MOVEMAILOBJS): stamp_BLD $(BLD)/emacsclient.$(O) $(BLD)/etags.$(O) $(BLD)/regex.$(O): stamp_BLD diff --git a/lib-src/sorted-doc.c b/lib-src/sorted-doc.c deleted file mode 100644 index 4fe830e4013..00000000000 --- a/lib-src/sorted-doc.c +++ /dev/null @@ -1,296 +0,0 @@ -/* Give this program DOC-mm.nn.oo as standard input and it outputs to - standard output a file of texinfo input containing the doc strings. - -Copyright (C) 1989, 1992, 1994, 1996, 1999, 2000, 2001, 2002, 2003, - 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 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/>. */ - - -/* This version sorts the output by function name. */ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <stdio.h> -#include <ctype.h> -#ifdef DOS_NT -#include <fcntl.h> /* for O_BINARY */ -#include <io.h> /* for setmode */ -#endif -#ifndef HAVE_STDLIB_H /* config.h includes stdlib. */ -#ifndef WINDOWSNT /* src/s/ms-w32.h includes stdlib.h */ -extern char *malloc (); -#endif -#endif - -#define NUL '\0' -#define MARKER '\037' - -#define DEBUG 0 - -typedef struct line LINE; - -struct line -{ - LINE *next; /* ptr to next or NULL */ - char *line; /* text of the line */ -}; - -typedef struct docstr DOCSTR; - -struct docstr /* Allocated thing for an entry. */ -{ - DOCSTR *next; /* next in the chain */ - char *name; /* name of the function or var */ - LINE *first; /* first line of doc text. */ - char type; /* 'F' for function, 'V' for variable */ -}; - - -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ - -void -error (const char *s1, const char *s2) -{ - fprintf (stderr, "sorted-doc: "); - fprintf (stderr, s1, s2); - fprintf (stderr, "\n"); -} - -/* Print error message and exit. */ - -void -fatal (const char *s1, const char *s2) -{ - error (s1, s2); - exit (EXIT_FAILURE); -} - -/* Like malloc but get fatal error if memory is exhausted. */ - -char * -xmalloc (int size) -{ - char *result = malloc ((unsigned)size); - if (result == NULL) - fatal ("%s", "virtual memory exhausted"); - return result; -} - -char * -xstrdup (const char *str) -{ - char *buf = xmalloc (strlen (str) + 1); - (void) strcpy (buf, str); - return (buf); -} - -/* Comparison function for qsort to call. */ - -int -cmpdoc (const void *va, const void *vb) -{ - DOCSTR *const *a = va; - DOCSTR *const *b = vb; - register int val = strcmp ((*a)->name, (*b)->name); - if (val) return val; - return (*a)->type - (*b)->type; -} - -enum state -{ - WAITING, BEG_NAME, NAME_GET, BEG_DESC, DESC_GET -}; - -const char *states[] = -{ - "WAITING", "BEG_NAME", "NAME_GET", "BEG_DESC", "DESC_GET" -}; - -int -main (void) -{ - register DOCSTR *dp = NULL; /* allocated DOCSTR */ - register LINE *lp = NULL; /* allocated line */ - register char *bp; /* ptr inside line buffer */ - register enum state state = WAITING; /* state at start */ - int cnt = 0; /* number of DOCSTRs read */ - - DOCSTR *docs = NULL; /* chain of allocated DOCSTRS */ - char buf[512]; /* line buffer */ - -#ifdef DOS_NT - /* DOC is a binary file. */ - if (!isatty (fileno (stdin))) - setmode (fileno (stdin), O_BINARY); -#endif - - bp = buf; - - while (1) /* process one char at a time */ - { - /* this char from the DOCSTR file */ - register int ch = getchar (); - - /* Beginnings */ - - if (state == WAITING) - { - if (ch == MARKER) - state = BEG_NAME; - } - else if (state == BEG_NAME) - { - cnt++; - if (dp == NULL) /* first dp allocated */ - { - docs = dp = (DOCSTR*) xmalloc (sizeof (DOCSTR)); - } - else /* all the rest */ - { - dp->next = (DOCSTR*) xmalloc (sizeof (DOCSTR)); - dp = dp->next; - } - lp = NULL; - dp->next = NULL; - bp = buf; - state = NAME_GET; - /* Record whether function or variable. */ - dp->type = ch; - ch = getchar (); - } - else if (state == BEG_DESC) - { - if (lp == NULL) /* first line for dp */ - { - dp->first = lp = (LINE*)xmalloc (sizeof (LINE)); - } - else /* continuing lines */ - { - lp->next = (LINE*)xmalloc (sizeof (LINE)); - lp = lp->next; - } - lp->next = NULL; - bp = buf; - state = DESC_GET; - } - - /* process gets */ - - if (state == NAME_GET || state == DESC_GET) - { - if (ch != MARKER && ch != '\n' && ch != EOF) - { - *bp++ = ch; - } - else /* saving and changing state */ - { - *bp = NUL; - bp = xstrdup (buf); - - if (state == NAME_GET) - dp->name = bp; - else - lp->line = bp; - - bp = buf; - state = (ch == MARKER) ? BEG_NAME : BEG_DESC; - } - } /* NAME_GET || DESC_GET */ - if (ch == EOF) - break; - } - - { - DOCSTR **array; - register int i; /* counter */ - - /* build array of ptrs to DOCSTRs */ - - array = (DOCSTR**)xmalloc (cnt * sizeof (*array)); - for (dp = docs, i = 0; dp != NULL ; dp = dp->next) - array[i++] = dp; - - /* sort the array by name; within each name, by type */ - - qsort ((char*)array, cnt, sizeof (DOCSTR*), cmpdoc); - - /* write the output header */ - - printf ("\\input texinfo @c -*-texinfo-*-\n"); - printf ("@setfilename ../info/summary\n"); - printf ("@settitle Command Summary for GNU Emacs\n"); - printf ("@finalout\n"); - printf ("@unnumbered Command Summary for GNU Emacs\n"); - printf ("@table @asis\n"); - printf ("\n"); - printf ("@iftex\n"); - printf ("@global@let@ITEM@item\n"); - printf ("@def@item{@filbreak@vskip5pt@ITEM}\n"); - printf ("@font@tensy cmsy10 scaled @magstephalf\n"); - printf ("@font@teni cmmi10 scaled @magstephalf\n"); - printf ("@def\\{{@tensy@char110}}\n"); /* this backslash goes with cmr10 */ - printf ("@def|{{@tensy@char106}}\n"); - printf ("@def@{{{@tensy@char102}}\n"); - printf ("@def@}{{@tensy@char103}}\n"); - printf ("@def<{{@teni@char62}}\n"); - printf ("@def>{{@teni@char60}}\n"); - printf ("@chardef@@64\n"); - printf ("@catcode43=12\n"); - printf ("@tableindent-0.2in\n"); - printf ("@end iftex\n"); - - /* print each function from the array */ - - for (i = 0; i < cnt; i++) - { - printf ("\n@item %s @code{%s}\n@display\n", - array[i]->type == 'F' ? "Function" : "Variable", - array[i]->name); - - for (lp = array[i]->first; lp != NULL ; lp = lp->next) - { - for (bp = lp->line; *bp; bp++) - { - /* the characters "@{}" need special treatment */ - if (*bp == '@' || *bp == '{' || *bp == '}') - { - putchar('@'); - } - putchar(*bp); - } - putchar ('\n'); - } - printf("@end display\n"); - /* Try to avoid a save size overflow in the TeX output - routine. */ - if (i%100 == 0 && i > 0 && i != cnt) - printf("\n@end table\n@table @asis\n"); - } - - printf ("@end table\n"); - printf ("@bye\n"); - } - - return EXIT_SUCCESS; -} - -/* arch-tag: ce28f204-1e70-4b34-8210-3d54a5662071 - (do not change this comment) */ - -/* sorted-doc.c ends here */ diff --git a/lib-src/test-distrib.c b/lib-src/test-distrib.c index 1487c2bab57..aca46f121fa 100644 --- a/lib-src/test-distrib.c +++ b/lib-src/test-distrib.c @@ -19,24 +19,14 @@ You should have received a copy of the GNU General Public License 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 @@ int cool_read (int fd, char *buf, size_t size) { ssize_t num; - size_t sofar = 0; + ssize_t sofar = 0; while (1) { diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11 index 2543ce03b6f..5b9fa028a9d 100644 --- a/lisp/ChangeLog.11 +++ b/lisp/ChangeLog.11 @@ -11494,7 +11494,7 @@ * net/zone-mode.el (zone-mode): Use write-file-functions, not write-file-hooks. -2003-12-29 Eric Hanchrow <offby1@blarg.net> (tiny change) +2003-12-29 Eric Hanchrow <offby1@blarg.net> * autorevert.el (auto-revert-interval): Doc fix. @@ -12922,7 +12922,7 @@ * emacs-lisp/tq.el (tq-create): Fix mixed up unquote style. -2003-09-12 Eric Hanchrow <offby1@blarg.net> (tiny change) +2003-09-12 Eric Hanchrow <offby1@blarg.net> * dired.el (dired-mode-map): Fix typo. diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index aff7f54d68d..5c343602fbc 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -2528,7 +2528,7 @@ * files.el (find-alternate-file): Revert query message to Emacs 21 version. -2007-01-20 Eric Hanchrow <offby1@blarg.net> (tiny change) +2007-01-20 Eric Hanchrow <offby1@blarg.net> * progmodes/cperl-mode.el (cperl-electric-keywords): Document in the doc string how to use personal abbrevs without electric keywords. @@ -7791,7 +7791,7 @@ * textmodes/table.el: Add move-beginning-of-line and move-end-of-line to Point Motion Only Group. -2006-07-22 Eric Hanchrow <offby1@blarg.net> (tiny change) +2006-07-22 Eric Hanchrow <offby1@blarg.net> * progmodes/delphi.el (delphi-fill-comment): Use save-restriction. @@ -12997,8 +12997,8 @@ 2006-02-13 Mathias Dahl <mathias.dahl@gmail.com> - * tumme.el: Remove history section. If someone needs the it, it - can always be found in CVS. + * tumme.el: Remove history section. If someone needs it, it can + always be found in CVS. 2006-02-12 Mathias Dahl <mathias.dahl@gmail.com> @@ -20588,7 +20588,7 @@ * progmodes/gud.el (gud-speedbar-menu-items): Use :visible instead of :active. -2005-10-08 Eric Hanchrow <offby1@blarg.net> (tiny change) +2005-10-08 Eric Hanchrow <offby1@blarg.net> * textmodes/ispell.el (ispell-check-version): Ignore hyphen, and all that follows, in aspell's version text. @@ -29165,7 +29165,7 @@ * jit-lock.el (jit-lock-stealth-time): Change default value to 16. (jit-lock-stealth-nice): Change default value to 0.5. -2005-04-23 Eric Hanchrow <offby1@blarg.net> (tiny change) +2005-04-23 Eric Hanchrow <offby1@blarg.net> * abbrev.el (write-abbrev-file): Write table entries in alphabetical order by table name. diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13 index e35e0bf5fa6..2607bb9b39f 100644 --- a/lisp/ChangeLog.13 +++ b/lisp/ChangeLog.13 @@ -6680,8 +6680,9 @@ buffer if the parent buffer is in vc-dired-mode. 2007-11-23 Mark A. Hershberger <mah@everybody.org> + James Clark <none@example.com> - * nxml: Initial merge of nxml. Kept nxml/char-name subdir for now. + * nxml/: Initial merge of nxml. Kept nxml/char-name subdir for now. 2007-11-23 Juri Linkov <juri@jurta.org> @@ -13493,7 +13494,7 @@ * menu-bar.el (menu-bar-vc-filter): New function. (menu-bar-tools-menu): Use it as a filter. -2007-08-01 Eric Hanchrow <offby1@blarg.net> (tiny change) +2007-08-01 Eric Hanchrow <offby1@blarg.net> * ibuf-ext.el (ibuffer-mark-old-buffers): Docstring fix. @@ -16693,10 +16694,9 @@ See ChangeLog.12 for earlier changes. ;; Local Variables: ;; coding: utf-8 -;; add-log-time-zone-rule: t ;; End: - Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16712,5 +16712,3 @@ See ChangeLog.12 for earlier changes. 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: 1e8aa93a-fc6c-4ac3-9b10-1f445e1840af diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index 436ab6b6759..75d62faf6bc 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -2148,7 +2148,7 @@ * emacs-lisp/find-func.el (find-library-name, find-library): Doc fixes. (Part of bug#2270) -2009-02-10 Eric Hanchrow <eric.hanchrow@gmail.com> (tiny change) +2009-02-10 Eric Hanchrow <eric.hanchrow@gmail.com> * env.el (getenv): When FRAME is non-nil, pass the frame environment to `getenv-internal', not the frame. (Bug#2259) @@ -6518,7 +6518,7 @@ (hl-line-unhighlight, global-hl-line-unhighlight): Use `when'. (hl-line-sticky-flag): Remove spurious * in docstring. -2008-10-14 Eric Hanchrow <offby1@blarg.net> (tiny change) +2008-10-14 Eric Hanchrow <offby1@blarg.net> * vc-git.el (vc-git-show-log-entry): Include the revision in the search string. diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index 89d532f4c69..6d9cbbeeabb 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -1034,8 +1034,8 @@ 2001-09-18 Eli Zaretskii <eliz@is.elta.co.il> * dired.el (dired-move-to-filename-regexp): Allow one digit in the - numeric month value, and allow the Kanji character after the it to - be missing (happens with ls-lisp's output on Japanese versions of + numeric month value, and allow the Kanji character after it to be + missing (happens with ls-lisp's output on Japanese versions of MS-Windows). 2001-09-18 Miles Bader <miles@gnu.org> diff --git a/lisp/ChangeLog.trunk b/lisp/ChangeLog.trunk index 63f1e946d31..93dcc72214e 100644 --- a/lisp/ChangeLog.trunk +++ b/lisp/ChangeLog.trunk @@ -1,15 +1,2375 @@ +2010-12-10 Stefan Monnier <monnier@iro.umontreal.ca> + + Derive from prog-mode, use derived-mode-p, and fix up various + minor style issues in lisp/progmodes. + + * progmodes/vhdl-mode.el (vhdl-mode): + * progmodes/verilog-mode.el (verilog-mode): + * progmodes/vera-mode.el (vera-mode): + * progmodes/sql.el (sql-mode): + * progmodes/scheme.el (scheme-mode): + * progmodes/perl-mode.el (perl-mode): + * progmodes/octave-inf.el (inferior-octave-mode): + * progmodes/autoconf.el (autoconf-mode): + * progmodes/m4-mode.el (m4-mode): + * progmodes/inf-lisp.el (inferior-lisp-mode): + * progmodes/idlwave.el (idlwave-mode): + * progmodes/icon.el (icon-mode): + * progmodes/idlw-help.el (idlwave-help-mode): + * progmodes/dcl-mode.el (dcl-mode): + * progmodes/idlw-shell.el (idlwave-shell-mode): + * progmodes/ebrowse.el (ebrowse-tree-mode, ebrowse-electric-list-mode) + (ebrowse-member-mode, ebrowse-electric-position-mode): + Use define-derived-mode. + + * progmodes/xscheme.el (exit-scheme-interaction-mode) + (xscheme-enter-interaction-mode, xscheme-enter-debugger-mode) + (xscheme-debugger-mode-p, xscheme-send-string-1): + * progmodes/tcl.el (inferior-tcl-proc, tcl-current-word) + (tcl-load-file, tcl-restart-with-file): + * progmodes/ps-mode.el (ps-run-running): + * progmodes/gdb-mi.el (gud-watch, gdb-mouse-set-clear-breakpoint): + * progmodes/js.el (js--get-all-known-symbols): + * progmodes/inf-lisp.el (inferior-lisp-proc): + * progmodes/idlwave.el (idlwave-beginning-of-statement) + (idlwave-template, idlwave-update-buffer-routine-info) + (idlwave-update-current-buffer-info) + (idlwave-get-routine-info-from-buffers, idlwave-choose) + (idlwave-scan-class-info, idlwave-fix-keywords) + (idlwave-list-buffer-load-path-shadows): + * progmodes/idlw-toolbar.el (idlwave-toolbar, idlwave-toolbar-add) + (idlwave-toolbar-remove): + * progmodes/idlw-shell.el (idlwave-shell-save-and-action) + (idlwave-shell-file-name, idlwave-shell-electric-debug-all-off) + (idlwave-shell-menu-def): + * progmodes/idlw-complete-structtag.el + (idlwave-prepare-structure-tag-completion): + * progmodes/gud.el (gud-set-buffer): + * progmodes/f90.el (f90-backslash-not-special): + * progmodes/delphi.el (delphi-find-unit): Use derived-mode-p. + + * progmodes/xscheme.el (xscheme-start) + (local-set-scheme-interaction-buffer, scheme-interaction-mode): + * progmodes/which-func.el (which-function): + * progmodes/vhdl-mode.el (vhdl-set-style): + * progmodes/verilog-mode.el (verilog-set-compile-command) + (verilog-modify-compile-command, verilog-error-regexp-add-xemacs) + (verilog-set-define, verilog-auto-reeval-locals): + * progmodes/sql.el (sql-product-font-lock, sql-interactive-mode): + * progmodes/simula.el (simula-mode): + * progmodes/scheme.el (scheme-mode-variables, dsssl-mode): + * progmodes/python.el (python-check, python-mode): + * progmodes/prolog.el (prolog-mode-variables): + * progmodes/gud.el (gud-tooltip-activate-mouse-motions): + * progmodes/ebrowse.el (ebrowse-view-file-other-frame): + * progmodes/delphi.el (delphi-mode): + * progmodes/cc-styles.el (c-setup-paragraph-variables): + * progmodes/cc-mode.el (c-basic-common-init, c-common-init) + (c-font-lock-init): Move make-local-variable to their setq. + + * progmodes/vhdl-mode.el (vhdl-write-file-hooks-init) + (vhdl-hs-minor-mode, vhdl-ps-print-init): Fix make-local-variable -> + make-local-hook. + * progmodes/sh-script.el (sh-require-final-newline): Remove. + (sh-set-shell): Don't set require-final-newline since it's already done + by prog-mode. + * progmodes/modula2.el (m2-mode): Don't make m2-end-comment-column + since we never set it. + * progmodes/ebrowse.el (ebrowse-set-tree-indentation): + Use read-string and standard prompt. + * progmodes/dcl-mode.el (dcl-mode-map): Move init into declaration. + * progmodes/meta-mode.el (meta-mode-abbrev-table): Merge init and decl. + (meta-common-mode-syntax-table): Rename from meta-mode-syntax-table. + (meta-common-mode-map): Rename from meta-mode-map. + Remove C-m binding, which is a user preference, not mode specific. + (meta-common-mode): New major mode; replace meta-common-initialization. + * progmodes/js.el (js-mode): Call syntax-propertize rather than messing + around with font-lock. + * progmodes/etags.el (select-tags-table-mode): + Derive from special-mode. + * progmodes/octave-mod.el (octave-mode): + * progmodes/gdb-mi.el (gdb-inferior-io-mode, gdb-threads-mode) + (gdb-memory-mode, gdb-disassembly-mode, gdb-breakpoints-mode) + (gdb-frames-mode, gdb-locals-mode, gdb-registers-mode): + Let define-derived-mode do its job. + * progmodes/cpp.el (cpp-edit-mode-map): + Move initialization into declaration. + (cpp-edit-mode): Use define-derived-mode. + (cpp-edit-load): Use derived-mode-p. + * progmodes/mixal-mode.el (mixal-mode): + * progmodes/f90.el (f90-mode): + * progmodes/cfengine.el (cfengine-mode): Don't bother setting + require-final-newline since prog-mode does it already. + * progmodes/cc-cmds.el (c-update-modeline): Use match-string. + * progmodes/asm-mode.el (asm-mode-map): Fix menu setup. + * progmodes/antlr-mode.el: Require cc-mode upfront. + (antlr-mode-syntax-table, antlr-action-syntax-table): Initialize in + the declaration. + (antlr-directory-dependencies, antlr-show-makefile-rules): + Use derived-mode-p. + (antlr-language-option): Don't assume point-min==1. + (antlr-mode): Use define-derived-mode. + * progmodes/ada-mode.el: Use derived-mode-p. + (ada-mode): Use define-derived-mode. + Use hack-local-variables-hook. + +2010-12-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/texinfo.el (texinfo-mode-map): Bind texinfo-insert-@end. + (texinfo-mode): Don't disable adaptive-fill-mode. + (texinfo-insert-block): Adjust cursor placement for blocks with arg. + (texinfo-insert-@end, texinfo-insert-braces, texinfo-insert-@code) + (texinfo-insert-@dfn, texinfo-insert-@email, texinfo-insert-@emph) + (texinfo-insert-@example, texinfo-insert-@file, texinfo-insert-@item) + (texinfo-insert-@kbd, texinfo-insert-@node, texinfo-insert-@noindent) + (texinfo-insert-@quotation, texinfo-insert-@samp) + (texinfo-insert-@strong, texinfo-insert-@table, texinfo-insert-@var) + (texinfo-insert-@uref): Use define-skeleton. + (texinfo-insert-@-with-arg): Delete. + +2010-12-10 Eli Zaretskii <eliz@gnu.org> + + * arc-mode.el (archive-zip-extract): If w32-quote-process-args is + nil, do quote archive member names. (Bug#6144) + +2010-12-10 Glenn Morris <rgm@gnu.org> + + * files.el (diff-no-select): Declare. + + * mail/emacsbug.el (report-emacs-bug): Use mail-user-agent properties. + (report-emacs-bug-create-existing-bugs-buffer): Avoid free variables. + + * comint.el (comint-input-ring-file-name): Doc fix. + +2010-12-09 Eli Zaretskii <eliz@gnu.org> + + * menu-bar.el (menu-bar-frame-for-menubar, menu-bar-positive-p): + New functions. + (menu-bar-showhide-menu) <menu-bar-mode, showhide-tool-bar>: + Use them instead of `nil' and `>', respectively. + (menu-bar-showhide-tool-bar-menu): Use menu-bar-frame-for-menubar + instead of `nil'. + (toggle-menu-bar-mode-from-frame): Use menu-bar-frame-for-menubar + and menu-bar-positive-p instead of `nil' and `>', respectively. + (Bug#1077) + +2010-12-09 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * whitespace.el (whitespace-newline-mode): Code fix. + +2010-12-09 Glenn Morris <rgm@gnu.org> + + * play/landmark.el (lm-print-y,s,noise-int, lm-print-y,s,noise): + Rename functions without commas, update callers. + +2010-12-08 Jeff Dairiki <dairiki@dairiki.org> (tiny change) + + * whitespace.el (whitespace-cleanup-region): + Clean up spaces before tabs. (Bug#7582) + +2010-12-08 Karl Fogel <kfogel@red-bean.com> + + * bookmark.el: Adjust parameter names and doc strings to resolve + confusion over whether "bookmark" meant a bookmark name or a + bookmark record. Along the way, shorten one function's name for + similar reasons. (Issue #7548) + (bookmark-name-from-record): New name for + `bookmark-name-from-full-record'. All callers changed. + (bookmark-get-bookmark, bookmark-get-bookmark-record) + (bookmark-default-annotation-text, bookmark-prop-get, bookmark-prop-set) + (bookmark-get-annotation, bookmark-set-annotation) + (bookmark-get-filename, bookmark-set-filename) + (bookmark-get-position, bookmark-set-position) + (bookmark-get-front-context-string, bookmark-set-front-context-string) + (bookmark-get-rear-context-string, bookmark-set-rear-context-string) + (bookmark-get-handler, bookmark-edit-annotation, bookmark--jump-via) + (bookmark-handle-bookmark, bookmark-location, bookmark-show-annotation): + Rename `bookmark' parameter to `bookmark-name-or-record', to + clearly show its role, and shorten or adjust doc strings accordingly. + (bookmark-set-name): Same, and pass the parameter directly to + `bookmark-get-bookmark' instead of redundantly doing the callee's work. + (bookmark-default-annotation-text, bookmark-send-edited-annotation) + (bookmark-relocate, bookmark-insert-location, bookmark-insert) + (bookmark-delete): Rename `bookmark' parameter to `bookmark-name', + and in some cases shorten doc string accordingly. + (bookmark-rename): Change `old' and `new' parameters to `old-name' + and `new-name', and adjust an internal variable to avoid confusion. + (bookmark-jump, bookmark-jump-noselect): Clarify `bookmark' + parameter in doc string. + +2010-12-08 Glenn Morris <rgm@gnu.org> + + * progmodes/gdb-mi.el (gdb): Try to initialize comint input history + from gdb's history file. (Bug#7575) + + * mail/emacsbug.el (report-emacs-bug): + Try to handle some other mail clients. + +2010-12-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (dir-locals-collect-variables): Don't let errors stop us. + Use string-prefix-p. + (file-name-version-regexp): New var. + (file-name-sans-versions): + * jka-cmpr-hook.el (jka-compr-build-file-regexp): Use it, + (jka-compr-get-compression-info): Use dolist. + (jka-compr-compression-info-list): Don't bother specifying + version/backup regexps. + +2010-12-07 Tassilo Horn <tassilo@member.fsf.org> + + * simple.el (just-one-space): Make argument n default to 1 if + omitted. + +2010-12-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * electric.el (electric-indent-post-self-insert-function): + Delete trailing newlines even if we don't reindent. + +2010-12-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion-at-point): Remove the `arg'. + * bindings.el (complete-symbol): Move back from minibuffer.el. + +2010-12-06 Deniz Dogan <deniz.a.m.dogan@gmail.com> + + * simple.el (just-one-space): Delete newlines for negative arg. + +2010-12-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * ansi-color.el (ansi-color-unfontify-region): Replace by trivial def. + (ansi-color-filter-apply): Simplify. + (ansi-color-apply): Use `font-lock-face' rather than `face'. + +2010-12-05 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> + + * vc/vc-dir.el (vc-dir-query-replace-regexp): Doc fix (Bug#7501). + +2010-12-04 Chong Yidong <cyd@stupidchicken.com> + + * dired.el (dired-use-ls-dired): Set default to a special + "unspecified" value. + (dired-insert-directory): When called the first time, check + whether "ls --dired" succeeds and set dired-use-ls-dired (Bug#7546). + +2010-12-04 Tak Ota <Takaaki.Ota@am.sony.com> + + * replace.el: Add "collect" feature to occur. + (occur-collect-regexp-history): New var. + (occur-read-primary-args): Return a replace string for nlines, + if needed. + (occur): Extend the meaning of nlines. + +2010-12-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/which-func.el (which-func-ff-hook): Log the error message. + (which-func-update-1): Distinguish symbols from strings. + (which-function): Stay within 80 columns. + +2010-12-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (with-demoted-errors): Distinguish symbols from strings. + + * newcomment.el (comment-styles): Add docs to each style (bug#7509). + Improve docstring. + (comment-style): Use comment-styles's docs to describe values. + +2010-12-03 Jan Djärv <jan.h.d@swipnet.se> + + * term/common-win.el (x-setup-function-keys): Restore ns-new-frame + and ns-show-prefs (Bug#7535). + + * term/ns-win.el (global-map): Restore ns-new-frame and ns-show-prefs + bindings (Bug#7535). + +2010-12-03 Glenn Morris <rgm@gnu.org> + + * nxml/nxml-mode.el: Require rng-nxml. + (rng-nxml-mode-init, nxml-enable-unicode-char-name-sets): + Remove declarations. + + * nxml/nxml-mode.el, nxml/nxml-outln.el, nxml/rng-loc.el: + * nxml/rng-nxml.el, nxml/rng-valid.el: + Remove leading `*' from defcustom docs. + + * startup.el (normal-top-level-add-subdirs-to-load-path): Simplify. + (normal-top-level-add-to-load-path, tty-handle-args): + Convert comments to basic doc-strings. + + * net/browse-url.el (browse-url-url-at-point) + (browse-url-default-browser): Remove autoload cookies. + + * mail/emacsbug.el (report-emacs-bug-create-existing-bugs-buffer): + Remove more undefined cl functions. + + * vc/diff.el (diff-sentinel): Make new arguments optional. + * ibuf-ext.el (diff-sentinel): Update declaration. + +2010-12-03 Daiki Ueno <ueno@unixuser.org> + + * epg.el (epg-digest-algorithm-alist): Replace "RMD160" with + "RIPEMD160" (Bug#7490). Reported by Daniel Kahn Gillmor. + (epg-context-set-passphrase-callback): Mention that the callback + is not called when used with GnuPG 2.x. + +2010-12-02 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-local-host-regexp): Add "localhost6". + (tramp-file-name-port): Check also for `tramp-default-port'. + (tramp-get-connection-name): New defun. + (tramp-get-connection-process): Use it. + (tramp-debug-message): Extend function exclude list. + (tramp-drop-volume-letter): Fix doc string. + + * net/tramp-cmds.el: Remove solved todo item. + + * net/tramp-efs.el: + * net/tramp-ftp.el: + * net/tramp-gvfs.el: + * net/tramp-gw.el: + * net/tramp-imap.el: + * net/tramp-smb.el: Fix regexps added to `tramp-default-method-alist' + and `tramp-default-user-alist', respectively. + + * net/tramp-gw.el (tramp-gw-open-connection): + Use `tramp-get-connection-name' and `tramp-get-connection-buffer'. + + * net/tramp-imap.el (tramp-imap-make-iht): Use just + `tramp-file-name-port'. + + * net/tramp-sh.el (tramp-methods): Add recursive options to "pscp" + and "psftp". Exchange "%k" marker with options. + (tramp-do-copy-or-rename-file, tramp-sh-handle-file-local-copy): + Compute size of link target. + (tramp-do-copy-or-rename-file-out-of-band). Move setting of + `tramp-current-*' up due to gateway methods. Optimze computing of + copy arguments. Use `tramp-get-connection-name' and + `tramp-get-connection-buffer'. Improve debug messages. + (tramp-compute-multi-hops): Remove port determination. + (tramp-maybe-open-connection): Use `tramp-get-connection-name'. + + * net/trampver.el: Update release number. + +2010-12-02 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl-macs.el (cl-parse-loop-clause): + Avoid infinite loop over windows. (Bug#7492) + + * progmodes/flymake.el (flymake-check-file-limit): + Allow nil to mean "no limit". + (flymake-check-patch-master-file-buffer): Update for above change. + Allow a .tex file-name extension to be optional. + (flymake-master-tex-init): Also match \include statements. + +2010-11-30 Sam Steingold <sds@gnu.org> + + * nxml/nxml-mode.el (nxml-parent-document): Add a variable. + (nxml-parent-document-set): A function to set `nxml-parent-document'. + (nxml-mode): Define using `define-derived-mode' instead of `defun'. + (nxml-mode-hook): Remove `defcustom' (auto-defined by + define-derived-mode'). + * nxml/rng-valid.el (rng-dtd-trivial-p): Add a helper function for + users who want to call `nxml-parent-document-set'. + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * log-edit.el (log-edit-font-lock-keywords): Don't try matching + stand-alone lines, since that is handled by log-edit-match-to-eoh + (Bug#6465). + +2010-11-27 Eduard Wiebe <usenet@pusto.de> + + * dired.el (dired-get-filename): Replace backslashes with slashes + in file names on MS-Windows, needed by `locate'. (Bug#7308) + * locate.el (locate-default-make-command-line): Don't consider + drive letter and root directory part of + `directory-listing-before-filename-regexp'. (Bug#7308) + (locate-post-command-hook, locate-post-command-hook): New defcustoms. + +2010-11-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-prec2->grammar): Simplify handling + of :smie-open/close-alist. + (smie-next-sexp): Make it accept a "start token" as argument. + (smie-indent-keyword): Be careful not to misidentify tokens that span + more than one line, as empty lines. Add argument `token'. + +2010-11-27 Kenichi Handa <handa@m17n.org> + + * mail/rmailmm.el (rmail-mime-insert-multipart): For unsupported + multipart subtypes, insert all as usual. + + * mail/rmail.el: Require rfc2047. + +2010-11-27 Kenichi Handa <handa@m17n.org> + + * mail/rmailmm.el (rmail-mime-entity, rmail-mime-entity-type) + (rmail-mime-entity-disposition) + (rmail-mime-entity-transfer-encoding, rmail-mime-entity-header) + (rmail-mime-entity-body, rmail-mime-entity-children): New functions. + (rmail-mime-save): Handle the case that the button's `data' is a + MIME entity. + (rmail-mime-insert-text): New function. + (rmail-mime-insert-image): Handle the case that DATA is a MIME + entity. + (rmail-mime-bulk-handler): Just call rmail-mime-insert-bulk. + (rmail-mime-insert-bulk): New function mostly copied from the old + rmail-mime-bulk-handler. + (rmail-mime-multipart-handler): Just call + rmail-mime-process-multipart. + (rmail-mime-process-multipart): New funciton mostly copied from + the old rmail-mime-multipart-handler. + (rmail-mime-show): Just call rmail-mime-process. + (rmail-mime-process): New funciton mostly copied from the old + rmail-mime-show. + (rmail-mime-insert-multipart, rmail-mime-parse) + (rmail-mime-insert, rmail-show-mime) + (rmail-insert-mime-forwarded-message) + (rmail-insert-mime-resent-message): New functions. + (rmail-insert-mime-forwarded-message-function): Set to + rmail-insert-mime-forwarded-message. + (rmail-insert-mime-resent-message-function): Set to + rmail-insert-mime-resent-message. + + * mail/rmailsum.el: Require rfc2047. + (rmail-header-summary): Handle multiline Subject: field. + (rmail-summary-line-decoder): Change the default to + rfc2047-decode-string. + + * mail/rmail.el (rmail-enable-mime): Change the default to t. + (rmail-mime-feature): Change the default to `rmailmm'. + (rmail-quit): Delete the specifal code for rmail-enable-mime. + (rmail-display-labels): Likewise. + (rmail-show-message-1): Check rmail-enable-mime, and use + rmail-show-mime-function for a MIME message. Decode the headers + according to RFC2047. + +2010-11-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/which-func.el (which-func-imenu-joiner-function): + Return a string, as expected. + (which-function-mode): Make sure we stop any previous timer before + starting a new one. + +2010-11-27 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-default-method-alist) + (tramp-default-user-alist, tramp-default-proxies-alist): + Adapt custom options type. (Bug#7445) + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/python.el: Add Ipython support (Bug#5390). + (python-shell-prompt-alist) + (python-shell-continuation-prompt-alist): New options. + (python--set-prompt-regexp): New function. + (inferior-python-mode, run-python, python-shell): + Require ansi-color. Use python--set-prompt-regexp to set the comint + prompt based on the Python interpreter. + (python--prompt-regexp): New var. + (python-check-comint-prompt) + (python-comint-output-filter-function): Use it. + (run-python): Use a pipe (Bug#5694). + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/python.el (run-python): Doc fix. + (python-keep-current-directory-in-path): New var (Bug#7454). + +2010-11-27 Chong Yidong <cyd@stupidchicken.com> + + * lpr.el (lpr-buffer, print-buffer, lpr-region, print-region): + Prompt user before actually printing. + +2010-11-27 Glenn Morris <rgm@gnu.org> + + * startup.el (package-enable-at-startup, package-initialize): + Remove unnecessary declarations. + +2010-11-27 Eli Zaretskii <eliz@gnu.org> + + * international/characters.el (glyphless-char-display-control): + Exclude newline and TAB from the c0-control group. + +2010-11-27 Glenn Morris <rgm@gnu.org> + + * mail/sendmail.el (build-mail-aliases): Doc fix for autoload. + (expand-mail-aliases): Remove unnecessary autoload. + + * allout.el (allout-command-prefix, allout-mode-map): Declare. + + * shell.el (shell-dir-cookie-re): Move definition before use. + + * mail/emacsbug.el (report-emacs-bug-create-existing-bugs-buffer): + Replace undefined CL functions. + +2010-11-26 Eli Zaretskii <eliz@gnu.org> + + * simple.el (prog-mode): Set bidi-paragraph-direction to + left-to-right. + + * term/pc-win.el (x-get-selection-internal): Emulation for MS-DOS. + +2010-11-26 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-outlook-format-1): New function, so that + diary-outlook-formats can be sensitive to calendar-date-style. + (diary-outlook-formats): Simplify the default setting. + (diary-from-outlook-internal): Pass subject and body as arguments. + Use dolist rather than dotimes. Don't save the diary buffer. + (diary-from-outlook-gnus, diary-from-outlook-rmail): + Pass subject and body as explicit arguments to the -internal function. + +2010-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail/rfc2368.el (rfc2368-parse-mailto-url): Unfold URLs before + parsing them. This makes mailto:...?subject=foo\nbar work. + +2010-11-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/diff.el (diff): Fix last change. + +2010-11-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el: Improve pcase-let. Use "pcase--" prefix. + (pcase--dontcare-upats): New var. + (pcase-let, pcase-let*): Generate better code. + Accept the same bodies as `let'. + (pcase-dolist): New macro. + (pcase--trivial-upat-p): New helper function. + (pcase--expand): Strip leading "(let nil" if any. + +2010-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail/mailclient.el (browse-url): Require. + (mailclient-send-it): Bind `browse-url-mailto-function' to nil to + use the external browser function to send the mail (bug#7469). + + * net/browse-url.el (browse-url-browser-function): Revert the + default back to the previous value, since the new value broke + mailclient.el. + (browse-url-mailto-function): New variable for mailto: URLs. + (browse-url): Use the new variable for mailto: URLs. + +2010-11-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * eshell/esh-cmd.el (eshell-parse-command): + * eshell/esh-arg.el (eshell-parse-arguments): + * eshell/em-script.el (eshell-source-file): + Use with-silent-modifications. + +2010-11-23 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc.el (vc-merge): Remove optional arg PROMPT. Always prompt + for a merge location. + + * vc/vc-bzr.el (vc-bzr-pull): Remove unused var. + (vc-bzr-merge-branch): Always prompt. + (vc-bzr-async-command): Use the full branch filename. + +2010-11-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * shell.el (shell): Use current-buffer by default if it's already + a shell mode buffer and its process is dead. + Suggested by Jose E. Marchesi <jemarch@gnu.org>. + +2010-11-23 Tassilo Horn <tassilo@member.fsf.org> + + * mail/emacsbug.el (report-emacs-bug-query-existing-bugs): + Mention that the keywords should be comma separated. + +2010-11-23 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc.el (vc-merge): Use vc-BACKEND-merge-branch if available. + Accept optional prefix arg meaning to prompt for a command. + (vc-update): Use vc-BACKEND-pull if available. Accept optional + prefix arg meaning to prompt for a command. + (vc-pull): Alias for vc-update. + + * vc/vc-bzr.el (vc-bzr-admin-branchconf, vc-bzr-history): New vars. + (vc-bzr--branch-conf, vc-bzr-async-command, vc-bzr-pull) + (vc-bzr-merge-branch): New functions, implementing merge-branch + and pull operations. + +2010-11-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * Makefile.in: Fix up last merge. + + * vc/diff.el (diff-old-temp-file, diff-new-temp-file): Remove. + (diff-sentinel): Get them as arguments instead. + (diff-old-file, diff-new-file, diff-extra-args): Remove. + (diff-file-local-copy, diff-better-file-name): New funs. + (diff-no-select): Rename from diff-into-buffer. + Support buffers additionally to files. Move `buf' arg. Don't display buf. + Prefer closures to buffer-local variables. + (diff): Adjust accordingly. + (diff-buffer-with-file): Move from files.el. + * files.el (diff-buffer-with-file): Move to vc/diff.el. + (diff-buffer-internal): Remove. + (diff-buffer-buffer): Remove. + (save-some-buffers-action-alist): Use diff-no-select so as not to guess + the buffer name used, and so as not to mess up windows and frames. + +2010-11-22 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> + + * files.el: Make revert work with diff-buffer-with-file (bug#7277). + (diff-buffer-internal): New function extracted from diff-buffer-with-file + (diff-buffer-with-file): Use it. + * vc/diff.el (diff-into-buffer): New fun, extracted from diff. + (diff): Use it. + +2010-11-22 Tassilo Horn <tassilo@member.fsf.org> + + * textmodes/reftex-ref.el (reftex-goto-label): Use the current + \ref's or \pageref's value as default instead of initial input. + +2010-11-21 Michael Albinus <michael.albinus@gmx.de> + + * files.el (backup-by-copying-when-mismatch): The default value is + now t. + + * startup.el (normal-top-level): + * net/tramp.el (tramp-handle-insert-file-contents): Do not set + `backup-by-copying-when-mismatch'. + +2010-11-21 Jan Djärv <jan.h.d@swipnet.se> + + * tool-bar.el (tool-bar-setup): Remove save as, print and customize. + +2010-11-21 Deniz Dogan <deniz.a.m.dogan@gmail.com> + + * progmodes/python.el (python-font-lock-keywords): + Highlight top-level augmented assignments (Bug#6445). + +2010-11-21 Jan Djärv <jan.h.d@swipnet.se> + + * term/ns-win.el (ns-right-control-modifier) + (ns-right-command-modifier): Defvar them. + + * cus-start.el (all): Add ns-right-control-modifier and + ns-right-command-modifier (Bug#7458). + +2010-11-20 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/authors.el (authors-ignored-files) + (authors-valid-file-names, authors-renamed-files-alist): Add entries. + +2010-11-20 Tassilo Horn <tassilo@member.fsf.org> + + * mail/emacsbug.el (report-emacs-bug-query-existing-bugs) + (report-emacs-bug-parse-query-results) + (report-emacs-bug-create-existing-bugs-buffer): Pass through + keywords used for querying the bug database to show them in the + existing bugs buffer. + +2010-11-20 Jan Djärv <jan.h.d@swipnet.se> + + * tool-bar.el (tool-bar-setup): Add some :vert-only keywords. + + * info.el (info-tool-bar-map): Add some :vert-only keywords. + +2010-11-20 Eli Zaretskii <eliz@gnu.org> + + * international/characters.el (glyphless-char-display-control): + Make it a defcustom, with update-glyphless-char-display as its + :set attribute. + (top level): Don't call update-glyphless-char-display. + +2010-11-20 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.2.0. + + * net/tramp.el (tramp-handle-insert-file-contents): Don't use + `file-remote-p' (due to compatibility). + + * net/tramp-sh.el (tramp-do-copy-or-rename-file-directly) + (tramp-do-copy-or-rename-file-out-of-band): Use `ignore-errors'. + + * net/trampver.el: Update release number. + +2010-11-20 Eli Zaretskii <eliz@gnu.org> + + * faces.el (glyphless-char): Define value for `pc'. + +2010-11-20 Tassilo Horn <tassilo@member.fsf.org> + + Implemented a bug querying mechanism. + * mail/emacsbug.el (report-emacs-bug-tracker-url): New variable. + (report-emacs-bug-create-existing-bugs-buffer) + (report-emacs-bug-parse-query-results) + (report-emacs-bug-query-existing-bugs): New functions. + +2010-11-19 Tassilo Horn <tassilo@member.fsf.org> + + * textmodes/reftex-ref.el (reftex-goto-label): If point is inside + a \ref{} or \pageref{} macro, then use its value as initial input. + +2010-11-19 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (math-build-units-table-buffer): + calc/README: Mention that the TeX specific units won't use the + `tex' prefix in TeX mode. + calc/calc-lang.el (math-variable-table): Don't use the `tex' + prefix for units in TeX mode. + +2010-11-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (kill-new, kill-append, kill-region): + * comint.el (comint-kill-region): Make the yank-handler argument + obsolete. + +2010-11-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-bnf-classify): Signal errors for tokens + that are both openers (resp. closers) and something else. + (smie-grammar): Loosen definition of valid values. + (smie-next-sexp, smie-down-list, smie-blink-matching-open) + (smie-indent--parent, smie-rule-parent, smie-indent-keyword) + (smie-indent-after-keyword): Adjust users. + (smie-indent-keyword): Don't indent empty lines. + + * vc-hg.el (vc-hg-program): New var. + Suggested by Norman Gray <norman@astro.gla.ac.uk>. + (vc-hg-state, vc-hg-working-revision, vc-hg-command): Use it. + +2010-11-18 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/autoload.el (autoload-find-destination): The function + coding-system-eol-type may return non-numeric values. (Bug#7414) + +2010-11-18 Ulrich Mueller <ulm@gentoo.org> + + * server.el (server-force-stop): Ensure the server is stopped (Bug#7409). + +2010-11-18 Eli Zaretskii <eliz@gnu.org> + + * subr.el (posn-col-row): Pay attention to header line. (Bug#7390) + +2010-11-18 Chong Yidong <cyd@stupidchicken.com> + + * textmodes/picture.el (picture-mouse-set-point): Don't use + posn-col-row; explicitly compute the motion based on the posn at + the window-start (Bug#7390). + +2010-11-18 Glenn Morris <rgm@gnu.org> + + * novice.el (disabled-command-function): + Fix 2009-11-15 change. (Bug#7384) + +2010-11-18 Glenn Morris <rgm@gnu.org> + + * calendar/calendar.el (diary-iso-date-forms): Make elements + mutually exclusive. (Bug#7377) + +2010-11-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-prec2->grammar): Obey equality constraints + when filling the remaining "unconstrained" values. + +2010-11-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-warnings): Simplify the + safety predicate. + + * files.el (safe-local-variable-p): Gracefully handle errors. + + * emacs-lisp/smie.el (smie-rule-parent, smie-indent--rule): + Use smie-indent-virtual when indenting relative to an opener. + (smie-rule-separator): Use smie-rule-parent. + (smie-indent-keyword): Consult rules, even for openers at bol. + (smie-indent-comment-close): Try to align closer's content. + +2010-11-18 Glenn Morris <rgm@gnu.org> + + * ls-lisp.el (ls-lisp-dired-ignore-case): Make it an obsolete alias. + +2010-11-18 Glenn Morris <rgm@gnu.org> + + * printing.el (pr-menu-bind): Doc fix. + + * speedbar.el (speedbar-toggle-images): Doc fix. + + * progmodes/python.el (python-shell): Doc fix. + + * wid-edit.el (widget-field-use-before-change) + (widget-use-overlay-change): Doc fixes. + +2010-11-18 Stefan Monnier <monnier@iro.umontreal.ca> + + Minor cleanup to improve style. + * textmodes/rst.el (rst-update-section): Use point-marker. + (rst-get-decoration): Eliminate unneeded assignment. + (rst-promote-region, rst-straighten-decorations) + (rst-section-tree, rst-adjust): Use point-marker. + (rst-toc-mode-mouse-goto): Avoid setq. + (rst-shift-region-guts, rst-shift-region-left) + (rst-iterate-leftmost-paragraphs, rst-iterate-leftmost-paragraphs-2) + (rst-convert-bullets-to-enumeration): Use copy-marker. + + * minibuffer.el (completion-fail-discreetly): New var. + (completion--do-completion): Use it. + + * electric.el (electric-pair-pairs): New var. + (electric-pair-post-self-insert-function): Use it. + (electric-layout-post-self-insert-function): Don't insert a before + newline unless it's actually needed. + +2010-11-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/python.el (run-python): Explain why we remove the current + directory from sys.path. Suggested by Eric Hanchrow <erich@cozi.com>. + + * progmodes/grep.el (grep-regexp-alist): Tighten the regexp (bug#7378). + +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): + Rename 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. + (smie-precs->prec2): Rename from smie-precs-precedence-table. + (smie-bnf->prec2): Rename from smie-bnf-precedence-table. + (smie-prec2->grammar): Rename from smie-prec2-levels. + (smie-grammar): Rename from smie-op-levels. + (smie-indent--hanging-p): Rename from smie-hanging-p. + (smie-rule-hanging-p): New alias. + (smie-indent--bolp): Rename from smie-bolp. + (smie-indent--hanging-p): New alias. + (smie--token): New dynamically bound variable. + (smie-indent--parent): New function. + (smie-rule-parent-p): Use it; rename from smie-parent-p. + (smie-rule-next-p): Rename from smie-next-p. + (smie-rule-prev-p): Rename from smie-prev-p. + (smie-rule-sibling-p, smie-rule-parent) + (smie-indent--separator-outdent, smie-rule-separator): New functions. + (smie-rule-separator-outdent): New var. + (smie-indent--rule): Merge with smie-indent--column. + (smie-indent-forward-token, smie-indent-backward-token): + Also recognize close parens. + (smie-indent-keyword): Don't use smie-indent--column any more. + (smie-indent-after-keyword): Ignore closers by default. + (smie-indent-line): Use with-demoted-errors. + * progmodes/octave-mod.el (octave-smie-grammar): + Rename from octave-smie-op-levels. + (octave-smie-rules): Adjust to new behavior. + * progmodes/prolog.el (prolog-smie-grammar): + Rename from prolog-smie-op-levels. + +2010-11-07 Glenn Morris <rgm@gnu.org> + + * eshell/esh-util.el (subst-char-in-string) + (directory-files-and-attributes): These compatibility definitions are + not needed on any version of Emacs since at least 21.4. + + * progmodes/verilog-mode.el (verilog-get-beg-of-line) + (verilog-get-end-of-line): Remove. + (verilog-within-string, verilog-re-search-forward-substr) + (verilog-re-search-backward-substr, verilog-set-auto-endcomments) + (verilog-surelint-off, verilog-getopt-file, verilog-highlight-region): + Use point-at-bol, point-at-eol. + * progmodes/pascal.el (pascal-get-beg-of-line, pascal-get-end-of-line): + Remove. + (pascal-declaration-end, pascal-declaration-beg, pascal-within-string) + (electric-pascal-terminate-line, pascal-set-auto-comments) + (pascal-indent-paramlist, pascal-indent-declaration) + (pascal-get-lineup-indent, pascal-func-completion) + (pascal-get-completion-decl, pascal-var-completion, pascal-completion): + Use point-at-bol, point-at-eol. + * progmodes/flymake.el (flymake-line-beginning-position) + (flymake-line-end-position): Remove. + (flymake-highlight-line): Use point-at-bol, point-at-eol. + * eshell/esh-util.el (line-end-position, line-beginning-position): + Remove compat definitions. + + * emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine): + Use end-of-line N. + (checkdoc-this-string-valid-engine, checkdoc-file-comments-engine): + Use line-end-position. + + * emacs-lisp/chart.el (chart-zap-chars): + * play/decipher.el (decipher-set-map): + * progmodes/ada-mode.el (ada-get-current-indent) + (ada-search-ignore-string-comment, ada-tab-hard, ada-untab-hard): + * progmodes/ada-prj.el (ada-prj-load-from-file, ada-prj-display-help): + * progmodes/ada-xref.el (ada-initialize-runtime-library) + (ada-get-all-references): + * progmodes/cperl-mode.el (cperl-electric-paren) + (cperl-electric-rparen, cperl-electric-keyword, cperl-electric-else) + (cperl-linefeed, cperl-sniff-for-indent, cperl-to-comment-or-eol) + (cperl-find-pods-heres, cperl-indent-exp, cperl-fix-line-spacing) + (cperl-word-at-point-hard): + * progmodes/idlw-shell.el (idlwave-shell-move-or-history) + (idlwave-shell-filename-string, idlwave-shell-batch-command) + (idlwave-shell-display-line): + * progmodes/idlwave.el (idlwave-show-begin, idlwave-fill-paragraph) + (idlwave-calc-hanging-indent, idlwave-auto-fill, idlwave-template): + * progmodes/js.el (js--re-search-forward-inner) + (js--re-search-backward-inner): + * progmodes/vhdl-mode.el (vhdl-align-region-1, vhdl-align-region-2) + (vhdl-fix-clause, vhdl-compose-configuration-architecture): + * progmodes/ruby-mode.el (ruby-parse-partial, eval-when-compile): + * textmodes/flyspell.el (flyspell-process-localwords): + * textmodes/ispell.el (ispell-buffer-local-parsing) + (ispell-buffer-local-dict, ispell-buffer-local-words): + Use point-at-bol and point-at-eol. + + * speedbar.el (speedbar-generic-item-info) + (speedbar-item-info-tag-helper, speedbar-change-expand-button-char) + (speedbar-add-indicator, speedbar-check-vc-this-line) + (speedbar-check-obj-this-line, speedbar-extract-one-symbol) + (speedbar-buffers-line-directory, speedbar-buffer-revert-buffer): + Replace more uses of end-of-line etc with line-end-position. + +2010-11-06 Glenn Morris <rgm@gnu.org> + + * textmodes/texnfo-upd.el (texinfo-start-menu-description) + (texinfo-update-menu-region-beginning, texinfo-menu-first-node) + (texinfo-delete-existing-pointers, texinfo-find-pointer) + (texinfo-clean-up-node-line, texinfo-insert-node-lines) + (texinfo-multiple-files-update): + * textmodes/table.el (table--probe-cell-left-up) + (table--probe-cell-right-bottom): + * textmodes/picture.el (picture-tab-search): + * textmodes/page-ext.el (pages-copy-header-and-position) + (pages-directory-for-addresses): + * progmodes/vera-mode.el (vera-get-offset): + * progmodes/simula.el (simula-calculate-indent): + * progmodes/python.el (python-pdbtrack-overlay-arrow): + * progmodes/prolog.el (end-of-prolog-clause): + * progmodes/perl-mode.el (perl-calculate-indent, perl-indent-exp): + * progmodes/icon.el (indent-icon-exp): + * progmodes/etags.el (tag-re-match-p): + * progmodes/ebrowse.el (ebrowse-show-file-name-at-point): + * progmodes/ebnf2ps.el (ebnf-begin-file): + * progmodes/dcl-mode.el (dcl-back-to-indentation-1) + (dcl-save-local-variable): + * play/life.el (life-setup): + * play/gametree.el (gametree-looking-at-ply): + * nxml/nxml-maint.el (nxml-insert-target-repertoire-glyph-set): + * mail/sendmail.el (mail-mode-auto-fill): + * emacs-lisp/lisp-mode.el (calculate-lisp-indent): + * emacs-lisp/edebug.el (edebug-overlay-arrow): + * emacs-lisp/checkdoc.el (checkdoc-this-string-valid): + * woman.el (woman-parse-numeric-value, woman2-TH, woman2-SH) + (woman-tab-to-tab-stop, WoMan-warn-ignored): + * type-break.el (type-break-file-keystroke-count): + * term.el (term-replace-by-expanded-history-before-point) + (term-skip-prompt, term-extract-string): + * speedbar.el (speedbar-edit-line, speedbar-expand-line) + (speedbar-contract-line, speedbar-toggle-line-expansion) + (speedbar-parse-c-or-c++tag, speedbar-parse-tex-string) + (speedbar-buffer-revert-buffer, speedbar-highlight-one-tag-line): + * sort.el (sort-skip-fields): + * skeleton.el (skeleton-internal-list): + * simple.el (line-move-finish, line-move-to-column): + * shell.el (shell-forward-command): + * misc.el (copy-from-above-command): + * makesum.el (double-column): + * ebuff-menu.el (electric-buffer-update-highlight): + * dired.el (dired-move-to-end-of-filename): + * dframe.el (dframe-popup-kludge): + * bookmark.el (bookmark-kill-line, bookmark-bmenu-show-filenames): + * arc-mode.el (archive-get-lineno): + Use line-end-position and line-beginning-position. + + * progmodes/idlwave.el (idlwave-routine-entry-compare-twins): + (idlwave-study-twins): Prefix dynamic local `class'. + (idlwave-routine-twin-compare): Update for above name change. + + * emacs-lisp/eieio-comp.el (byte-compile-file-form-defmethod): + Use boundp tests to silence compiler. Update for changed name of + bytecomp-filename variable. + + * emulation/viper-cmd.el (viper-read-string-with-history): + Prefix dynamic local `initial'. + (viper-minibuffer-standard-hook): Update for above name change. + + * emacs-lisp/elint.el (elint-init-env): Prefix dynamic local `env'. + (elint-init-form): Update for above name change. + + * mail/mail-extr.el (mail-extract-address-components): Give dynamic + local variables `cbeg' and `cend' a prefix. + (mail-extr-voodoo): Update for above name change. + + * textmodes/reftex-toc.el (reftex-toc-do-promote) + (reftex-toc-promote-prepare): Pass `delta' as an explicit argument. + (reftex-toc-promote-action): Doc fix. + + * textmodes/reftex-sel.el (reftex-select-item): Give local variables + `prompt', `data' a prefix. + (reftex-select-post-command-hook, reftex-select-callback) + (reftex-select-mouse-accept, reftex-select-read-cite): + Update for above name changes. + + * textmodes/reftex-ref.el (reftex-reference): Rename local variable + `refstyle' to reftex-refstyle. + (reftex-offer-label-menu): Update for above name change. + * textmodes/reftex-sel.el (reftex-select-toggle-varioref): Update for + `refstyle' name change. + + * vc/emerge.el (emerge-eval-in-buffer): Remove, and replace all uses + with with-current-buffer. + (diff, template): Give dynamic local variables a prefix. + (emerge-line-numbers): Rename local `diff' to emerge-line-diff. + (emerge-line-number-in-buf): Update for above name change. + (emerge-combine-versions-internal): Rename local `template' to + emerge-combine-template. + (emerge-combine-versions-edit): Update for above name change. + +2010-11-06 Ralf Angeli <angeli@caeruleus.net> + + * textmodes/reftex-cite.el + (reftex-extract-bib-entries-from-thebibliography): Match bibitem + entries with whitespace after \bibitem. + (reftex-create-bibtex-file): Match entries containing numbers and + symbol constituents. Make sure that entries with whitespace at + various places are found. + +2010-11-05 Christian Millour <cm@abtela.com> (tiny change) + + * shell.el (shell-process-popd): Made aware of comint-file-name-prefix. + +2010-11-05 Jan Djärv <jan.h.d@swipnet.se> + + * mouse.el (mouse-yank-primary): Update comment (Bug#6802). + +2010-11-05 Glenn Morris <rgm@gnu.org> + + * woman.el (woman0-roff-buffer, woman1-roff-buffer) + (woman2-roff-buffer): Give local variable `request' a prefix. + (woman0-macro): Rename argument `request' in the same way. + (woman-request): New name for `request' dynamic variable. + (woman-unquote, woman-forward-arg): Update for above name change. + (woman1-roff-buffer): Give local variable `unquote' a prefix. + (woman1-unquote): New name for `unquote' dynamic variable. + (woman1-B-or-I, woman1-alt-fonts): Update for above name change. + (woman-translations): Rename from `translations'. No longer global. + (woman2-tr, woman-translate): Update for above name change. + (woman-translate): Check for bound variable. + (woman2-roff-buffer): Give local variable `translations' a prefix. + + * play/doctor.el: Give all local variables a prefix. Update callers. + (doc$, doctor-put-meaning): Use backquote. + + * emacs-lisp/cl-macs.el (loop): Give local variable args a prefix. + (cl-parse-loop-clause, cl-loop-handle-accum): Update for above change. + + * emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Give local + variables bytes, ptr, op a prefix. + (disassemble-offset): Update for above change. + +2010-11-03 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-unpack): Remove no-op. + (package--builtins, package--dir): Doc fix. + (package-activate-1, package-activate, package-install) + (package-compute-transaction): Fix error message. + (package-delete): Use delete-directory. Omit system packages. + (package-initialize): Set package-alist to nil first. + (package-menu-mark-delete, package-menu-mark-install): Don't add + symbols that are inconsistent with the package state. + (package-menu-execute): Perform deletions and installations as + single batch operations. + +2010-11-03 Glenn Morris <rgm@gnu.org> + + * progmodes/idlwave.el (idlwave-pset): Only used on XEmacs. + (props): Remove unnecessary declaration. + + * textmodes/ispell.el (ispell-init-process): On Emacs, always use + set-process-query-on-exit-flag. + + * textmodes/reftex-toc.el (name1, dummy, dummy2): Remove unused decs. + (reftex-toc-do-promote): Remove unused local `mpos'. + (reftex-toc-restore-region): Make `mpos' local to this function. + + * net/dbus.el (dbus-name-owner-changed-handler): Doc fix. + + * play/landmark.el (lm-losing-threshold): Correct spelling. + (lm-human-plays): Use new name. + + * play/gomoku.el (gomoku-loosing-threshold): Correct spelling. + (gomoku-human-plays): Use new name. + + * play/gomoku.el (nil-score, Xscore, XXscore, XXXscore, XXXXscore) + (Oscore, OOscore, OOOscore, OOOOscore): Rename with gomoku- prefix. + (gomoku-score-trans-table, gomoku-winning-threshold) + (gomoku-loosing-threshold, gomoku-init-score-table): Use new names. + +2010-11-03 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el: Don't put built-in packages in + package-alist, to avoid loading inefficiencies. + (package-built-in-p): Make VERSION optional, and treat it as a + minimum acceptable version. + (package-activate): Search separately for built-in packages. + Emit a warning if a dependency fails. + (define-package): Handle most common case, where there is no + obsolete package, first. + (package-compute-transaction): Print required version in error. + (package--initialized): New variable. + (list-packages): Use it. + (package-initialize): Optional arg NO-ACTIVATE. Don't put + built-in packages in packages-alist; keep it separate. + Set package--initialized. + (describe-package): Avoid activating packages as a side-effect. + Search separately for built-in packages. + (describe-package-1): Handle the case where an elpa package is + simultaneously built-in and available/installed. + (package-installed-p, package--generate-package-list): + Search separately for built-in packages. + (package-load-descriptor): Doc fix. + +2010-11-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/perl-mode.el (perl-syntax-propertize-function): + Handle __DATA__ and __END__. + +2010-11-02 Noah Friedman <friedman@splode.com> + + * emacs-lisp/bytecomp.el (byte-recompile-file): If bytecomp-arg is + nil, do not ask to recompile files that are not already compiled, + and do not recompile them. + +2010-11-02 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-initialize): Ensure that + obsoleted built-in packages are not in package-activated-list + during activation. + (describe-package-1): Make the "installed" status override + "built-in". + +2010-11-01 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * subr.el (version-separator, version-regexp-alist): Remove '*' + from docstring. + (version-list-<=, version<=, version=): Doc fix. + +2010-11-01 Kenichi Handa <handa@m17n.org> + + * faces.el (glyphless-char): Inherit underline for tty. + +2010-11-01 Kenichi Handa <handa@m17n.org> + + Implement various display methods for glyphless characters. + + * international/characters.el (char-acronym-table): New variable. + (glyphless-char-control): New variable. + (update-glyphless-char-display): New funciton. + + * faces.el (glyphless-char): New face. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * calendar/holidays.el (general-holidays, oriental-holidays) + (local-holidays, other-holidays, hebrew-holidays, christian-holidays) + (islamic-holidays, bahai-holidays, solar-holidays): Move aliases before + the definitions of their targets. + + * emacs-lisp/smie.el (smie): New custom group. + (smie-blink-matching-inners, smie-indent-basic): Add :group. + + * faces.el (xw-defined-colors, x-setup-function-keys): + * mouse-sel.el (x-select-text): + * term/w32console.el (x-setup-function-keys): Update declarations. + + * progmodes/ruby-mode.el (ruby-syntax-propertize-heredoc): Declare. + + * textmodes/ispell.el (comment-add): Declare. + + * net/gnutls.el (gnutls-boot, gnutls-errorp, gnutls-error-string): + Declare. + + * info.el (finder-keywords-hash, package-alist): Declare. + +2010-11-01 Chong Yidong <cyd@stupidchicken.com> + + * finder.el (finder-compile-keywords): Don't use intern-soft, + since package names may not yet exist in the obarray. + +2010-11-01 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc-arch.el (vc-arch-checkin): + * vc/vc-cvs.el (vc-cvs-checkin): + * vc/vc-mtn.el (vc-mtn-checkin): + * vc/vc-rcs.el (vc-rcs-checkin): + * vc/vc-sccs.el (vc-sccs-checkin): + * vc/vc-svn.el (vc-svn-checkin): Remove optional extra arg, unused + since 2010-04-21 commit by Stefan Monnier. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-recompile-file): Fix previous change. + + * startup.el (package-enable-at-startup, package-initialize): + Silence compiler. + + * progmodes/ada-mode.el (ada-font-lock-syntactic-keywords): + Silence compiler. + +2010-10-31 Julien Danjou <julien@danjou.info> + + * emacs-lisp/bytecomp.el (byte-recompile-file): New fun (bug#7297). + (byte-recompile-directory): + * emacs-lisp/lisp-mode.el (emacs-lisp-byte-compile-and-load): + Use `byte-recompile-file'. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * cus-start.el: Handle standard values via a keyword. + Only set version property if specified. + (cursor-in-non-selected-windows, menu-bar-mode) + (tool-bar-mode, show-trailing-whitespace): + Do not specify standard values. + (transient-mark-mode, temporary-file-directory): Use :standard. + +2010-10-31 Jan Djärv <jan.h.d@swipnet.se> + + * term/x-win.el (x-get-selection-value): New function that gets + PRIMARY with type as specified in x-select-request-type. (Bug#6802). + +2010-10-31 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-insert-file-contents): For root, + preserve owner and group when editing files. (Bug#7289) + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * speedbar.el (speedbar-mode): + * play/fortune.el (fortune-in-buffer, fortune): + * play/gomoku.el (gomoku-mode): + * play/landmark.el (lm-mode): + * textmodes/bibtex.el (bibtex-validate, bibtex-validate-globally): + Replace inappropriate uses of toggle-read-only. (Bug#7292) + + * select.el (x-selection): Mark it as an obsolete alias. + +2010-10-31 Aaron S. Hawley <aaron.s.hawley@gmail.com> + + * vc/add-log.el (find-change-log): Use derived-mode-p rather than + major-mode (bug#7284). + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * menu-bar.el (menu-bar-files-menu): Make it into an actual alias, + rather than just an unused variable that inherits from the real one. + +2010-10-31 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-cmds.el (c-mask-paragraph): Fix an off-by-1 error. + This fixes bug #7185. + +2010-10-30 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line): Search for package directories, and + don't load package.el if none are found. + + * emacs-lisp/package.el (describe-package, list-packages): + Call package-initialize if it has not been called yet. + +2010-10-30 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-fonts.el (c-font-lock-enum-tail): New function + which fontifies the tail of an enum. + (c-basic-matchers-after): Insert a call to the above new function. + This fixes bug #7264. + +2010-10-30 Glenn Morris <rgm@gnu.org> + + * cus-start.el: Add :set properties for minor modes menu-bar-mode, + tool-bar-mode, transient-mark-mode. (Bug#7306) + Include the :set property in the dumped Emacs. + +2010-10-29 Stefan Monnier <monnier@iro.umontreal.ca> + + SMIE: change indent rules format, improve smie-setup. + * emacs-lisp/smie.el (smie-precs-precedence-table) + (smie-merge-prec2s, smie-bnf-precedence-table, smie-prec2-levels): + Mark them pure so the tables gets built at compile time. + (smie-bnf-precedence-table): Store the closer-alist in the table. + (smie-prec2-levels): Preserve the closer-alist. + (smie-blink-matching-open): Be more forgiving in case of indentation. + (smie-hanging-p): Rename from smie-indent--hanging-p. + (smie-bolp): Rename from smie-indent--bolp. + (smie--parent, smie--after): New dynamic vars. + (smie-parent-p, smie-next-p, smie-prev-p): New funs. + (smie-indent-rules): Remove. + (smie-indent--offset-rule): Remove fun. + (smie-rules-function): New var. + (smie-indent--rule): New fun. + (smie-indent--offset, smie-indent-keyword, smie-indent-after-keyword) + (smie-indent-exps): Use it. + (smie-setup): Setup paren blinking; add keyword args for token + functions; extract closer-alist from op-levels. + (smie-indent-debug-log): Remove var. + (smie-indent-debug): Remove fun. + * progmodes/prolog.el (prolog-smie-indent-rules): Remove. + (prolog-smie-rules): New fun to replace it. + (prolog-mode-variables): Simplify. + * progmodes/octave-mod.el (octave-smie-closer-alist): Remove, now that + it's setup automatically. + (octave-smie-indent-rules): Remove. + (octave-smie-rules): New fun to replace it. + (octave-mode): Simplify. + +2010-10-29 Glenn Morris <rgm@gnu.org> + + * files.el (temporary-file-directory): Remove (already defined in C). + * cus-start.el: Add temporary-file-directory. + + * abbrev.el (abbrev-mode): + * composite.el (auto-composition-mode): + * menu-bar.el (menu-bar-mode): + * simple.el (transient-mark-mode): + * tool-bar.el (tool-bar-mode): Adjust the define-minor-mode calls so + that they do not define the associated variables twice. + * simple.el (transient-mark-mode): Remove defvar. + * composite.el (auto-composition-mode): Make variable auto-buffer-local. + * cus-start.el: Add transient-mark-mode, menu-bar-mode, tool-bar-mode. + Handle multiple groups, and also custom-delayed-init-variables. + * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix. + +2010-10-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase): New `string' and `guard' patterns. + (pcase-if): Add one minor optimization. + (pcase-split-equal): Rename from pcase-split-eq. + (pcase-split-member): Rename from pcase-split-memq. + (pcase-u1): Add strings to the member optimization. + Add `guard' variant of predicates. + (pcase-q1): Add string patterns. + +2010-10-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/log-edit.el (log-edit-rewrite-fixes): State its safety pred. + +2010-10-28 Glenn Morris <rgm@gnu.org> + + * term/ns-win.el (global-map, menu-bar-final-items, menu-bar-help-menu): + Move menu-bar related settings to ../menu-bar.el. + * menu-bar.el (global-map, menu-bar-final-items, menu-bar-help-menu): + Move ns-specific settings here from term/ns-win.el. + + * simple.el (x-selection-owner-p): Remove unused declaration. + +2010-10-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion-cycling): New var (bug#7266). + (minibuffer-complete, completion--do-completion): + Use completion--flush-all-sorted-completions. + (minibuffer-complete): Only cycle if completion-cycling is set. + (completion--flush-all-sorted-completions): Unset completion-cycling. + (minibuffer-force-complete): Set completion-cycling. + (completion-all-sorted-completions): Move declaration before first use. + +2010-10-28 Leo <sdl.web@gmail.com> + + * iswitchb.el (iswitchb-kill-buffer): Avoid `iswitchb-make-buflist' + which changes the order of matches seen by users (bug#7231). + +2010-10-28 Jes Bodi Klinke <jes@bodi-klinke.dk> (tiny change) + + * progmodes/compile.el (compilation-mode-font-lock-keywords): + Don't confuse -omega as "-o mega". + +2010-10-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/log-edit.el (log-edit-rewrite-fixes): New var. + (log-edit-author): New dynamic var. + (log-edit-changelog-ours-p, log-edit-insert-changelog-entries): Use it + to return the author if different from committer. + (log-edit-insert-changelog): Use them to add Author: and Fixes headers. + + * play/landmark.el: Adjust commenting convention. + (lm-nil-score): Rename from nil-score. + (Xscore, XXscore, XXXscore, XXXXscore, Oscore, OOscore, OOOscore) + (OOOOscore): Move into a let in lm-score-trans-table. + (lm-winning-threshold, lm-loosing-threshold): Use lm-score-trans-table. + + * electric.el (electric-indent-chars): Autoload. + * progmodes/octave-mod.el (octave-mode): + * progmodes/ruby-mode.el (ruby-mode): Take advantage of it. + (ruby-mode-abbrev-table): Merge initialization and declaration. + +2010-10-27 Glenn Morris <rgm@gnu.org> + + * abbrev.el (abbrev-mode): Remove one of the three definitions of this + variable. + + * server.el (server-host, server-port, server-auth-dir): Autoload risky. + + * term/ns-win.el: Restore require of cl when compiling. + (menu-bar-final-items): Remove non-existent `windows' menu. + (ns-handle-nxopen): Optionally handle the temp-case. + (ns-handle-nxopentemp): Just call ns-handle-nxopen. + (ns-insert-file, ns-find-file): Use `pop'. + +2010-10-26 Glenn Morris <rgm@gnu.org> + + * term/common-win.el (xw-defined-colors): Simplify the 'ns case. + +2010-10-26 Adrian Robert <Adrian.B.Robert@gmail.com> + + * term/ns-win.el (ns-new-frame, ns-show-prefs): Don't add to + global map. + * term/common-win.el (x-setup-function-keys): Remove most of the + keymappings. Comment on the remaining ones. + +2010-10-26 Peter Oliver <p.d.oliver@mavit.org.uk> (tiny change) + + * server.el (server-port): New option. (Bug#854) + (server-start): Use server-port. + +2010-10-26 Glenn Morris <rgm@gnu.org> + + * term/ns-win.el (ns-version-string): Remove unused declaration. + (ns-invocation-args): Change to x-invocation-args. + (ns-handle-switch, ns-handle-numeric-switch, ns-handle-iconic) + (ns-handle-name-switch, ns-ignore-2-arg): Remove. + (ns-handle-nxopen, ns-handle-nxopentemp, ns-ignore-1-arg): + Use x-invocation-args instead of ns-invocation-args. + (ns-initialize-window-system, handle-args-function-alist): + Use x-handle-args instead of ns-handle-args. + * term/common-win.el (x-handle-args): Also handle nextstep arguments. + * startup.el (command-line-ns-option-alist): Replace + ns-handle-name-switch, ns-handle-switch, ns-handle-numeric-switch, + ns-handle-iconic with the x- equivalents. + + * term/common-win.el (x-select-enable-clipboard): + * term/pc-win.el (x-select-enable-clipboard): Doc fix. + + * term/ns-win.el: No need to require cl when compiling. + (x-display-name, x-setup-function-keys, x-select-text, x-colors) + (xw-defined-colors): Use the common-win definitions. + (ns-alternatives-map): Make it an obsolete alias for x-alternatives-map. + (ns-handle-iconic): Make it an alias for x-handle-iconic. + * term/common-win.el (x-select-text, x-alternatives-map) + (x-setup-function-keys, x-colors, xw-defined-colors): Handle 'ns case. + * loadup.el [ns]: Load common-win. + +2010-10-26 Daiki Ueno <ueno@unixuser.org> + + * epa-mail.el (epa-mail-encrypt): Handle local-part only + recipients; expand mail aliases (Bug#7280). + +2010-10-25 Glenn Morris <rgm@gnu.org> + + * term/common-win.el (x-handle-switch): Simplify with pop. + Optionally handle numeric switches. + (x-handle-numeric-switch): Just call x-handle-switch. + (x-handle-initial-switch, x-handle-xrm-switch, x-handle-geometry) + (x-handle-name-switch, x-handle-display, x-handle-args): + Simplify with pop. + + * term/ns-win.el: Do not require easymenu. + (menu-bar-edit-menu) <copy, paste, paste-from-menu, separator-undo>: + <spell>: Move adjustments to menu-bar.el. + * menu-bar.el (menu-bar-edit-menu) <copy, paste, paste-from-menu>: + <separator-undo, spell>: Move ns-win's adjustments here. + * loadup.el [ns]: Do not load easymenu. + +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + * image.el (image-checkbox-checked, image-checkbox-unchecked): + Delete (Bug#7222). + + * startup.el (fancy-startup-tail): Instead of using inline images, + refer to image files from etc/. + + * wid-edit.el (checkbox): Likewise. + (widget-image-find): Center image specs. + +2010-10-24 Glenn Morris <rgm@gnu.org> + + * term/ns-win.el (x-select-text): Doc fix. + * w32-fns.el (x-alternatives-map, x-setup-function-keys) + (x-select-text): Move to term/common-win. + * term/w32-win.el (xw-defined-colors): Move to common-win. + * term/x-win.el (xw-defined-colors, x-alternatives-map) + (x-setup-function-keys, x-select-text): Move to common-win. + * term/common-win.el (x-select-text, x-alternatives-map) + (x-setup-function-keys, xw-defined-colors): Merge x- and w32- + definitions here. + +2010-10-24 T.V. Raman <tv.raman.tv@gmail.com> (tiny change) + + * net/mairix.el (mairix-searches-mode-map): + * mail/mspools.el (mspools-mode-map): Fix 2010-10-10 change. + +2010-10-24 Michael McNamara <mac@mail.brushroad.com> + + * verilog-mode.el (verilog-directive-re): Make this variable + auto-built for efficiency of execution and updating. + (verilog-extended-complete-re): Support 'pure' fucntion & task + declarations (these have no bodies). + (verilog-beg-of-statement): General cleanup to enable support of + 'pure' fucntion & task declarations (these have no bodies). + These efforts together fix Verilog bug210 from veripool; which was also + noticed by Steve Pearlmutter. + (verilog-directive-re, verilog-directive-begin, verilog-indent-re) + (verilog-directive-nest-re, verilog-set-auto-endcomments): + Support `elsif. Reported by Shankar Giri. + (verilog-forward-ws&directives, verilog-in-attribute-p): Fixes for + attribute handling for lining up declarations and assignments. + (verilog-beg-of-statement-1): Fix issue where continued declaration + is indented differently if it is after a begin..end clock. + (verilog-in-attribute-p, verilog-skip-backward-comments) + (verilog-skip-forward-comment-p): Support proper treatment of + attributes by indent code. Reported by Jeff Steele. + (verilog-in-directive-p): Fix comment to correctly describe function. + (verilog-backward-up-list, verilog-in-struct-region-p) + (verilog-backward-token, verilog-in-struct-p) + (verilog-in-coverage-p, verilog-do-indent) + (verilog-pretty-declarations): Use verilog-backward-up-list as + wrapper around backward-up-list inorder to properly skip comments. + Reported by David Rogoff. + (verilog-property-re, verilog-endcomment-reason-re) + (verilog-beg-of-statement, verilog-set-auto-endcomments) + (verilog-calc-1 ): Fix for assert a; else b; indentation (new form + of if). Reported by Max Bjurling and + (verilog-calc-1): Fix for clocking block in modport + declaration. Reported by Brian Hunter. + +2010-10-24 Wilson Snyder <wsnyder@wsnyder.org> + + * verilog-mode.el (verilog-auto-inst, verilog-gate-ios) + (verilog-gate-keywords, verilog-read-sub-decls) + (verilog-read-sub-decls-gate, verilog-read-sub-decls-gate-ios) + (verilog-read-sub-decls-line, verilog-read-sub-decls-sig): Support + AUTOINST for gate primitives, bug284. Reported by Mark Johnson. + (verilog-read-decls): Fix spaces in V2K module parameters causing + mis-identification as interfaces, bug287. + (verilog-read-decls): Fix not treating "parameter string" as a + parameter in AUTOINSTPARAM. + (verilog-read-always-signals-recurse, verilog-read-decls): Fix not + treating `elsif similar to `endif inside AUTOSENSE. + (verilog-do-indent): Implement correct automatic or static task or + function end comment highlight. Reported by Steve Pearlmutter. + (verilog-font-lock-keywords-2): Fix highlighting of single + character pins, bug264. Reported by Michael Laajanen. + (verilog-auto-inst, verilog-read-decls, verilog-read-sub-decls) + (verilog-read-sub-decls-in-interfaced, verilog-read-sub-decls-sig) + (verilog-subdecls-get-interfaced, verilog-subdecls-new): + Support interfaces with AUTOINST, bug270. Reported by Luis Gutierrez. + (verilog-pretty-expr): Fix interactive arguments, bug272. + Reported by Mark Johnson. + (verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp): + Add 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF, + bug269. Suggested by Gary Delp. + (verilog-mode-map, verilog-preprocess, verilog-preprocess-history) + (verilog-preprocessor, verilog-set-compile-command): + Create verilog-preprocess and verilog-preprocessor to show + preprocessed output. + (verilog-get-beg-of-line, verilog-get-end-of-line) + (verilog-modi-file-or-buffer, verilog-modi-name) + (verilog-modi-point, verilog-within-string): Move defmacro's + before first use to avoid warning. Reported by Steve Pearlmutter. + (verilog-colorize-buffer, verilog-colorize-include-files-buffer) + (verilog-colorize-region, verilog-highlight-buffer) + (verilog-highlight-includes, verilog-highlight-modules) + (verilog-highlight-region, verilog-mode): Rename colorize to + highlight to match other packages. Disable module highlighting, + as received speed complaints, reenable for experimentation only + using new verilog-highlight-modules. + (verilog-read-decls): Fix regexp stack overflow in very large + AUTO_TEMPLATEs, bug250. + (verilog-auto, verilog-delete-auto, verilog-save-buffer-state) + (verilog-scan): Create verilog-save-buffer-state to standardize + making insignificant changes that shouldn't call hooks. + (verilog-save-no-change-functions, verilog-save-scan-cache) + (verilog-scan, verilog-scan-cache-ok-p, verilog-scan-region): + Create verilog-save-no-change-functions to wrap verilog-scan + preservation, and fix to work with nested preserved calls. + (verilog-auto-inst, verilog-auto-inst-dot-name): Support .name + port syntax for AUTOWIRE, and with new verilog-auto-inst-dot-name + generate .name with AUTOINST, bug245. Suggested by David Rogoff. + (verilog-submit-bug-report): Update variable list to be complete. + (verilog-auto, verilog-colorize-region): Fix AUTO expansion + breaking on-the-fly font-locking. + (verilog-colorize-buffer, verilog-colorize-include-files) + (verilog-colorize-include-files-buffer, verilog-colorize-region) + (verilog-load-file-at-mouse, verilog-load-file-at-point) + (verilog-mode, verilog-read-inst-module-matcher): With point on a + AUTOINST cell instance name, middle mouse button now finds-file on + it. Suggested by Brad Dobbie. + (verilog-alw-get-temps, verilog-auto-reset) + (verilog-auto-sense-sigs, verilog-read-always-signals) + (verilog-read-always-signals-recurse): Fix loop indexes being + AUTORESET. AUTORESET now assumes any variables in the + initialization section of a for() should be ignored. + Reported by Dan Dever. + (verilog-error-font-lock-keywords) + (verilog-error-regexp-emacs-alist) + (verilog-error-regexp-xemacs-alist): Fix error detection of + Cadence HAL, reported by David Asher. Repair drift between the + three similar error variables. + (verilog-modi-lookup, verilog-modi-lookup-cache) + (verilog-modi-lookup-last-current, verilog-modi-lookup-last-mod) + (verilog-modi-lookup-last-modi, verilog-modi-lookup-last-tick): + Fix slow verilog-auto expansion on very large files. + (verilog-read-sub-decls-expr, verilog-read-sub-decls-line): + Fix AUTOOUTPUT treating "1*2" as a signal name in submodule connection + "{1*2{...". Broke in last revision. + (verilog-read-sub-decls-expr): Fix AUTOOUTPUT not detecting + submodule connections with replications "{#{a},#{b}}". + +2010-10-24 Juanma Barranquero <lekktu@gmail.com> + + * progmodes/dcl-mode.el (dcl-electric-reindent-regexps): + Fix typo in docstring. + +2010-10-24 Kenichi Handa <handa@m17n.org> + + * face-remap.el (text-scale-adjust): Call read-event with a proper + prompt. + +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/unsafep.el: Don't mark functions that display + messages as safe. Suggested by Johan BockgÃ¥rd. + +2010-10-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/regexp-opt.el (regexp-opt-group, regexp-opt-charset): + Turn comments into docstrings. + + * minibuffer.el (completion--replace): Move point where it belongs + when there's a common suffix (bug#7215). + +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + Merge read-color and facemenu-read-color (Bug#7242). + + * faces.el (read-color): Use the completion code from + facemenu-read-color. Require match in completion. Doc fix. + + * facemenu.el (facemenu-read-color): Alias for read-color. + (facemenu-set-foreground, facemenu-set-background): + Use read-color. + + * frame.el (set-background-color, set-foreground-color) + (set-cursor-color, set-mouse-color, set-border-color): + Use read-color. + +2010-10-24 Leo <sdl.web@gmail.com> + + * eshell/em-unix.el (eshell-remove-entries): Use the TRASH + argument of delete-file and delete-directory (Bug#7011). + +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-menu-mode-map): Inherit from + button-buffer-map. + +2010-10-24 Ralf Angeli <angeli@caeruleus.net> + + * emacs-lisp/package.el (package--generate-package-list): Make the + *Packages* buffer read-only. + +2010-10-24 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-fonts.el (c-font-lock-declarations): Cache the + result of `c-beginning-of-decl-1' between invocations of a lambda + function (Bug #7265). + +2010-10-24 Daiki Ueno <ueno@unixuser.org> + + * epg-config.el (epg-gpg-program): Try to use "gpg2" if "gpg" + executable is not available on the system (Bug#7268). + +2010-10-24 Glenn Morris <rgm@gnu.org> + + * select.el (selection-coding-system, next-selection-coding-system): + Sync doc with C versions. + + * w32-vars.el (x-select-enable-clipboard): + * term/x-win.el (x-select-enable-clipboard): Move to common-win. + * term/common-win.el (x-select-enable-clipboard): Move here. + + * term/tty-colors.el (tty-defined-color-alist): Remove duplicate + definition of C variable. + + * frame.el (show-trailing-whitespace, auto-hscroll-mode) + (display-hourglass, hourglass-delay, cursor-in-non-selected-windows): + Don't redefine things that are defined in C. + * cus-start.el: Also handle :risky, :safe, :set, and :tag. + (show-trailing-whitespace, auto-hscroll-mode) + (display-hourglass, hourglass-delay, cursor-in-non-selected-windows): + Set up the appropriate custom properties. + +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + Bind "C-c ]" to ... + * progmodes/f90.el (f90-mode-map): ... f90-insert-end. + * nxml/nxml-mode.el (nxml-mode-map): ... nxml-finish-element. + * textmodes/tex-mode.el (tex-mode-map): ... latex-close-block. + * textmodes/sgml-mode.el (sgml-mode-map): ... sgml-close-tag. + +2010-10-23 Glenn Morris <rgm@gnu.org> + + * textmodes/flyspell.el (flyspell-mode): If there was an error, + say what it was. + + * frame.el (auto-hscroll-mode, cursor-in-non-selected-windows): + Sync docs with C version. + + * term/ns-win.el (xw-defined-colors): + * term/x-win.el (xw-defined-colors): Make docs identical to w32-win. + + * term/pc-win.el (x-select-enable-clipboard): + * term/x-win.el (x-select-enable-clipboard): + * w32-vars.el (x-select-enable-clipboard): Make doc-strings identical. + + * comint.el (comint-password-prompt-regexp): Make it less vague. + Bump version. + + * help-fns.el (doc-file-to-man, doc-file-to-info): New commands. + + * help.el (finder-by-keyword): Remove unnecessary autoload. + +2010-10-22 Glenn Morris <rgm@gnu.org> + + * loadup.el: Unconditionally load float-sup. + * paren.el (show-paren-delay): + * emacs-lisp/float-sup.el: + * emulation/cua-base.el (cua-prefix-override-inhibit-delay): + * obsolete/lazy-lock.el (lazy-lock-defer-time, lazy-lock-stealth-nice) + (lazy-lock-stealth-verbose): Assume float support. + * ps-print.el: Assume float support on Emacs. + * emacs-lisp/timer.el (timer-next-integral-multiple-of-time): + Remove non-float branch. + + * emacs-lisp/autoload.el (batch-update-autoloads): Update for + src/Makefile no longer being pre-processed. + +2010-10-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/find-func.el (find-library): Use test-completion. + +2010-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * newcomment.el (comment-dwim): Fix the intentation in the doc string. + +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. + (tramp-send-command): Unset $PS1 when using here documents, in + order not to get several prompts. + (tramp-get-inline-coding): Return `nil' in case of errors. + +2010-10-21 Daiki Ueno <ueno@unixuser.org> + + * hexl.el (hexl-mode, hexl-mode-exit): + Tweak revert-buffer-function to inhibit auto-mode-alist (Bug#7252). + (hexl-revert-buffer-function): New function. + (hexl-before-revert-hook, hexl-after-revert-hook): Abolish. + +2010-10-19 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-langs.el (c-type-decl-prefix-key): C++ bit: + Move "\(const\|throw\|volatile\)\>" nearer the start of the regexp, so + that these keywords aren't wrongly matched as identifiers. + + * progmodes/cc-mode.el (c-before-change, c-after-change): Move the + setting of c-new-BEG and c-new-END from c-before-change to + c-after-change. (Bug#7181) + +2010-10-19 Chong Yidong <cyd@stupidchicken.com> + + * cus-face.el (custom-theme-set-faces): Revert 2010-10-18 change. + Don't mark as safe. + + * custom.el (custom-theme-set-variables): Likewise. + (load-theme): Add custom-theme-set-faces and + custom-theme-set-variables to safe-functions while loading. + (custom-enabled-themes): Mark as risky. + +2010-10-18 Julien Danjou <julien@danjou.info> + + * bindings.el: Remove end dashes in default mode-line-format. + +2010-10-19 Chong Yidong <cyd@stupidchicken.com> + + * bindings.el (global-map): Bind C-d to delete-char and deletechar + to delete-forward-char. + + * simple.el (normal-erase-is-backspace-mode): Remap delete to + deletechar, and hence delete-forward-char. + +2010-10-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * repeat.el (repeat): Use read-key (bug#6256). + +2010-10-19 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/unsafep.el: Don't mark functions that display + messages as safe. Suggested by Johan BockgÃ¥rd. + +2010-10-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion--replace): Move point where it belongs + when there's a common suffix (bug#7215). + +2010-10-19 Kenichi Handa <handa@m17n.org> + + * international/characters.el: Add category '|' (word breakable) + to fullwidth characters. + +2010-10-19 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-do-file-attributes-with-stat) + (tramp-do-directory-files-and-attributes-with-stat): Use "e0" in + order to make stat results a float. Patch by Andreas Schwab + <schwab@linux-m68k.org>. + +2010-10-18 Julien Danjou <julien@danjou.info> + + * avoid.el (mouse-avoidance-ignore-p): Ignore mouse when it is + hidden by `make-pointer-invisible'. + +2010-10-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (locate-file-completion-table): Strip non-matching elements + before checking length of list (bug#7238). + +2010-10-18 Chong Yidong <cyd@stupidchicken.com> + + * custom.el (custom-theme-set-variables): Mark as a safe function. + (load-theme): Check forms using unsafep. + + * cus-face.el (custom-theme-set-faces): Mark as a safe function. + +2010-10-17 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-aspell-find-dictionary): + Fix aspell data file searching (bug#7230). + +2010-10-16 Chong Yidong <cyd@stupidchicken.com> + + * cus-theme.el (custom-theme--migrate-settings): New var. + (customize-create-theme): Allow editing the `user' theme. + (custom-theme-add-variable, custom-theme-add-var-1) + (custom-theme-add-face, custom-theme-add-face-1): Add a checkbox + to the front of each variable or face widget. + (custom-theme-write): Save theme settings in the correct order. + Optionally, remove saved settings from user customizations. + (custom-theme-write-variables, custom-theme-write-faces): + Save only the checked widgets. + (customize-themes): Add a link for migrating custom settings. + + * custom.el (custom-declare-theme, provide-theme): + Use custom-theme-name-valid-p. + (custom-theme-name-valid-p): Remove checks that are now + unnecessary since themes no longer obey load-path. + + * cus-edit.el (custom-variable-value-create): For the simple + style, hide documentation string when hidden. + +2010-10-16 Chong Yidong <cyd@stupidchicken.com> + + * cus-edit.el (custom-variable, custom-face): Combine the + :inhibit-magic and :display-style properties into a single + :custom-style property. + (custom-toggle-hide-variable, custom-toggle-hide-face): + New functions. If hiding an edited value, save it to :shown-value. + (custom-variable-value-create, custom-face-value-create): Use them. + (custom-magic-reset): Allow magic property to be unset. + + * custom.el: Custom themes no longer use load-path. + (custom-theme-load-path): New option. Change built-in theme + directory to etc/. + (custom-enabled-themes): Add custom-theme-load-path dependency. + (custom-theme--load-path): New function. + (load-theme, custom-available-themes): Use it. + + * cus-theme.el (describe-theme-1): Use custom-theme--load-path. + (customize-themes): Link to custom-theme-load-path variable. + (custom-theme-add-var-1, custom-theme-add-face-1): Use the + :custom-style property. + + * themes/*.el: Moved to etc/. + +2010-10-16 Ralf Angeli <angeli@caeruleus.net> + + * textmodes/reftex-cite.el + (reftex-extract-bib-entries-from-thebibliography): Do not move + point when searching for \bibitem entries. Match entries with + spaces or tabs in front of arguments. + +2010-10-16 Chong Yidong <cyd@stupidchicken.com> + + * cus-theme.el (customize-create-theme): Delete overlays after + erasing. If given a THEME arg, display only the faces of that arg + instead of custom-theme--listed-faces. + (custom-theme-variable-menu, custom-theme-variable-action) + (custom-variable-reset-theme, custom-theme-delete-variable): Delete. + (custom-theme-add-variable, custom-theme-add-face): Apply value + from the theme settings, instead of the current value. + (custom-theme-add-var-1, custom-theme-add-face-1): New functions. + (custom-theme-visit-theme): Allow calling outside theme buffers. + (custom-theme-merge-theme): Don't enable the theme when merging. + (custom-theme-write-variables, custom-theme-write-faces): Use the + :shown-value properties to save buffer values, not global ones. + (customize-themes): Display a warning about user customizations. + + * cus-edit.el (custom-variable-value-create) + (custom-face-value-create): Obey new special properties + :shown-value and :inhibit-magic. + 2010-10-15 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): - Suppress expansion of tabs to spaces. + Suppress expansion of tabs to spaces. Reported by Dale Sedivec + <dale@codefu.org>. 2010-10-14 Kenichi Handa <handa@m17n.org> * mail/rmail.el (rmail-show-message-1): Catch an error of base64-decode-region and just show an error message (bug#7165). - * ps-mule.el (ps-mule-font-spec-list): Delete it. Not used - anymore. + * ps-mule.el (ps-mule-font-spec-list): Delete it. Not used anymore. (ps-mule-begin-job): Fix for the case that only ENCODING is set in a font-spec (bug#7197). @@ -43,11 +2403,11 @@ 2010-10-14 Jay Belanger <jay.p.belanger@gmail.com> - * calc/calc-alg.el (math-var): Renamed from `var'. + * calc/calc-alg.el (math-var): Rename from `var'. (math-is-polynomial, math-is-poly-rec): Replace `var' with `math-var'. - * calc/calcalg2.el (math-var): Renamed from `var'. + * calc/calcalg2.el (math-var): Rename from `var'. (calcFunc-table, math-scan-for-limits): Replace `var' with `math-var'. @@ -111,8 +2471,8 @@ (custom-theme-allow-multiple-selections): New option. (custom-theme-choose-mode): New major mode. - * custom.el (custom-theme-set-variables): Remove dead code. Obey - custom--inhibit-theme-enable. + * custom.el (custom-theme-set-variables): Remove dead code. + Obey custom--inhibit-theme-enable. (custom--inhibit-theme-enable): New var. (provide-theme): Obey it. (load-theme): Replace load with manual read/eval, in order to @@ -123,8 +2483,8 @@ * cus-edit.el (custom--initialize-widget-variables): New function. (Custom-mode): Use it. - * cus-face.el (custom-theme-set-faces): Remove dead code. Obey - custom--inhibit-theme-enable. + * cus-face.el (custom-theme-set-faces): Remove dead code. + Obey custom--inhibit-theme-enable. * help-mode.el (help-theme-def, help-theme-edit): New buttons. @@ -175,15 +2535,14 @@ (custom-available-themes): New function. (load-theme): Use it. - * cus-edit.el (custom-face-edit-fix-value): Use - custom-fix-face-spec. + * cus-edit.el (custom-face-edit-fix-value): Use custom-fix-face-spec. * custom.el (custom-push-theme): Cleanup (use cond). (disable-theme): Recompute the saved-face property. (custom-theme-recalc-face): Follow face alias before setting prop. - * image.el (image-checkbox-checked, image-checkbox-unchecked): New - variables, containing checkbox images. + * image.el (image-checkbox-checked, image-checkbox-unchecked): + New variables, containing checkbox images. * startup.el (fancy-startup-tail): * wid-edit.el (checkbox): Use them. @@ -218,8 +2577,8 @@ * epa.el (epa-passphrase-callback-function): Display filename passed as the 3rd arg. - * epa-file.el (epa-file-passphrase-callback-function): Pass - filename to epa-passphrase-callback-function. + * epa-file.el (epa-file-passphrase-callback-function): + Pass filename to epa-passphrase-callback-function. 2010-10-09 Chong Yidong <cyd@stupidchicken.com> @@ -247,8 +2606,7 @@ * cc-engine.el (c-forward-type): New &optional param "brace-block-too". (c-forward-decl-or-cast-1): cdr of return value now indicates the - presence of either or both of a "struct"-like keyword and - "typedef". + presence of either or both of a "struct"-like keyword and "typedef". * cc-fonts.el (c-complex-decl-matchers): Remove the heuristic fontification of declarators which follow a "}". @@ -270,8 +2628,7 @@ querying the password for. * ibuffer.el (ibuffer-visit-buffer): To mimick list-buffers - behaviour, don't bury the ibuffer buffer when visiting other - buffers. + behaviour, don't bury the ibuffer buffer when visiting other buffers. 2010-10-08 Chong Yidong <cyd@stupidchicken.com> @@ -279,12 +2636,12 @@ (custom-magic-value-create): Pad button tags with spaces. (custom-face-edit): New variable. (custom-face-value-create): Determine whether to use the usual - face editor here, instead of using custom-face-selected. Pass - face defaults to custom-face-edit widget. + face editor here, instead of using custom-face-selected. + Pass face defaults to custom-face-edit widget. (custom-face-selected, custom-display-unselected): Delete widgets. (custom-display-unselected-match): Function removed. - (custom-face-set, custom-face-mark-to-save): Accept - custom-face-edit widgets as the direct widget child. + (custom-face-set, custom-face-mark-to-save): + Accept custom-face-edit widgets as the direct widget child. * wid-edit.el (widget--completing-widget): New var. (widget-default-complete): Bind it when doing completion. @@ -350,10 +2707,6 @@ * dired.el (dired-save-positions): Doc fix. (Bug#7119) -2010-10-08 Andreas Schwab <schwab@linux-m68k.org> - - * Makefile.in (ELCFILES): Update. - 2010-10-08 Glenn Morris <rgm@gnu.org> * vc/ediff-wind.el (ediff-setup-control-frame): @@ -368,8 +2721,8 @@ * cus-edit.el (custom-variable, custom-face): Doc fix. (custom-face-edit): Add value-create attribute. (custom-face-edit-value-create) - (custom-face-edit-value-visibility-action): New functions. Hide - unused face attributes by default, and add a visibility toggle. + (custom-face-edit-value-visibility-action): New functions. + Hide unused face attributes by default, and add a visibility toggle. (custom-face-edit-deactivate): Show empty values with shadow face. (custom-face-selected): Only use this for face specs with default attributes. @@ -449,10 +2802,9 @@ (tramp-handle-file-exists-p, tramp-handle-file-newer-than-file-p): New defuns, taken from tramp-smb.el. (tramp-coding-system-change-eol-conversion) - (tramp-set-process-query-on-exit-flag): Removed. + (tramp-set-process-query-on-exit-flag): Remove. - * net/tramp-compat.el (top): Do not check for byte-compiler - objects. + * net/tramp-compat.el (top): Do not check for byte-compiler objects. (tramp-compat-coding-system-change-eol-conversion) (tramp-compat-set-process-query-on-exit-flag): New defuns, taken from tramp.el. @@ -461,30 +2813,30 @@ * net/tramp-gw.el: Replace `tramp-set-process-query-on-exit-flag' by `tramp-compat-set-process-query-on-exit-flag'. - * net/tramp-imap.el (tramp-imap-file-name-handler-alist): Use - `tramp-handle-directory-files-and-attributes', + * net/tramp-imap.el (tramp-imap-file-name-handler-alist): + Use `tramp-handle-directory-files-and-attributes', `tramp-handle-file-exists-p' and `tramp-handle-file-newer-than-file-p'. (tramp-imap-handle-file-exists-p) (tramp-imap-handle-file-executable-p) (tramp-imap-handle-file-readable-p) (tramp-imap-handle-directory-files-and-attributes) - (tramp-imap-handle-file-newer-than-file-p): Removed. + (tramp-imap-handle-file-newer-than-file-p): Remove. * net/tramp-sh.el: Replace `tramp-set-process-query-on-exit-flag' by `tramp-compat-set-process-query-on-exit-flag' and `tramp-coding-system-change-eol-conversion' by `tramp-compat-coding-system-change-eol-conversion'. - * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Use - `tramp-handle-directory-files-and-attributes', + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): + Use `tramp-handle-directory-files-and-attributes', `tramp-handle-file-exists-p' and `tramp-handle-file-newer-than-file-p'. (tramp-smb-handle-directory-files-and-attributes) (tramp-smb-handle-file-exists-p) - (tramp-smb-handle-file-newer-than-file-p): Removed. - (tramp-smb-maybe-open-connection): Replace - `tramp-set-process-query-on-exit-flag' by + (tramp-smb-handle-file-newer-than-file-p): Remove. + (tramp-smb-maybe-open-connection): + Replace `tramp-set-process-query-on-exit-flag' by `tramp-compat-set-process-query-on-exit-flag'. 2010-10-05 Glenn Morris <rgm@gnu.org> @@ -511,7 +2863,7 @@ (tramp-handle-substitute-in-file-name) (tramp-handle-unhandled-file-name-directory) (tramp-mode-string-to-int, tramp-local-host-p) - (tramp-make-tramp-temp-file): Moved from tramp-sh.el. + (tramp-make-tramp-temp-file): Move from tramp-sh.el. * net/tramp-gvfs.el (top): * net/tramp-smb.el (top): Do not require 'tramp-sh. @@ -528,8 +2880,8 @@ * net/gnutls.el: Improve docs. Remove starttls and ssl emulation. Provide only `open-gnutls-stream' (formerly `open-ssl-stream') and - `gnutls-negotiate' (formerly `starttls-negotiate'). Remove - trivial wrapper `starttls-open-stream'. + `gnutls-negotiate' (formerly `starttls-negotiate'). + Remove trivial wrapper `starttls-open-stream'. 2010-10-03 Dan Nicolaescu <dann@ics.uci.edu> @@ -543,8 +2895,8 @@ 2010-10-03 Teodor Zlatanov <tzz@lifelogs.com> * net/gnutls.el (starttls-negotiate): Use the plist interface to - `gnutls-boot'. Make TYPE the only required parameter. Allow - TRUSTFILES and KEYFILES to be lists. + `gnutls-boot'. Make TYPE the only required parameter. + Allow TRUSTFILES and KEYFILES to be lists. (open-ssl-stream): Use it. 2010-10-03 Glenn Morris <rgm@gnu.org> @@ -565,8 +2917,8 @@ 2010-10-03 Chong Yidong <cyd@stupidchicken.com> - * emacs-lisp/bytecomp.el (byte-compile-from-buffer): Remove - obsolete use of binary-overwrite-mode (Bug#7001). + * emacs-lisp/bytecomp.el (byte-compile-from-buffer): + Remove obsolete use of binary-overwrite-mode (Bug#7001). 2010-10-03 Glenn Morris <rgm@gnu.org> @@ -601,18 +2953,18 @@ 2010-10-03 Chong Yidong <cyd@stupidchicken.com> - * server.el (server-process-filter, server-return-error): Give - emacsclient time to shut down after receiving an error string. + * server.el (server-process-filter, server-return-error): + Give emacsclient time to shut down after receiving an error string. 2010-10-02 Michael Albinus <michael.albinus@gmx.de> * files.el (remote-file-name-inhibit-cache): New defcustom. - * time.el (display-time-file-nonempty-p): Use - `remote-file-name-inhibit-cache'. + * time.el (display-time-file-nonempty-p): + Use `remote-file-name-inhibit-cache'. - * net/tramp.el (tramp-completion-reread-directory-timeout): Fix - docstring. + * net/tramp.el (tramp-completion-reread-directory-timeout): + Fix docstring. * net/tramp-cache.el (tramp-cache-inhibit-cache): Remove. (tramp-get-file-property): Replace `tramp-cache-inhibit-cache' by @@ -633,10 +2985,9 @@ * net/tramp-sh.el (tramp-handle-verify-visited-file-modtime) (tramp-handle-file-name-all-completions) - (tramp-handle-vc-registered): Use - `remote-file-name-inhibit-cache'. - (tramp-open-connection-setup-interactive-shell): Call - `tramp-cleanup-connection' directly. + (tramp-handle-vc-registered): Use `remote-file-name-inhibit-cache'. + (tramp-open-connection-setup-interactive-shell): + Call `tramp-cleanup-connection' directly. 2010-10-02 Glenn Morris <rgm@gnu.org> @@ -729,8 +3080,8 @@ * calendar/appt.el (appt-issue-message, appt-visible, appt-msg-window): Remove options, obsolete since 22.1. - (appt-display-format, appt-display-message): Remove - backwards-compatibility code. + (appt-display-format, appt-display-message): + Remove backwards-compatibility code. (appt-check): No longer check appt-issue-message. (appt-make-list): No longer autoload it. Doc fix. No longer activate the package. @@ -1802,8 +4153,8 @@ (tramp-compat-call-process): New defuns, moved from tramp.el. * net/tramp-fish.el (top) Require just 'tramp. Add objects to - `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add - to `tramp-unload-hook'. Change call of + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. + Add to `tramp-unload-hook'. Change call of `tramp-compat-decimal-to-octal' to new function name. (tramp-fish-method): Make it a defconst. (tramp-fish-file-name-p): Make it a defsubst. @@ -1838,8 +4189,8 @@ (tramp-gw-open-connection): Set tramp-autoload cookie. * net/tramp-imap.el (top) Require just 'tramp. Add objects to - `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add - to `tramp-unload-hook'. Change checks, whether package can be + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. + Add to `tramp-unload-hook'. Change checks, whether package can be loaded. (tramp-imap-file-name-p): Make it a defsubst. (tramp-imap-method, tramp-imaps-method) @@ -1847,8 +4198,8 @@ (tramp-imap-file-name-p): Set tramp-autoload cookie. * net/tramp-smb.el (top) Require just 'tramp. Add objects to - `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add - to `tramp-unload-hook'. Change checks, whether package can be + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. + Add to `tramp-unload-hook'. Change checks, whether package can be loaded. Change call of `tramp-compat-decimal-to-octal' to new function name. (tramp-smb-tunnel-method): Make it a defconst. @@ -2054,12 +4405,12 @@ * term/x-win.el: Update documentation for x-last-selected-text-*. (x-last-selected-text-cut, x-last-selected-text-cut-encoded) (x-last-cut-buffer-coding, x-cut-buffer-max): Remove. - (x-select-text): Remove argument PUSH, update documentation. Remove - cut-buffer code. + (x-select-text): Remove argument PUSH, update documentation. + Remove cut-buffer code. (x-selection-value-internal): Was previously x-selection-value. (x-selection-value): Rename from x-cut-buffer-or-selection-value. - Update documentation, remove cut-buffer code. Call - x-selection-value-internal. + Update documentation, remove cut-buffer code. + Call x-selection-value-internal. (x-clipboard-yank): Call x-selection-value-internal. (x-initialize-window-system): Remove setting of x-cut-buffer-max. @@ -2069,7 +4420,7 @@ * term/ns-win.el (x-setup-function-keys, ns-last-selected-text): x-cut-buffer-or-selection-value renamed to x-selection-value - (x-selection-value): Renamed from x-cut-buffer-or-selection-value. + (x-selection-value): Rename from x-cut-buffer-or-selection-value. (x-select-text): Remove argument PUSH, update documentation. * emacs-lisp/cl-macs.el (x-get-cutbuffer, x-get-cut-buffer): Remove. @@ -2390,8 +4741,8 @@ (tramp-gvfs-handle-copy-file, tramp-gvfs-handle-rename-file): Implement backup call, when operation on local files fails. Use progress reporter. Flush properties of changed files. - (tramp-gvfs-handle-delete-file): Add TRASH arg. Use - `tramp-compat-delete-file'. + (tramp-gvfs-handle-delete-file): Add TRASH arg. + Use `tramp-compat-delete-file'. (tramp-gvfs-handle-expand-file-name): Expand "~/". (tramp-gvfs-handle-make-directory): Make more traces. (tramp-gvfs-handle-write-region): Protect deleting tmpfile. @@ -2581,9 +4932,9 @@ whitespace-toggle-options (Bug#6479). Allow to use fill-column instead of whitespace-line-column (from EmacsWiki). New version 13.1. - (whitespace-style): Added new value 'face. Adjust docstring. - (whitespace-space, whitespace-hspace, whitespace-tab): Adjust - foreground property face. + (whitespace-style): Add new value 'face. Adjust docstring. + (whitespace-space, whitespace-hspace, whitespace-tab): + Adjust foreground property face. (whitespace-line-column): Adjust docstring and type declaration. (whitespace-style-value-list, whitespace-toggle-option-alist) (whitespace-help-text): Adjust const initialization. @@ -2611,8 +4962,8 @@ (python-shell-prompt-alist) (python-shell-continuation-prompt-alist): New options. (python--set-prompt-regexp): New function. - (inferior-python-mode, run-python, python-shell): Require - ansi-color. Use python--set-prompt-regexp to set the comint + (inferior-python-mode, run-python, python-shell): + Require ansi-color. Use python--set-prompt-regexp to set the comint prompt based on the Python interpreter. (python--prompt-regexp): New var. (python-check-comint-prompt) @@ -3198,16 +5549,16 @@ 2010-08-06 Alan Mackenzie <bug-cc-mode@gnu.org> - * progmodes/cc-cmds.el (c-mask-paragraph, c-fill-paragraph): Fix - for the case that a C style comment has its delimiters alone on + * progmodes/cc-cmds.el (c-mask-paragraph, c-fill-paragraph): + Fix for the case that a C style comment has its delimiters alone on their respective lines. 2010-08-06 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-handle-start-file-process): Set connection property "vec". - (tramp-process-sentinel): Use it for flushing the cache. We - cannot do it via the process buffer, the buffer could be deleted + (tramp-process-sentinel): Use it for flushing the cache. + We cannot do it via the process buffer, the buffer could be deleted already when running the sentinel. 2010-08-06 Jürgen Hötzel <juergen@archlinux.org> (tiny change) @@ -3221,11 +5572,11 @@ 2010-08-05 Eli Zaretskii <eliz@gnu.org> - * emacs-lisp/find-gc.el (find-gc-source-files): Rename - unexec.c => unexcoff.c. + * emacs-lisp/find-gc.el (find-gc-source-files): + Rename unexec.c => unexcoff.c. - * emacs-lisp/authors.el (authors-fixed-entries): Rename - unexec.c => unexcoff.c. + * emacs-lisp/authors.el (authors-fixed-entries): + Rename unexec.c => unexcoff.c. 2010-08-05 Michael Albinus <michael.albinus@gmx.de> @@ -3277,9 +5628,6 @@ 2010-07-31 Nathaniel Flath <flat0103@gmail.com> - Enhance Java Mode to handle Java 5.0 (Tiger) and Java 6 (Mustang). - The following functions were modified or created: - * progmodes/cc-vars.el (c-offsets-alist, c-inside-block-syms) (objc-font-lock-extra-types): * progmodes/cc-mode.el (c-basic-common-init): @@ -3295,6 +5643,8 @@ (c-forward-<>-arglist, c-forward-<>-arglist-recur) (c-forward-name, c-forward-type, c-forward-decl-or-cast-1) (c-guess-continued-construct, c-guess-basic-syntax): + Enhance Java Mode to handle Java 5.0 (Tiger) and Java 6 (Mustang). + The above functions were modified or created. 2010-07-31 Jan Djärv <jan.h.d@swipnet.se> @@ -3536,9 +5886,9 @@ * progmodes/sql.el: Version 2.3. (sql-connection-alist): Changed keys from symbols to strings; enhanced the widget definition. - (sql-mode-menu): Added submenu to select connections. - (sql-interactive-mode-menu): Added "Save Connection" item. - (sql-add-product): Fixed menu item. + (sql-mode-menu): Add submenu to select connections. + (sql-interactive-mode-menu): Add "Save Connection" item. + (sql-add-product): Fix menu item. (sql-get-product-feature): Improved error handling. (sql--alt-buffer-part, sql--alt-if-not-empty): Removed. (sql-make-alternate-buffer-name): Simplified. @@ -3550,8 +5900,8 @@ 2010-07-20 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-file-name-handler): Trace 'quit. - (tramp-open-connection-setup-interactive-shell): Apply - workaround for IRIX64 bug. Move argument of last + (tramp-open-connection-setup-interactive-shell): + Apply workaround for IRIX64 bug. Move argument of last `tramp-send-command' where it belongs to. 2010-07-20 Michael Albinus <michael.albinus@gmx.de> @@ -3578,8 +5928,8 @@ 2010-07-18 Michael R. Mauger <mmaug@yahoo.com> * progmodes/sql.el: Version 2.2. - (sql-product, sql-user, sql-database, sql-server, sql-port): Use - defcustom :safe keyword rather than putting safe-local-variable + (sql-product, sql-user, sql-database, sql-server, sql-port): + Use defcustom :safe keyword rather than putting safe-local-variable property. (sql-password): Use defcustom :risky keyword rather than putting risky-local-variable property. @@ -3589,14 +5939,14 @@ (sql-ms-login-params, sql-postgres-login-params) (sql-interbase-login-params, sql-db2-login-params) (sql-linter-login-params): Add `port' option. - (sql-get-product-feature): Added NO-INDIRECT parameter. + (sql-get-product-feature): Add NO-INDIRECT parameter. (sql-comint-oracle, sql-comint-sybase) (sql-comint-informix, sql-comint-sqlite, sql-comint-mysql) (sql-comint-solid, sql-comint-ingres, sql-comint-ms) (sql-comint-postgres, sql-comint-interbase, sql-comint-db2) - (sql-comint-linter): Renamed sql-connect-* functions to + (sql-comint-linter): Rename sql-connect-* functions to sql-comint-*. - (sql-product-alist, sql-mode-menu): Renamed as above and + (sql-product-alist, sql-mode-menu): Rename as above and :sqli-connect-func to :sqli-comint-func. (sql-connection): New variable. (sql-interactive-mode): Set it. @@ -3787,8 +6137,8 @@ 2010-07-10 Aleksei Gusev <aleksei.gusev@gmail.com> (tiny change) - * progmodes/compile.el (compilation-error-regexp-alist-alist): Add - regexps for cucumber and ruby. + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Add regexps for cucumber and ruby. 2010-07-08 Daiki Ueno <ueno@unixuser.org> @@ -3895,8 +6245,8 @@ * faces.el (x-handle-named-frame-geometry) (x-handle-reverse-video, x-create-frame-with-faces) - (face-set-after-frame-default, tty-create-frame-with-faces): Don't - separately consult default-frame-alist. It is now passed as the + (face-set-after-frame-default, tty-create-frame-with-faces): + Don't separately consult default-frame-alist. It is now passed as the PARAMETER argument. 2010-06-30 Andreas Schwab <schwab@linux-m68k.org> @@ -3921,8 +6271,8 @@ 2010-06-28 Jan Djärv <jan.h.d@swipnet.se> - * dynamic-setting.el (font-setting-change-default-font): Remove - call to message. + * dynamic-setting.el (font-setting-change-default-font): + Remove call to message. 2010-06-28 Kenichi Handa <handa@m17n.org> @@ -4174,8 +6524,8 @@ (package-list-packages-internal): Check package-load-list. (package-load-descriptor, package-generate-autoloads) (package-unpack, package-unpack-single) - (package--read-archive-file, package-delete): Use - expand-file-name. + (package--read-archive-file, package-delete): + Use expand-file-name. * emacs-lisp/package-x.el: New file. Package uploading functionality split out from package.el. @@ -4213,7 +6563,7 @@ * vc/vc-annotate.el (vc-annotate): Add an optional argument for the VC backend. Use it when non-nil. (vc-annotate-warp-revision): Pass the VC backend to vc-annotate. - (Bug#6487) + (Bug#6487). Fix vc-annotate-show-changeset-diff-revision-at-line for git. * vc/vc-annotate.el (vc-annotate-show-diff-revision-at-line-internal): @@ -4294,7 +6644,7 @@ appt-time-msg-list specify the warning time. (appt-add): Add new argument with the warning time. (Bug#5176) -2010-06-16 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change) +2010-06-16 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> * vc/vc-svn.el (vc-svn-after-dir-status): Fix regexp for Subversions older than version 1.6. (Bug#6361) @@ -4306,15 +6656,15 @@ 2010-06-16 AgustÃn MartÃn <agustin.martin@hispalinux.es> - * textmodes/ispell.el (ispell-dictionary-base-alist): Fix - portuguese casechars/not-casechars for missing 'çÇ'. + * textmodes/ispell.el (ispell-dictionary-base-alist): + Fix portuguese casechars/not-casechars for missing 'çÇ'. Suggested by Rolando Pereira (bug#6434). 2010-06-15 Juanma Barranquero <lekktu@gmail.com> * facemenu.el (list-colors-sort): Doc fix. -2010-06-15 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> (tiny change) +2010-06-15 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> * progmodes/sql.el (sql-connect-mysql): Fix typo. @@ -4794,8 +7144,8 @@ 2010-05-28 Michael Albinus <michael.albinus@gmx.de> - * net/tramp-compat.el (tramp-compat-delete-file): Use - `symbol-value' for backward compatibility. + * net/tramp-compat.el (tramp-compat-delete-file): + Use `symbol-value' for backward compatibility. * net/tramp.el (tramp-handle-make-symbolic-link) (tramp-handle-load) @@ -4813,15 +7163,15 @@ (tramp-fish-handle-process-file): Use `delete-file' instead of `tramp-compat-delete-file'. - * net/tramp-ftp.el (tramp-ftp-file-name-handler): Use - `delete-file' instead of `tramp-compat-delete-file'. + * net/tramp-ftp.el (tramp-ftp-file-name-handler): + Use `delete-file' instead of `tramp-compat-delete-file'. * net/tramp-gvfs.el (tramp-gvfs-handle-delete-file): Rename arg. (tramp-gvfs-handle-write-region): Use `delete-file' instead of `tramp-compat-delete-file'. - * net/tramp-imap.el (tramp-imap-do-copy-or-rename-file): Use - `delete-file' instead of `tramp-compat-delete-file'. + * net/tramp-imap.el (tramp-imap-do-copy-or-rename-file): + Use `delete-file' instead of `tramp-compat-delete-file'. * net/tramp-smb.el (tramp-smb-handle-copy-file) (tramp-smb-handle-file-local-copy, tramp-smb-handle-rename-file) @@ -4896,8 +7246,8 @@ 2010-05-27 Chong Yidong <cyd@stupidchicken.com> - * progmodes/verilog-mode.el (verilog-type-font-keywords): Use - font-lock-constant-face, not obsolete font-lock-reference-face. + * progmodes/verilog-mode.el (verilog-type-font-keywords): + Use font-lock-constant-face, not obsolete font-lock-reference-face. 2010-05-27 Kenichi Handa <handa@m17n.org> @@ -4981,8 +7331,8 @@ * net/tramp.el (tramp-progress-reporter-update): New defun. (with-progress-reporter): Use it. (tramp-process-actions): - * net/tramp-gvfs.el (tramp-gvfs-handler-askquestion): Preserve - current message, in order to let progress reporter continue + * net/tramp-gvfs.el (tramp-gvfs-handler-askquestion): + Preserve current message, in order to let progress reporter continue afterwards. (Bug#6257) 2010-05-25 Glenn Morris <rgm@gnu.org> @@ -5286,8 +7636,8 @@ * bindings.el (global-map): Bind them to right and left arrow keys. Don't override standard definition of convert-standard-filename. - * files.el (convert-standard-filename): Call - w32-convert-standard-filename and dos-convert-standard-filename on + * files.el (convert-standard-filename): + Call w32-convert-standard-filename and dos-convert-standard-filename on the corresponding systems. * w32-fns.el (w32-convert-standard-filename): Rename from @@ -5787,8 +8137,8 @@ * net/tramp-smb.el (tramp-smb-handle-delete-file): Add FORCE arg. (tramp-smb-handle-copy-file, tramp-smb-handle-file-local-copy) - (tramp-smb-handle-rename-file, tramp-smb-handle-write-region): Use - `tramp-compat-delete-file'. + (tramp-smb-handle-rename-file, tramp-smb-handle-write-region): + Use `tramp-compat-delete-file'. 2010-05-05 Stefan Monnier <monnier@iro.umontreal.ca> @@ -7614,8 +9964,8 @@ 2010-02-21 Chong Yidong <cyd@stupidchicken.com> - * files.el (directory-listing-before-filename-regexp): Use - stricter matching for iso-style dates, to avoid false matches with + * files.el (directory-listing-before-filename-regexp): + Use stricter matching for iso-style dates, to avoid false matches with date-like filenames (Bug#5597). * htmlfontify.el (htmlfontify): Doc fix. @@ -7638,8 +9988,8 @@ 2010-02-19 Chong Yidong <cyd@stupidchicken.com> - * isearch.el (isearch-update-post-hook, isearch-update): Revert - 2010-02-17 change. + * isearch.el (isearch-update-post-hook, isearch-update): + Revert 2010-02-17 change. 2010-02-19 Ulf Jasper <ulf.jasper@web.de> @@ -7874,7 +10224,8 @@ 2010-02-06 Dan Nicolaescu <dann@ics.uci.edu> - * vc-bzr.el (vc-bzr-dir-extra-headers): Disable the pending merges header. + * vc-bzr.el (vc-bzr-dir-extra-headers): + Disable the pending merges header. 2010-02-05 Juri Linkov <juri@jurta.org> @@ -8092,7 +10443,7 @@ * vc-bzr.el (vc-bzr-revision-table): New function. -2010-01-25 Eric Hanchrow <eric.hanchrow@gmail.com> (tiny change) +2010-01-25 Eric Hanchrow <eric.hanchrow@gmail.com> * vc-git.el (vc-git-dir-status-goto-stage): Pass --relative to the diff-index command. This requires at least git-1.5.5. (Bug#1589). @@ -8105,8 +10456,8 @@ (vc-git-toggle-signoff): Remove function. (vc-git-extra-menu-map): Do not bind vc-git-toggle-signoff. - * term/xterm.el (xterm-maybe-set-dark-background-mode): Rename - from xterm-set-background-mode. Return t if the background mode + * term/xterm.el (xterm-maybe-set-dark-background-mode): + Rename from xterm-set-background-mode. Return t if the background mode was set. (terminal-init-xterm): Move tty-set-up-initial-frame-faces earlier, call it again in case the background mode has changed. @@ -8270,8 +10621,8 @@ 2010-01-16 Lennart Borgman <lennart.borgman@gmail.com> - * nxml/nxml-mode.el (nxml-extend-after-change-region): Never - return t (Bug#3898). + * nxml/nxml-mode.el (nxml-extend-after-change-region): + Never return t (Bug#3898). 2010-01-16 Frédéric Perrin <frederic.perrin@resel.fr> (tiny change) @@ -8388,8 +10739,8 @@ 2010-01-12 Glenn Morris <rgm@gnu.org> - * mail/emacsbug.el (report-emacs-bug-pretest-address): Set - it to bug-gnu-emacs rather than emacs-pretest-bug. + * mail/emacsbug.el (report-emacs-bug-pretest-address): + Set it to bug-gnu-emacs rather than emacs-pretest-bug. 2010-01-11 Sam Steingold <sds@gnu.org> @@ -8703,8 +11054,8 @@ 2009-12-29 Dan Nicolaescu <dann@ics.uci.edu> Make vc-dir work on subdirectories of the bzr root. - * vc-bzr.el (vc-bzr-after-dir-status): Add new argument. Return - file names relative to it. + * vc-bzr.el (vc-bzr-after-dir-status): Add new argument. + Return file names relative to it. (vc-bzr-dir-status, vc-bzr-dir-status-files): Pass the bzr root relative directory to vc-bzr-after-dir-status. @@ -8748,7 +11099,7 @@ 2009-12-25 Kenichi Handa <handa@m17n.org> - * language/indian.el (devanagari-composable-pattern): Fixed to + * language/indian.el (devanagari-composable-pattern): Fix to handle ZWNJ and ZWJ. Use it in composition-function-table for Devanagari. (malayalam-composable-pattern): Fix previous change. @@ -9164,11 +11515,11 @@ (tramp-methods, tramp-find-shell) (tramp-open-connection-setup-interactive-shell) (tramp-maybe-open-connection): Use it. - (tramp-shell-prompt-pattern, tramp-wait-for-output): Handle - existence of `#' and `$'. + (tramp-shell-prompt-pattern, tramp-wait-for-output): + Handle existence of `#' and `$'. - * net/tramp-fish.el (tramp-fish-maybe-open-connection): Use - `tramp-initial-end-of-output'. + * net/tramp-fish.el (tramp-fish-maybe-open-connection): + Use `tramp-initial-end-of-output'. 2009-12-07 Dan Nicolaescu <dann@ics.uci.edu> @@ -9226,13 +11577,13 @@ 2009-12-06 Ulf Jasper <ulf.jasper@web.de> - * xml.el (xml-substitute-numeric-entities): Move - newsticker--decode-numeric-entities in newst-backend.el to + * xml.el (xml-substitute-numeric-entities): + Move newsticker--decode-numeric-entities in newst-backend.el to xml-substitute-numeric-entities in xml.el. (Bug#5008) * net/newst-backend.el (newsticker--parse-generic-feed) (newsticker--parse-generic-items) - (newsticker--decode-numeric-entities): Move - newsticker--decode-numeric-entities in newst-backend.el to + (newsticker--decode-numeric-entities): + Move newsticker--decode-numeric-entities in newst-backend.el to xml-substitute-numeric-entities in xml.el. (Bug#5008) 2009-12-06 Daniel Colascione <dan.colascione@gmail.com> @@ -9295,8 +11646,8 @@ 2009-12-05 Kevin Ryde <user42@zip.com.au> - * textmodes/sgml-mode.el (sgml-lexical-context): Recognise - comment-start-skip to comment-end-skip as comment (Bug#4781). + * textmodes/sgml-mode.el (sgml-lexical-context): + Recognise comment-start-skip to comment-end-skip as comment (Bug#4781). 2009-12-05 Juri Linkov <juri@jurta.org> @@ -9385,7 +11736,7 @@ (newsticker-treeview-next-new-or-immortal-item): Doc change. (newsticker--treeview-first-feed): Doc change. (newsticker-treeview-list-menu) - (newsticker-treeview-item-menu): Added menu entries. + (newsticker-treeview-item-menu): Add menu entries. (newsticker-treeview-item-mode): New. * net/newst-backend.el (newsticker-customize): Delete other @@ -9753,8 +12104,8 @@ (doc-view-scroll-up-or-next-page) (doc-view-scroll-down-or-previous-page) (doc-view-next-line-or-next-page) - (doc-view-previous-line-or-previous-page): Rename - `doc-view-continuous-mode' to `doc-view-continuous'. (Bug#4896) + (doc-view-previous-line-or-previous-page): + Rename `doc-view-continuous-mode' to `doc-view-continuous'. (Bug#4896) 2009-11-30 Juri Linkov <juri@jurta.org> @@ -9956,8 +12307,8 @@ (verilog-auto-inst, verilog-auto-star-safe) (verilog-delete-auto-star-implicit, verilog-read-sub-decls): - Fix removing "// Interfaces" when saving .* expansions. Reported by - Pierre-David Pfister. + Fix removing "// Interfaces" when saving .* expansions. + Reported by Pierre-David Pfister. 2009-11-26 Glenn Morris <rgm@gnu.org> @@ -11135,12 +13486,12 @@ (tramp-compat-delete-directory): New defuns. * net/tramp-fish.el (tramp-fish-handle-delete-directory): - * net/tramp-gvfs.el (tramp-gvfs-handle-delete-directory): Use - `tramp-compat-delete-directory'. + * net/tramp-gvfs.el (tramp-gvfs-handle-delete-directory): + Use `tramp-compat-delete-directory'. * net/tramp-smb.el (tramp-smb-handle-copy-directory) - (tramp-smb-handle-delete-directory): Use - `tramp-compat-copy-directory' and `tramp-compat-delete-directory'. + (tramp-smb-handle-delete-directory): + Use `tramp-compat-copy-directory' and `tramp-compat-delete-directory'. * net/trampver.el: Update release number. @@ -11492,11 +13843,11 @@ 2009-10-31 Chong Yidong <cyd@stupidchicken.com> - * international/mule-diag.el (list-character-sets-1): Minor - message fix (Bug#3526). + * international/mule-diag.el (list-character-sets-1): + Minor message fix (Bug#3526). - * progmodes/etags.el (etags-list-tags, etags-tags-apropos): Fix - face property (Bug#4834). + * progmodes/etags.el (etags-list-tags, etags-tags-apropos): + Fix face property (Bug#4834). (etags-list-tags, etags-tags-apropos-additional) (etags-tags-apropos, tags-select-tags-table): Add follow-link property. @@ -11993,8 +14344,8 @@ 2009-10-23 Jay Belanger <jay.p.belanger@gmail.com> - * calc/calc.el (math-read-number, math-read-number-simple): Use - `save-match-data'. + * calc/calc.el (math-read-number, math-read-number-simple): + Use `save-match-data'. 2009-10-22 Stefan Monnier <monnier@iro.umontreal.ca> @@ -13309,8 +15660,8 @@ 2009-09-26 Alan Mackenzie <acm@muc.de> - * progmodes/cc-engine.el (c-beginning-of-statement-1): Correct - buggy bracketing. (Bug#4289) + * progmodes/cc-engine.el (c-beginning-of-statement-1): + Correct buggy bracketing. (Bug#4289) * progmodes/cc-langs.el (c-nonlabel-token-key): Allow quoted character constants (as case labels). (Bug#4289) @@ -13693,8 +16044,8 @@ 2009-09-21 Chong Yidong <cyd@stupidchicken.com> - * files.el (conf-mode-maybe, magic-fallback-mode-alist): Use - nxml-mode instead of xml-mode. + * files.el (conf-mode-maybe, magic-fallback-mode-alist): + Use nxml-mode instead of xml-mode. 2009-09-21 Kevin Ryde <user42@zip.com.au> @@ -14515,8 +16866,8 @@ * net/tramp.el (tramp-handle-insert-directory): Handle "--dired" also when adding a new directory. - * net/tramp-compat.el (tramp-compat-line-beginning-position): New - defun. + * net/tramp-compat.el (tramp-compat-line-beginning-position): + New defun. 2009-09-04 Stefan Monnier <monnier@iro.umontreal.ca> @@ -14984,7 +17335,7 @@ Don't modify last-coding-system-used by accident. (tramp-completion-file-name-handler): Apply the checks here, instead during registration. - (tramp-register-file-name-handlers): Renamed from + (tramp-register-file-name-handlers): Rename from `tramp-register-file-name-handler'. Register both `tramp-file-name-handler' and `tramp-completion-file-name-handler'. (tramp-register-completion-file-name-handler): Remove. (Bug#4260) @@ -15776,7 +18127,7 @@ 'update signal. Instead, update all disassembly buffers only after threads list. (gdb): Send -target-detach when buffer is killed (Bug#3794). - (gdb-starting): Moved -data-list-register-names... + (gdb-starting): Move -data-list-register-names... (gdb-stopped): ...here so it's sent when first thread stops. (gdb-registers-handler-custom): Do nothing if register names are unknown yet. @@ -15843,8 +18194,8 @@ (gdb-control-current-thread): Interactive setters for `gdb-gud-control-all-threads' to use in menu. (gdb-show-run-p): Show «Go» when process is not active. - (gud-tool-bar-map): Add non-stop/A,T indicator. Uses - gud/thread.xpm and gud/all.xpm. + (gud-tool-bar-map): Add non-stop/A,T indicator. + Uses gud/thread.xpm and gud/all.xpm. 2009-08-08 Yoni Rabkin <yoni@rabkins.net> @@ -15868,8 +18219,8 @@ (gdb-breakpoints-mode-map): Don't assume threads buffer is present. (gdb-threads-mode-map): Don't assume breakpoints buffer is present. (gdb-disassembly-handler-custom, gdb-stack-list-frames-custom) - (gdb-locals-handler-custom, gdb-registers-handler-custom): Thread - info in mode name. + (gdb-locals-handler-custom, gdb-registers-handler-custom): + Thread info in mode name. (gdb-registers-mode-map): TAB to switch to locals. 2009-08-08 Eli Zaretskii <eliz@gnu.org> @@ -15884,14 +18235,14 @@ 2009-08-07 Eli Zaretskii <eliz@gnu.org> - * mail/sendmail.el (mail-yank-original): Set - buffer-file-coding-system from the one used by the message whose + * mail/sendmail.el (mail-yank-original): + Set buffer-file-coding-system from the one used by the message whose text is yanked. * calc/calc-graph.el (calc-graph-plot): Set calc-graph-last-device to "windows" when "pgnuplot" is used. - (calc-graph-command, calc-gnuplot-command, calc-graph-init): Don't - call accept-process-output if "pgnuplot" is used. + (calc-graph-command, calc-gnuplot-command, calc-graph-init): + Don't call accept-process-output if "pgnuplot" is used. (calc-graph-init): Don't send -display and -geometry to "pgnuplot". If "pgnuplot" is used, glean gnuplot version by running "pgnuplot -V" with shell-command-to-string. @@ -15915,8 +18266,8 @@ * progmodes/gdb-mi.el (gdb-var-create-regexp): Removed. (gdb-var-create-handler): Rewritten using JSON parser. - (gdb-propertize-header): Moved earlier. - (gdb-set-header): Removed to avoid duplication. + (gdb-propertize-header): Move earlier. + (gdb-set-header): Remove to avoid duplication. (gdb-thread-list-handler-custom, gdb-invalidate-disassembly): Refresh disassembly buffers only after threads list have been update. @@ -15986,7 +18337,7 @@ (gdb-locals-handler-custom): Now prints data like in variable declarations. (gdb-jump-to, gdb-file-button, gdb-insert-file-location-button): - Removed confusing buttons. + Remove confusing buttons. (gdb-invalidate-threads): Append --frame. (gdb-threads-mode-map, gdb-breakpoints-mode-map): TAB to switch between breakpoints/threads buffers. @@ -16031,11 +18382,11 @@ * progmodes/gdb-mi.el (gdb-thread-number): Initialize with nil. (gdb-current-context-command): Do not append --thread if `gdb-thread-number' is nil. - (gdb-running-threads-count, gdb-stopped-threads-count): New - variables. + (gdb-running-threads-count, gdb-stopped-threads-count): + New variables. (gdb-non-stop, gdb-gud-control-all-threads, gdb-switch-reasons) - (gdb-stopped-hooks, gdb-switch-when-another-stopped): New - customization options. + (gdb-stopped-hooks, gdb-switch-when-another-stopped): + New customization options. (gdb-gud-context-command, gdb-gud-context-call): New wrappers for GUD commands. (gdb): `gud-def' definitions changed to use `gdb-gud-context-call'. @@ -16064,7 +18415,7 @@ (def-gdb-auto-update-handler): New nopreserve optional argument. (gdb-stack-list-frames-custom): Print stack from top to bottom. - * progmodes/gdb-mi.el (gdb-pc-address): Removed unused variable. + * progmodes/gdb-mi.el (gdb-pc-address): Remove unused variable. (gdb-threads-list, gdb-breakpoints-list): New assoc lists. (gdb-parent-mode): New mode to derive other GDB modes from. (gdb-display-disassembly-for-thread) @@ -16088,7 +18439,7 @@ (gdb-display-registers-for-thread, gdb-frame-stack-for-thread) (gdb-frame-locals-for-thread, gdb-frame-registers-for-thread): New commands which show buffers bound to thread. - (gdb-stack-list-locals-regexp): Removed unused regexp. + (gdb-stack-list-locals-regexp): Remove unused regexp. * progmodes/gdb-mi.el (gdb-breakpoints-buffer-name) (gdb-locals-buffer-name, gdb-registers-buffer-name) @@ -16159,8 +18510,8 @@ * net/tramp-cache.el (tramp-cache-inhibit-cache): New defvar. (tramp-get-file-property): Use it. - * autorevert.el (auto-revert-handler): Allow - `auto-revert-tail-mode' for remote files. + * autorevert.el (auto-revert-handler): + Allow `auto-revert-tail-mode' for remote files. 2009-08-02 Jason Rumney <jasonr@gnu.org> @@ -16170,8 +18521,8 @@ 2009-08-02 Chong Yidong <cyd@stupidchicken.com> * font-lock.el (font-lock-string-face, font-lock-builtin-face) - (font-lock-variable-name-face, font-lock-constant-face): Darken - the colors for light backgrounds. + (font-lock-variable-name-face, font-lock-constant-face): + Darken the colors for light backgrounds. 2009-08-01 Eli Zaretskii <eliz@gnu.org> @@ -16271,8 +18622,8 @@ * net/zeroconf.el (zeroconf-init): Check for "GetVersionString" instead of "IsNSSSupportAvailable". Avahi ought to work also when - "IsNSSSupportAvailable" method is not available. Reported by - Steve Youngs <steve@sxemacs.org>. + "IsNSSSupportAvailable" method is not available. + Reported by Steve Youngs <steve@sxemacs.org>. 2009-07-24 Kenichi Handa <handa@m17n.org> @@ -16397,11 +18748,11 @@ 2009-07-21 Chong Yidong <cyd@stupidchicken.com> - * mail/rmailedit.el (rmail-edit-mode): Use - auto-save-include-big-deletions. + * mail/rmailedit.el (rmail-edit-mode): + Use auto-save-include-big-deletions. - * mail/rmail.el (rmail-variables): Use - auto-save-include-big-deletions. + * mail/rmail.el (rmail-variables): + Use auto-save-include-big-deletions. * files.el (auto-save-mode): Revert 2009-07-21 and 2009-07-16 changes. @@ -16577,8 +18928,8 @@ * w32-fns.el (x-selection-owner-p): New function. * mouse.el (mouse-drag-track): Call deactivate-mark earlier. - (mouse-yank-at-click, mouse-yank-primary): If - select-active-regions is non-nil, deactivate the mark before + (mouse-yank-at-click, mouse-yank-primary): + If select-active-regions is non-nil, deactivate the mark before insertion. * simple.el (deactivate-mark, set-mark): Only save selection if we @@ -16647,11 +18998,11 @@ * select.el (x-set-selection): Doc fix. (x-valid-simple-selection-p): Allow buffer values. - (xselect--selection-bounds): Handle buffer values. Suggested by - David De La Harpe Golden. + (xselect--selection-bounds): Handle buffer values. + Suggested by David De La Harpe Golden. - * mouse.el (mouse-set-region, mouse-drag-track): Call - copy-region-as-kill before setting the mark, to let + * mouse.el (mouse-set-region, mouse-drag-track): + Call copy-region-as-kill before setting the mark, to let select-active-regions work. 2009-07-15 David De La Harpe Golden <david@harpegolden.net> @@ -16853,8 +19204,8 @@ * progmodes/gdb-mi.el: Port memory buffer from gdb-ui.el. (gdb-memory-address): New variable which holds top address of memory page shown in memory buffer. - (gdb-memory-repeat-count, gdb-memory-format, gdb-memory-unit): New - customization variables. + (gdb-memory-repeat-count, gdb-memory-format, gdb-memory-unit): + New customization variables. New functions: (gdb-display-memory-buffer, gdb-frame-memory-buffer): Functions to display the memory buffer. @@ -16867,8 +19218,8 @@ (gdb-memory-unit-word, gdb-memory-unit-halfword) (gdb-memory-unit-giant, gdb-memory-unit-byte): Functions to set unit size used in memory buffer. - (gdb-memory-show-next-page, gdb-memory-show-previous-page): Switch - to next/previous page of memory buffer. + (gdb-memory-show-next-page, gdb-memory-show-previous-page): + Switch to next/previous page of memory buffer. Now using (bindat-get-field) instead of fadr functions. 2009-07-07 Sam Steingold <sds@gnu.org> @@ -16878,8 +19229,8 @@ 2009-07-07 Kenichi Handa <handa@m17n.org> - * international/mule-cmds.el (reset-language-environment): Put - the highset priority to the charset iso-8859-1. + * international/mule-cmds.el (reset-language-environment): + Put the highset priority to the charset iso-8859-1. 2009-07-06 Chong Yidong <cyd@stupidchicken.com> @@ -16909,8 +19260,8 @@ (woman-file-name, woman2-format-paragraphs) (woman-leave-blank-lines): Code cleanup. (woman-use-own-frame): Change default to nil. - (woman-italic, woman-bold, woman-unknown, woman-addition): Change - defaults to inherit from default faces. + (woman-italic, woman-bold, woman-unknown, woman-addition): + Change defaults to inherit from default faces. (woman2-process-escapes): Consume the newline after a stand-alone filler character (Bug#3651). @@ -17204,8 +19555,8 @@ (verilog-auto-ascii-enum): Support one-hot state machines in AUTOASCIIENUM. Suggested by Lloyd Gomez. (verilog-auto-inst, verilog-auto-inst-port): Include interface - modport in AUTOINST and add vl-modport for users. Reported by - David Rogoff. + modport in AUTOINST and add vl-modport for users. + Reported by David Rogoff. (verilog-auto-inout-module, verilog-auto-inst) (verilog-decls-get-interfaces, verilog-insert-definition) (verilog-insert-one-definition, verilog-read-decls) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 6e48360587f..9d0e86fbce8 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1,7 +1,7 @@ ;;; abbrev.el --- abbrev mode commands for Emacs -;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: abbrev convenience @@ -57,18 +57,10 @@ define global abbrevs instead." "Toggle Abbrev mode in the current buffer. With optional argument ARG, turn abbrev mode on if ARG is positive, otherwise turn it off. In Abbrev mode, inserting an -abbreviation causes it to expand and be replaced by its expansion.") +abbreviation causes it to expand and be replaced by its expansion." + ;; It's defined in C, this stops the d-m-m macro defining it again. + :variable abbrev-mode) -(defcustom abbrev-mode nil - "Enable or disable Abbrev mode. -Non-nil means automatically expand abbrevs as they are inserted. - -Setting this variable with `setq' changes it for the current buffer. -Changing it with \\[customize] sets the default value. -Interactively, use the command `abbrev-mode' -to enable or disable Abbrev mode in the current buffer." - :type 'boolean - :group 'abbrev-mode) (put 'abbrev-mode 'safe-local-variable 'booleanp) @@ -927,5 +919,4 @@ SORTFUN is passed to `sort' to change the default ordering." (provide 'abbrev) -;; arch-tag: dbd6f3ae-dfe3-40ba-b00f-f9e3ff960df5 ;;; abbrev.el ends here diff --git a/lisp/allout.el b/lisp/allout.el index 5c7577d5353..b497c82f0b3 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1,12 +1,12 @@ ;;; allout.el --- extensive outline mode for use alone and with other modes -;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; 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,145 @@ ;;;_* 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 +(defvar allout-command-prefix) ; defined below +(defvar allout-mode-map) + +;;;_ > 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 +257,13 @@ unless optional third, non-nil element is present.") ("\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 +881,7 @@ disable auto-saves for that file." ;;;_ + 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 +920,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring." ;;;_ #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 +1291,13 @@ See doc string for `allout-keybindings-list' for format of binding list." (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 +1413,7 @@ The settings are stored on `allout-mode-prior-settings'." (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 +1676,14 @@ and the place for the cursor after the decryption is done." (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 +1697,7 @@ and the place for the cursor after the decryption is done." 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 +1733,7 @@ the following two lines in your Emacs init file: \(allout-init t)" (interactive) - (if (called-interactively-p 'interactive) + (if (allout-called-interactively-p) (progn (setq mode (completing-read @@ -1614,7 +1757,7 @@ the following two lines in your Emacs init file: (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 +1799,7 @@ the following two lines in your Emacs init file: (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 +2259,11 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (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 +2298,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." ;;;_ - 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 +2307,8 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." &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 +2370,9 @@ See `allout-overlay-interior-modification-handler' for details." (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 +2654,7 @@ Outermost is first." ;;;_ > 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 +2673,7 @@ Outermost is first." (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 +2719,20 @@ Outermost is first." (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 +3045,8 @@ otherwise skip white space between bullet and ensuing text." (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 +3054,13 @@ If interactive, we position at the end of the prefix. 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 +3114,20 @@ excluded as delimiting whitespace between topics. 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 +3177,9 @@ collapsed." (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 +3205,7 @@ which case point is returned to its original starting location." (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 +3233,7 @@ Returning depth if successful, nil if not." (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 +3378,7 @@ Presumes point is at the start of a topic prefix." (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 +3431,7 @@ A heading line is one that starts with a `*' (or that `allout-regexp' 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 +3452,7 @@ Returns resulting position, else nil if none found." (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 +3465,7 @@ Returns resulting position, else nil if none found." (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 +3550,10 @@ this-command accordingly. 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 +3567,7 @@ Returns the qualifying command, if any, else nil." (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 +3575,22 @@ Returns the qualifying command, if any, else nil." (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 +3619,7 @@ Offer one suitable for current depth DEPTH as default." (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 +4617,9 @@ Topic exposure is marked with text-properties, to be used by (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 +4658,8 @@ Topic exposure is marked with text-properties, to be used by (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 +4669,8 @@ Topic exposure is marked with text-properties, to be used by ;; 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 +4885,7 @@ by pops to non-distinctive yanks. Bug..." (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 +4926,10 @@ invoked.)" (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 +5008,7 @@ point of non-opened subtree?)" (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 +5835,7 @@ environment. Leaves point at the end of the line." (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 +6138,7 @@ See `allout-toggle-current-subtree-encryption' for more details." ;; 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 +6281,7 @@ Returns the resulting string, or nil if the transformation fails." (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 +6993,14 @@ If BEG is bigger than END we return 0." ((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 +7111,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (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 +7161,42 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (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 +7228,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." ;;;_ > 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 +7247,12 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (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 +7261,11 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (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 +7276,16 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (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 +7304,24 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." '(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 +7357,4 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." ;;allout-layout: (0 : -1 -1 0) ;;End: -;; arch-tag: cf38fbc3-c044-450f-8bff-afed8ba5681c ;;; allout.el ends here diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 6bc95fa8d94..98eeca325b2 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -215,48 +215,10 @@ This is a good function to put in `comint-output-filter-functions'." (add-hook 'comint-output-filter-functions 'ansi-color-process-output) - -;; Alternative font-lock-unfontify-region-function for Emacs only - -(defun ansi-color-unfontify-region (beg end &rest xemacs-stuff) - "Replacement function for `font-lock-default-unfontify-region'. - -As text properties are implemented using extents in XEmacs, this -function is probably not needed. In Emacs, however, things are a bit -different: When font-lock is active in a buffer, you cannot simply add -face text properties to the buffer. Font-lock will remove the face -text property using `font-lock-unfontify-region-function'. If you want -to insert the strings returned by `ansi-color-apply' into such buffers, -you must set `font-lock-unfontify-region-function' to -`ansi-color-unfontify-region'. This function will not remove all face -text properties unconditionally. It will keep the face text properties -if the property `ansi-color' is set. - -The region from BEG to END is unfontified. XEMACS-STUFF is ignored. - -A possible way to install this would be: - -\(add-hook 'font-lock-mode-hook - \(function (lambda () - \(setq font-lock-unfontify-region-function - 'ansi-color-unfontify-region))))" - ;; Simplified now that font-lock-unfontify-region uses save-buffer-state. - (when (boundp 'font-lock-syntactic-keywords) - (remove-text-properties beg end '(syntax-table nil))) - ;; instead of just using (remove-text-properties beg end '(face - ;; nil)), we find regions with a non-nil face text-property, skip - ;; positions with the ansi-color property set, and remove the - ;; remaining face text-properties. - (while (setq beg (text-property-not-all beg end 'face nil)) - (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) - (when (get-text-property beg 'face) - (let ((end-face (or (text-property-any beg end 'face nil) - end))) - (remove-text-properties beg end-face '(face nil)) - (setq beg end-face))))) +(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region) +(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1") ;; Working with strings - (defvar ansi-color-context nil "Context saved between two calls to `ansi-color-apply'. This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of @@ -290,9 +252,7 @@ This function can be added to `comint-preoutput-filter-functions'." (setq fragment (substring string pos) result (concat result (substring string start pos)))) (setq result (concat result (substring string start)))) - (if fragment - (setq ansi-color-context (list nil fragment)) - (setq ansi-color-context nil))) + (setq ansi-color-context (if fragment (list nil fragment)))) result)) (defun ansi-color-apply (string) @@ -309,10 +269,7 @@ Every call to this function will set and use the buffer-local variable This information will be used for the next call to `ansi-color-apply'. Set `ansi-color-context' to nil if you don't want this. -This function can be added to `comint-preoutput-filter-functions'. - -You cannot insert the strings returned into buffers using font-lock. -See `ansi-color-unfontify-region' for a way around this." +This function can be added to `comint-preoutput-filter-functions'." (let ((face (car ansi-color-context)) (start 0) end escape-sequence result colorized-substring) @@ -325,8 +282,7 @@ See `ansi-color-unfontify-region' for a way around this." (setq escape-sequence (match-string 1 string)) ;; Colorize the old block from start to end using old face. (when face - (put-text-property start end 'ansi-color t string) - (put-text-property start end 'face face string)) + (put-text-property start end 'font-lock-face face string)) (setq colorized-substring (substring string start end) start (match-end 0)) ;; Eliminate unrecognized ANSI sequences. @@ -338,8 +294,7 @@ See `ansi-color-unfontify-region' for a way around this." (setq face (ansi-color-apply-sequence escape-sequence face))) ;; if the rest of the string should have a face, put it there (when face - (put-text-property start (length string) 'ansi-color t string) - (put-text-property start (length string) 'face face string)) + (put-text-property start (length string) 'font-lock-face face string)) ;; save context, add the remainder of the string to the result (let (fragment) (if (string-match "\033" string start) @@ -347,9 +302,7 @@ See `ansi-color-unfontify-region' for a way around this." (setq fragment (substring string pos)) (push (substring string start pos) result)) (push (substring string start) result)) - (if (or face fragment) - (setq ansi-color-context (list face fragment)) - (setq ansi-color-context nil))) + (setq ansi-color-context (if (or face fragment) (list face fragment)))) (apply 'concat (nreverse result)))) ;; Working with regions diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 6dda7b2e40b..4a80b74e958 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -616,7 +616,7 @@ the mode is invalid. If ERROR is nil then nil will be returned." (defun archive-get-lineno () (if (>= (point) archive-file-list-start) (count-lines archive-file-list-start - (save-excursion (beginning-of-line) (point))) + (line-beginning-position)) 0)) (defun archive-get-descr (&optional noerror) @@ -1813,10 +1813,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." archive ;; unzip expands wildcards in NAME, so we need to quote it. But ;; not on DOS/Windows, since that fails extraction on those - ;; systems, and file names with wildcards in zip archives don't - ;; work there anyway. + ;; systems (unless w32-quote-process-args is nil), and file names + ;; with wildcards in zip archives don't work there anyway. ;; FIXME: Does pkunzip need similar treatment? - (if (and (not (memq system-type '(windows-nt ms-dos))) + (if (and (or (not (memq system-type '(windows-nt ms-dos))) + (and (boundp 'w32-quote-process-args) + (null w32-quote-process-args))) (equal (car archive-zip-extract) "unzip")) (shell-quote-argument name) name) @@ -2213,5 +2215,4 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (provide 'arc-mode) -;; arch-tag: e5966a01-35ec-4f27-8095-a043a79b457b ;;; arc-mode.el ends here diff --git a/lisp/array.el b/lisp/array.el index d22d58ca059..1f04e8ef724 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -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 @@ of `array-rows-numbered'." (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 @@ Entering array mode calls the function `array-mode-hook'." (provide 'array) -;; arch-tag: 0086605d-79fe-4a1a-992a-456417261f80 ;;; array.el ends here diff --git a/lisp/avoid.el b/lisp/avoid.el index adfb1dd78c8..4b713b827b6 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -278,7 +278,8 @@ redefine this function to suit your own tastes." (defun mouse-avoidance-ignore-p () (let ((mp (mouse-position))) - (or executing-kbd-macro ; don't check inside macro + (or (not (frame-pointer-visible-p)) ; The pointer is hidden + executing-kbd-macro ; don't check inside macro (null (cadr mp)) ; don't move unless in an Emacs frame (not (eq (car mp) (selected-frame))) ;; Don't do anything if last event was a mouse event. diff --git a/lisp/bindings.el b/lisp/bindings.el index d19db2c779e..bd4a1203364 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -318,7 +318,7 @@ Keymap to display on column and line numbers.") mouse-2: Make current window occupy the whole frame\n\ mouse-3: Remove current window from display") (recursive-edit-help-echo "Recursive edit, type C-M-c to get out") - (dashes (propertize "--" 'help-echo help-echo)) + (spaces (propertize " " 'help-echo help-echo)) (standard-mode-line-format (list "%e" @@ -334,9 +334,10 @@ mouse-3: Remove current window from display") '(vc-mode vc-mode) (propertize " " 'help-echo help-echo) 'mode-line-modes - `(which-func-mode ("" which-func-format ,dashes)) - `(global-mode-string ("" global-mode-string ,dashes)) - (propertize "-%-" 'help-echo help-echo))) + `(which-func-mode ("" which-func-format ,spaces)) + `(global-mode-string ("" global-mode-string ,spaces)) + `(:eval (unless (display-graphic-p) + ,(propertize "-%-" 'help-echo help-echo))))) (standard-mode-line-modes (list (propertize "%[" 'help-echo recursive-edit-help-echo) @@ -362,7 +363,7 @@ mouse-3: Toggle minor modes" 'mouse-2 #'mode-line-widen)) (propertize ")" 'help-echo help-echo) (propertize "%]" 'help-echo recursive-edit-help-echo) - (propertize "--" 'help-echo help-echo))) + spaces)) (standard-mode-line-position `((-3 ,(propertize @@ -654,6 +655,16 @@ is okay. See `mode-line-format'.") (define-key esc-map "\t" 'complete-symbol) +(defun complete-symbol (arg) + "Perform completion on the text around point. +The completion method is determined by `completion-at-point-functions'. + +With a prefix argument, this command does completion within +the collection of symbols listed in the index of the manual for the +language you are using." + (interactive "P") + (if arg (info-complete-symbol) (completion-at-point))) + ;; Reduce total amount of space we must allocate during this function ;; that we will not need to keep permanently. (garbage-collect) @@ -824,7 +835,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key global-map [?\C-\M--] 'negative-argument) (define-key global-map "\177" 'delete-backward-char) -(define-key global-map "\C-d" 'delete-forward-char) +(define-key global-map "\C-d" 'delete-char) (define-key global-map "\C-k" 'kill-line) (define-key global-map "\C-w" 'kill-region) @@ -933,7 +944,7 @@ if `inhibit-field-text-motion' is non-nil." ;; (define-key global-map [clearline] 'function-key-error) (define-key global-map [insertline] 'open-line) (define-key global-map [deleteline] 'kill-line) -(define-key global-map [deletechar] 'delete-char) +(define-key global-map [deletechar] 'delete-forward-char) ;; (define-key global-map [backtab] 'function-key-error) ;; (define-key global-map [f1] 'function-key-error) ;; (define-key global-map [f2] 'function-key-error) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 0eec76f4da7..268a370cdb6 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1,7 +1,8 @@ ;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later -;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Karl Fogel <kfogel@red-bean.com> ;; Maintainer: Karl Fogel <kfogel@red-bean.com> @@ -304,124 +305,112 @@ This point is in `bookmark-current-buffer'.") ;; need to know anything about the format of bookmark-alist entries. ;; Everyone else should go through them. -(defun bookmark-name-from-full-record (full-record) - "Return name of FULL-RECORD (an alist element instead of a string)." - (car full-record)) +(defun bookmark-name-from-record (bookmark-record) + "Return the name of BOOKMARK-RECORD. BOOKMARK-RECORD is, e.g., +one element from `bookmark-alist'." + (car bookmark-record)) (defun bookmark-all-names () "Return a list of all current bookmark names." (bookmark-maybe-load-default-file) - (mapcar 'bookmark-name-from-full-record bookmark-alist)) + (mapcar 'bookmark-name-from-record bookmark-alist)) -(defun bookmark-get-bookmark (bookmark &optional noerror) - "Return the bookmark record corresponding to BOOKMARK. -If BOOKMARK is a string, look for the corresponding bookmark record in -`bookmark-alist'; return it if found, otherwise error. Else if -BOOKMARK is already a bookmark record, just return it." +(defun bookmark-get-bookmark (bookmark-name-or-record &optional noerror) + "Return the bookmark record corresponding to BOOKMARK-NAME-OR-RECORD. +If BOOKMARK-NAME-OR-RECORD is a string, look for the corresponding +bookmark record in `bookmark-alist'; return it if found, otherwise +error. Else if BOOKMARK-NAME-OR-RECORD is already a bookmark record, +just return it." (cond - ((consp bookmark) bookmark) - ((stringp bookmark) - (or (assoc-string bookmark bookmark-alist bookmark-completion-ignore-case) - (unless noerror (error "Invalid bookmark %s" bookmark)))))) - - -(defun bookmark-get-bookmark-record (bookmark) - "Return the record portion of the entry for BOOKMARK in -`bookmark-alist' (that is, all information but the name). -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (let ((alist (cdr (bookmark-get-bookmark bookmark)))) + ((consp bookmark-name-or-record) bookmark-name-or-record) + ((stringp bookmark-name-or-record) + (or (assoc-string bookmark-name-or-record bookmark-alist + bookmark-completion-ignore-case) + (unless noerror (error "Invalid bookmark %s" + bookmark-name-or-record)))))) + + +(defun bookmark-get-bookmark-record (bookmark-name-or-record) + "Return the record portion of the entry for BOOKMARK-NAME-OR-RECORD in +`bookmark-alist' (that is, all information but the name)." + (let ((alist (cdr (bookmark-get-bookmark bookmark-name-or-record)))) ;; The bookmark objects can either look like (NAME ALIST) or ;; (NAME . ALIST), so we have to distinguish the two here. (if (and (null (cdr alist)) (consp (caar alist))) (car alist) alist))) -(defun bookmark-set-name (bookmark newname) - "Set BOOKMARK's name to NEWNAME. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (setcar - (if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark) - newname)) +(defun bookmark-set-name (bookmark-name-or-record newname) + "Set BOOKMARK-NAME-OR-RECORD's name to NEWNAME." + (setcar (bookmark-get-bookmark bookmark-name-or-record) newname)) -(defun bookmark-prop-get (bookmark prop) - "Return the property PROP of BOOKMARK, or nil if none. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (cdr (assq prop (bookmark-get-bookmark-record bookmark)))) +(defun bookmark-prop-get (bookmark-name-or-record prop) + "Return the property PROP of BOOKMARK-NAME-OR-RECORD, or nil if none." + (cdr (assq prop (bookmark-get-bookmark-record bookmark-name-or-record)))) -(defun bookmark-prop-set (bookmark prop val) - "Set the property PROP of BOOKMARK to VAL. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (let ((cell (assq prop (bookmark-get-bookmark-record bookmark)))) +(defun bookmark-prop-set (bookmark-name-or-record prop val) + "Set the property PROP of BOOKMARK-NAME-OR-RECORD to VAL." + (let ((cell (assq + prop (bookmark-get-bookmark-record bookmark-name-or-record)))) (if cell (setcdr cell val) - (nconc (bookmark-get-bookmark-record bookmark) + (nconc (bookmark-get-bookmark-record bookmark-name-or-record) (list (cons prop val)))))) -(defun bookmark-get-annotation (bookmark) - "Return the annotation of BOOKMARK, or nil if none. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-get bookmark 'annotation)) +(defun bookmark-get-annotation (bookmark-name-or-record) + "Return the annotation of BOOKMARK-NAME-OR-RECORD, or nil if none." + (bookmark-prop-get bookmark-name-or-record 'annotation)) -(defun bookmark-set-annotation (bookmark ann) - "Set the annotation of BOOKMARK to ANN. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-set bookmark 'annotation ann)) +(defun bookmark-set-annotation (bookmark-name-or-record ann) + "Set the annotation of BOOKMARK-NAME-OR-RECORD to ANN." + (bookmark-prop-set bookmark-name-or-record 'annotation ann)) -(defun bookmark-get-filename (bookmark) - "Return the full filename of BOOKMARK, or nil if none. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-get bookmark 'filename)) +(defun bookmark-get-filename (bookmark-name-or-record) + "Return the full filename of BOOKMARK-NAME-OR-RECORD, or nil if none." + (bookmark-prop-get bookmark-name-or-record 'filename)) -(defun bookmark-set-filename (bookmark filename) - "Set the full filename of BOOKMARK to FILENAME. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-set bookmark 'filename filename)) +(defun bookmark-set-filename (bookmark-name-or-record filename) + "Set the full filename of BOOKMARK-NAME-OR-RECORD to FILENAME." + (bookmark-prop-set bookmark-name-or-record 'filename filename)) -(defun bookmark-get-position (bookmark) - "Return the position (i.e.: point) of BOOKMARK, or nil if none. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-get bookmark 'position)) +(defun bookmark-get-position (bookmark-name-or-record) + "Return the position (i.e.: point) of BOOKMARK-NAME-OR-RECORD, or nil if none." + (bookmark-prop-get bookmark-name-or-record 'position)) -(defun bookmark-set-position (bookmark position) - "Set the position (i.e.: point) of BOOKMARK to POSITION. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-set bookmark 'position position)) +(defun bookmark-set-position (bookmark-name-or-record position) + "Set the position (i.e.: point) of BOOKMARK-NAME-OR-RECORD to POSITION." + (bookmark-prop-set bookmark-name-or-record 'position position)) -(defun bookmark-get-front-context-string (bookmark) - "Return the front-context-string of BOOKMARK, or nil if none. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-get bookmark 'front-context-string)) +(defun bookmark-get-front-context-string (bookmark-name-or-record) + "Return the front-context-string of BOOKMARK-NAME-OR-RECORD, or nil if none." + (bookmark-prop-get bookmark-name-or-record 'front-context-string)) -(defun bookmark-set-front-context-string (bookmark string) - "Set the front-context-string of BOOKMARK to STRING. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-set bookmark 'front-context-string string)) +(defun bookmark-set-front-context-string (bookmark-name-or-record string) + "Set the front-context-string of BOOKMARK-NAME-OR-RECORD to STRING." + (bookmark-prop-set bookmark-name-or-record 'front-context-string string)) -(defun bookmark-get-rear-context-string (bookmark) - "Return the rear-context-string of BOOKMARK, or nil if none. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-get bookmark 'rear-context-string)) +(defun bookmark-get-rear-context-string (bookmark-name-or-record) + "Return the rear-context-string of BOOKMARK-NAME-OR-RECORD, or nil if none." + (bookmark-prop-get bookmark-name-or-record 'rear-context-string)) -(defun bookmark-set-rear-context-string (bookmark string) - "Set the rear-context-string of BOOKMARK to STRING. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-set bookmark 'rear-context-string string)) +(defun bookmark-set-rear-context-string (bookmark-name-or-record string) + "Set the rear-context-string of BOOKMARK-NAME-OR-RECORD to STRING." + (bookmark-prop-set bookmark-name-or-record 'rear-context-string string)) -(defun bookmark-get-handler (bookmark) - "Return the handler function for BOOKMARK, or nil if none. -BOOKMARK may be a bookmark name (a string) or a bookmark record." - (bookmark-prop-get bookmark 'handler)) +(defun bookmark-get-handler (bookmark-name-or-record) + "Return the handler function for BOOKMARK-NAME-OR-RECORD, or nil if none." + (bookmark-prop-get bookmark-name-or-record 'handler)) (defvar bookmark-history nil "The history list for bookmark functions.") @@ -816,7 +805,7 @@ the list of bookmarks.)" "Kill from point to end of line. If optional arg NEWLINE-TOO is non-nil, delete the newline too. Does not affect the kill ring." - (let ((eol (save-excursion (end-of-line) (point)))) + (let ((eol (line-end-position))) (delete-region (point) eol) (if (and newline-too (looking-at "\n")) (delete-char 1)))) @@ -829,11 +818,11 @@ This is used in `bookmark-edit-annotation' to record the bookmark whose annotation is being edited.") -(defun bookmark-default-annotation-text (bookmark) - "Return default annotation text for BOOKMARK (a string, not a record). +(defun bookmark-default-annotation-text (bookmark-name) + "Return default annotation text for BOOKMARK-NAME. The default annotation text is simply some text explaining how to use annotations." - (concat "# Type the annotation for bookmark '" bookmark "' here.\n" + (concat "# Type the annotation for bookmark '" bookmark-name "' here.\n" "# All lines which start with a '#' will be deleted.\n" "# Type C-c C-c when done.\n#\n" "# Author: " (user-full-name) " <" (user-login-name) "@" @@ -855,22 +844,20 @@ It takes one argument, the name of the bookmark, as a string.") "Keymap for editing an annotation of a bookmark.") -(defun bookmark-edit-annotation-mode (bookmark) - "Mode for editing the annotation of bookmark BOOKMARK. +(defun bookmark-edit-annotation-mode (bookmark-name-or-record) + "Mode for editing the annotation of bookmark BOOKMARK-NAME-OR-RECORD. When you have finished composing, type \\[bookmark-send-annotation]. -BOOKMARK is a bookmark name (a string) or a bookmark record. - \\{bookmark-edit-annotation-mode-map}" (interactive) (kill-all-local-variables) (make-local-variable 'bookmark-annotation-name) - (setq bookmark-annotation-name bookmark) + (setq bookmark-annotation-name bookmark-name-or-record) (use-local-map bookmark-edit-annotation-mode-map) (setq major-mode 'bookmark-edit-annotation-mode mode-name "Edit Bookmark Annotation") - (insert (funcall bookmark-edit-annotation-text-func bookmark)) - (let ((annotation (bookmark-get-annotation bookmark))) + (insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record)) + (let ((annotation (bookmark-get-annotation bookmark-name-or-record))) (if (and annotation (not (string-equal annotation ""))) (insert annotation))) (run-mode-hooks 'text-mode-hook)) @@ -889,19 +876,18 @@ Lines beginning with `#' are ignored." (forward-line 1))) ;; Take no chances with text properties. (let ((annotation (buffer-substring-no-properties (point-min) (point-max))) - (bookmark bookmark-annotation-name)) - (bookmark-set-annotation bookmark annotation) + (bookmark-name bookmark-annotation-name)) + (bookmark-set-annotation bookmark-name annotation) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (bookmark-bmenu-surreptitiously-rebuild-list)) (kill-buffer (current-buffer))) -(defun bookmark-edit-annotation (bookmark) - "Pop up a buffer for editing bookmark BOOKMARK's annotation. -BOOKMARK is a bookmark name (a string) or a bookmark record." +(defun bookmark-edit-annotation (bookmark-name-or-record) + "Pop up a buffer for editing bookmark BOOKMARK-NAME-OR-RECORD's annotation." (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) - (bookmark-edit-annotation-mode bookmark)) + (bookmark-edit-annotation-mode bookmark-name-or-record)) (defun bookmark-insert-current-bookmark () @@ -1001,14 +987,14 @@ If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist." "Hook run after `bookmark-jump' jumps to a bookmark. Useful for example to unhide text in `outline-mode'.") -(defun bookmark--jump-via (bookmark display-function) - "Handle BOOKMARK, then call DISPLAY-FUNCTION with current buffer as argument. -Bookmark may be a bookmark name (a string) or a bookmark record. +(defun bookmark--jump-via (bookmark-name-or-record display-function) + "Handle BOOKMARK-NAME-OR-RECORD, then call DISPLAY-FUNCTION with +current buffer as argument. After calling DISPLAY-FUNCTION, set window point to the point specified -by BOOKMARK, if necessary, run `bookmark-after-jump-hook', and then show -any annotations for this bookmark." - (bookmark-handle-bookmark bookmark) +by BOOKMARK-NAME-OR-RECORD, if necessary, run `bookmark-after-jump-hook', +and then show any annotations for this bookmark." + (bookmark-handle-bookmark bookmark-name-or-record) (save-current-buffer (funcall display-function (current-buffer))) (let ((win (get-buffer-window (current-buffer) 0))) @@ -1019,7 +1005,7 @@ any annotations for this bookmark." (if bookmark-automatically-show-annotations ;; if there is an annotation for this bookmark, ;; show it in a buffer. - (bookmark-show-annotation bookmark))) + (bookmark-show-annotation bookmark-name-or-record))) ;;;###autoload @@ -1035,8 +1021,8 @@ if you wish to give the bookmark a new location, and `bookmark-jump' will then jump to the new location, as well as recording it in place of the old one in the permanent bookmark record. -BOOKMARK may be a bookmark name (a string) or a bookmark record, but -the latter is usually only used by programmatic callers. +BOOKMARK is usually a bookmark name (a string). It can also be a +bookmark record, but this is usually only done by programmatic callers. If DISPLAY-FUNC is non-nil, it is a function to invoke to display the bookmark. It defaults to `switch-to-buffer'. A typical value for @@ -1060,11 +1046,9 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'." (defun bookmark-jump-noselect (bookmark) - "Return the location pointed to by the bookmark BOOKMARK. + "Return the location pointed to by BOOKMARK (see `bookmark-jump'). The return value has the form (BUFFER . POINT). -BOOKMARK may be a bookmark name (a string) or a bookmark record. - Note: this function is deprecated and is present for Emacs 22 compatibility only." (save-excursion @@ -1073,26 +1057,27 @@ compatibility only." (make-obsolete 'bookmark-jump-noselect 'bookmark-handle-bookmark "23.1") -(defun bookmark-handle-bookmark (bookmark) - "Call BOOKMARK's handler or `bookmark-default-handler' if it has none. -BOOKMARK may be a bookmark name (a string) or a bookmark record. - -Changes current buffer and point and returns nil, or signals a `file-error'. +(defun bookmark-handle-bookmark (bookmark-name-or-record) + "Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler' +if it has none. This changes current buffer and point and returns nil, +or signals a `file-error'. -If BOOKMARK has no file, this is a no-op. If BOOKMARK has a file, but -that file no longer exists, then offer interactively to relocate BOOKMARK." +If BOOKMARK-NAME-OR-RECORD has no file, this is a no-op. If +BOOKMARK-NAME-OR-RECORD has a file, but that file no longer exists, +then offer interactively to relocate BOOKMARK-NAME-OR-RECORD." (condition-case err - (funcall (or (bookmark-get-handler bookmark) + (funcall (or (bookmark-get-handler bookmark-name-or-record) 'bookmark-default-handler) - (bookmark-get-bookmark bookmark)) + (bookmark-get-bookmark bookmark-name-or-record)) (bookmark-error-no-filename ;file-error ;; We were unable to find the marked file, so ask if user wants to ;; relocate the bookmark, else remind them to consider deletion. - (when (stringp bookmark) - ;; `bookmark' can be either a bookmark name (from `bookmark-alist') - ;; or a bookmark object. If it's an object, we assume it's a - ;; bookmark used internally by some other package. - (let ((file (bookmark-get-filename bookmark))) + (when (stringp bookmark-name-or-record) + ;; `bookmark-name-or-record' can be either a bookmark name + ;; (from `bookmark-alist') or a bookmark object. If it's an + ;; object, we assume it's a bookmark used internally by some + ;; other package. + (let ((file (bookmark-get-filename bookmark-name-or-record))) (when file ;Don't know how to relocate if there's no `file'. ;; If file is not a dir, directory-file-name just returns file. (let ((display-name (directory-file-name file))) @@ -1105,20 +1090,20 @@ that file no longer exists, then offer interactively to relocate BOOKMARK." (let ((use-dialog-box nil) (use-file-dialog nil)) (if (y-or-n-p (concat display-name " nonexistent. Relocate \"" - bookmark "\"? ")) + bookmark-name-or-record "\"? ")) (progn - (bookmark-relocate bookmark) + (bookmark-relocate bookmark-name-or-record) ;; Try again. - (funcall (or (bookmark-get-handler bookmark) + (funcall (or (bookmark-get-handler bookmark-name-or-record) 'bookmark-default-handler) - (bookmark-get-bookmark bookmark))) + (bookmark-get-bookmark bookmark-name-or-record))) (message "Bookmark not relocated; consider removing it (%s)." - bookmark) + bookmark-name-or-record) (signal (car err) (cdr err)))))))))) ;; Added by db. - (when (stringp bookmark) - (setq bookmark-current-bookmark bookmark)) + (when (stringp bookmark-name-or-record) + (setq bookmark-current-bookmark bookmark-name-or-record)) nil) (put 'bookmark-error-no-filename @@ -1158,23 +1143,22 @@ Changes current buffer and point and returns nil, or signals a `file-error'." nil)) ;;;###autoload -(defun bookmark-relocate (bookmark) - "Relocate BOOKMARK to another file (reading file name with minibuffer). -BOOKMARK is a bookmark name (a string), not a bookmark record. +(defun bookmark-relocate (bookmark-name) + "Relocate BOOKMARK-NAME to another file, reading file name with minibuffer. This makes an already existing bookmark point to that file, instead of the one it used to point at. Useful when a file has been renamed after a bookmark was set in it." (interactive (list (bookmark-completing-read "Bookmark to relocate"))) - (bookmark-maybe-historicize-string bookmark) + (bookmark-maybe-historicize-string bookmark-name) (bookmark-maybe-load-default-file) - (let* ((bmrk-filename (bookmark-get-filename bookmark)) + (let* ((bmrk-filename (bookmark-get-filename bookmark-name)) (newloc (abbreviate-file-name (expand-file-name (read-file-name - (format "Relocate %s to: " bookmark) + (format "Relocate %s to: " bookmark-name) (file-name-directory bmrk-filename)))))) - (bookmark-set-filename bookmark newloc) + (bookmark-set-filename bookmark-name newloc) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (if (bookmark-time-to-save-p) @@ -1183,17 +1167,16 @@ after a bookmark was set in it." ;;;###autoload -(defun bookmark-insert-location (bookmark &optional no-history) - "Insert the name of the file associated with BOOKMARK. -BOOKMARK is a bookmark name (a string), not a bookmark record. +(defun bookmark-insert-location (bookmark-name &optional no-history) + "Insert the name of the file associated with BOOKMARK-NAME. Optional second arg NO-HISTORY means don't record this in the minibuffer history list `bookmark-history'." (interactive (list (bookmark-completing-read "Insert bookmark location"))) - (or no-history (bookmark-maybe-historicize-string bookmark)) + (or no-history (bookmark-maybe-historicize-string bookmark-name)) (let ((start (point))) (prog1 - (insert (bookmark-location bookmark)) + (insert (bookmark-location bookmark-name)) (if (display-mouse-p) (add-text-properties start @@ -1207,42 +1190,39 @@ minibuffer history list `bookmark-history'." ;;;###autoload (defalias 'bookmark-locate 'bookmark-insert-location) -(defun bookmark-location (bookmark) - "Return a description of the location of BOOKMARK. -BOOKMARK may be a bookmark name (a string) or a bookmark record." +(defun bookmark-location (bookmark-name-or-record) + "Return a description of the location of BOOKMARK-NAME-OR-RECORD." (bookmark-maybe-load-default-file) ;; We could call the `handler' and ask for it to construct a description ;; dynamically: it would open up several new possibilities, but it ;; would have the major disadvantage of forcing to load each and ;; every handler when the user calls bookmark-menu. - (or (bookmark-prop-get bookmark 'location) - (bookmark-get-filename bookmark) + (or (bookmark-prop-get bookmark-name-or-record 'location) + (bookmark-get-filename bookmark-name-or-record) "-- Unknown location --")) ;;;###autoload -(defun bookmark-rename (old &optional new) - "Change the name of OLD bookmark to NEW name. -If called from keyboard, prompt for OLD and NEW. If called from -menubar, select OLD from a menu and prompt for NEW. - -Both OLD and NEW are bookmark names (strings), never bookmark records. +(defun bookmark-rename (old-name &optional new-name) + "Change the name of OLD-NAME bookmark to NEW-NAME name. +If called from keyboard, prompt for OLD-NAME and NEW-NAME. +If called from menubar, select OLD-NAME from a menu and prompt for NEW-NAME. -If called from Lisp, prompt for NEW if only OLD was passed as an -argument. If called with two strings, then no prompting is done. You -must pass at least OLD when calling from Lisp. +If called from Lisp, prompt for NEW-NAME if only OLD-NAME was passed +as an argument. If called with two strings, then no prompting is done. +You must pass at least OLD-NAME when calling from Lisp. While you are entering the new name, consecutive C-w's insert consecutive words from the text of the buffer into the new bookmark name." (interactive (list (bookmark-completing-read "Old bookmark name"))) - (bookmark-maybe-historicize-string old) + (bookmark-maybe-historicize-string old-name) (bookmark-maybe-load-default-file) (setq bookmark-yank-point (point)) (setq bookmark-current-buffer (current-buffer)) - (let ((newname - (or new ; use second arg, if non-nil + (let ((final-new-name + (or new-name ; use second arg, if non-nil (read-from-minibuffer "New name: " nil @@ -1251,8 +1231,8 @@ name." now-map) nil 'bookmark-history)))) - (bookmark-set-name old newname) - (setq bookmark-current-bookmark newname) + (bookmark-set-name old-name final-new-name) + (setq bookmark-current-bookmark final-new-name) (bookmark-bmenu-surreptitiously-rebuild-list) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) @@ -1261,21 +1241,21 @@ name." ;;;###autoload -(defun bookmark-insert (bookmark) - "Insert the text of the file pointed to by bookmark BOOKMARK. -BOOKMARK is a bookmark name (a string), not a bookmark record. +(defun bookmark-insert (bookmark-name) + "Insert the text of the file pointed to by bookmark BOOKMARK-NAME. +BOOKMARK-NAME is a bookmark name (a string), not a bookmark record. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this." (interactive (list (bookmark-completing-read "Insert bookmark contents"))) - (bookmark-maybe-historicize-string bookmark) + (bookmark-maybe-historicize-string bookmark-name) (bookmark-maybe-load-default-file) (let ((orig-point (point)) (str-to-insert (save-current-buffer - (bookmark-handle-bookmark bookmark) + (bookmark-handle-bookmark bookmark-name) (buffer-string)))) (insert str-to-insert) (push-mark) @@ -1283,9 +1263,8 @@ this." ;;;###autoload -(defun bookmark-delete (bookmark &optional batch) - "Delete BOOKMARK from the bookmark list. -BOOKMARK is a bookmark name (a string), not a bookmark record. +(defun bookmark-delete (bookmark-name &optional batch) + "Delete BOOKMARK-NAME from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will @@ -1296,9 +1275,9 @@ probably because we were called from there." (interactive (list (bookmark-completing-read "Delete bookmark" bookmark-current-bookmark))) - (bookmark-maybe-historicize-string bookmark) + (bookmark-maybe-historicize-string bookmark-name) (bookmark-maybe-load-default-file) - (let ((will-go (bookmark-get-bookmark bookmark 'noerror))) + (let ((will-go (bookmark-get-bookmark bookmark-name 'noerror))) (setq bookmark-alist (delq will-go bookmark-alist)) ;; Added by db, nil bookmark-current-bookmark if the last ;; occurrence has been deleted @@ -1412,13 +1391,13 @@ they conflict with existing bookmark names." (dolist (full-record new-list) (bookmark-maybe-rename full-record names) (setq bookmark-alist (nconc bookmark-alist (list full-record))) - (push (bookmark-name-from-full-record full-record) names)))) + (push (bookmark-name-from-record full-record) names)))) (defun bookmark-maybe-rename (full-record names) "Rename bookmark FULL-RECORD if its current name is already used. This is a helper for `bookmark-import-new-list'." - (let ((found-name (bookmark-name-from-full-record full-record))) + (let ((found-name (bookmark-name-from-record full-record))) (if (member found-name names) ;; We've got a conflict, so generate a new name (let ((count 2) @@ -1576,7 +1555,7 @@ deletion, or > if it is flagged for displaying." (add-text-properties (point-min) (point) '(font-lock-face bookmark-menu-heading)) (dolist (full-record (bookmark-maybe-sort-alist)) - (let ((name (bookmark-name-from-full-record full-record)) + (let ((name (bookmark-name-from-record full-record)) (annotation (bookmark-get-annotation full-record)) (start (point)) end) @@ -1684,7 +1663,7 @@ mainly for debugging, and should not be necessary in normal use." (while (< (point) (point-max)) (let ((bmrk (bookmark-bmenu-bookmark))) (push bmrk bookmark-bmenu-hidden-bookmarks) - (let ((start (save-excursion (end-of-line) (point)))) + (let ((start (line-end-position))) (move-to-column bookmark-bmenu-file-column t) ;; Strip off `mouse-face' from the white spaces region. (if (display-mouse-p) @@ -1746,16 +1725,15 @@ last full line, move to the last full line. The return value is undefined." (get-text-property (point) 'bookmark-name-prop))) -(defun bookmark-show-annotation (bookmark) - "Display the annotation for bookmark named BOOKMARK in a buffer, +(defun bookmark-show-annotation (bookmark-name-or-record) + "Display the annotation for BOOKMARK-NAME-OR-RECORD in a buffer, if an annotation exists." - (let ((annotation (bookmark-get-annotation bookmark))) + (let ((annotation (bookmark-get-annotation bookmark-name-or-record))) (when (and annotation (not (string-equal annotation ""))) (save-excursion (let ((old-buf (current-buffer))) (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) (delete-region (point-min) (point-max)) - ;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n")) (insert annotation) (goto-char (point-min)) (switch-to-buffer-other-window old-buf)))))) @@ -1767,7 +1745,7 @@ if an annotation exists." (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) (delete-region (point-min) (point-max)) (dolist (full-record bookmark-alist) - (let* ((name (bookmark-name-from-full-record full-record)) + (let* ((name (bookmark-name-from-record full-record)) (ann (bookmark-get-annotation full-record))) (insert (concat name ":\n")) (if (and ann (not (string-equal ann ""))) @@ -2225,5 +2203,4 @@ This also runs `bookmark-exit-hook'." (provide 'bookmark) -;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6 ;;; bookmark.el ends here diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e0f00d3553d..21fdada22c2 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -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 @@ negative ARG, display other buffers as well." (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 @@ For more information, see the function `buffer-menu'." (set-buffer-modified-p nil) (current-buffer)))) -;; arch-tag: e7dfcfc9-6cb2-46e4-bf55-8ef1936d83c6 ;;; buff-menu.el ends here diff --git a/lisp/calc/README b/lisp/calc/README index cf3a697c5d7..b23666018e5 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -74,6 +74,9 @@ Summary of changes to "Calc" Emacs 24.1 +* Calc no longer uses the tex prefix for TeX specific unit +names when using TeX or LaTeX mode. + * Added option to highlight selections using faces. * Gave `calc-histogram' the option of using a vector to determine the bins. diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index e4dc5f5a88b..f0a37ad3b74 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -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 diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index f461c47aafd..6c0a65f5567 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -540,6 +540,16 @@ ( \\Psi . var-Psi ) ( \\omega . var-omega ) ( \\Omega . var-Omega ) + ;; Units + ( pt . var-texpt ) + ( pc . var-texpc ) + ( bp . var-texbp ) + ( dd . var-texdd ) + ( cc . var-texcc ) + ( sp . var-texsp ) + ( pint . var-pt ) + ( parsec . var-pc) + ;; Others ( \\ell . var-ell ) ( \\infty . var-inf ) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index a88e87dffbc..8fd1983ac6d 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -57,23 +57,23 @@ "149597870691 m (*)") ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html) ( lyr "c yr" "Light Year" ) - ( pc "3.0856775854*10^16 m" "Parsec" nil + ( pc "3.0856775854*10^16 m" "Parsec (**)" nil "3.0856775854 10^16 m (*)") ;; (approx) ESUWM ( nmi "1852 m" "Nautical Mile" ) ( fath "6 ft" "Fathom" ) ( fur "660 ft" "Furlong") ( mu "1 um" "Micron" ) ( mil "(1/1000) in" "Mil" ) - ( point "(1/72) in" "Point (1/72 inch)" ) + ( point "(1/72) in" "Point (PostScript convention)" ) ( Ang "10^(-10) m" "Angstrom" ) ( mfi "mi+ft+in" "Miles + feet + inches" ) ;; TeX lengths - ( texpt "(100/7227) in" "Point (TeX conventions)" ) - ( texpc "12 texpt" "Pica" ) - ( texbp "point" "Big point (TeX conventions)" ) - ( texdd "(1238/1157) texpt" "Didot point" ) - ( texcc "12 texdd" "Cicero" ) - ( texsp "(1/65536) texpt" "Scaled TeX point" ) + ( texpt "(100/7227) in" "Point (TeX convention) (**)" ) + ( texpc "12 texpt" "Pica (TeX convention) (**)" ) + ( texbp "point" "Big point (TeX convention) (**)" ) + ( texdd "(1238/1157) texpt" "Didot point (TeX convention) (**)" ) + ( texcc "12 texdd" "Cicero (TeX convention) (**)" ) + ( texsp "(1/65536) texpt" "Scaled TeX point (TeX convention) (**)" ) ;; Area ( hect "10000 m^2" "*Hectare" ) @@ -86,7 +86,7 @@ ( l "L" "Liter" ) ( gal "4 qt" "US Gallon" ) ( qt "2 pt" "Quart" ) - ( pt "2 cup" "Pint" ) + ( pt "2 cup" "Pint (**)" ) ( cup "8 ozfl" "Cup" ) ( ozfl "2 tbsp" "Fluid Ounce" ) ( floz "2 tbsp" "Fluid Ounce" ) @@ -1531,7 +1531,12 @@ If EXPR is nil, return nil." (indent-to 15) (insert " " (nth 2 u) "\n") (while (eq (car (car (setq uptr (cdr uptr)))) 0))) - (insert "\n")) + (insert "\n\n") + (insert "(**) When in TeX or LaTeX display mode, the TeX specific unit\n" + "names will not use the `tex' prefix; the unit name for a\n" + "TeX point will be `pt' instead of `texpt', for example.\n" + "To avoid conflicts, the unit names for pint and parsec will\n" + "be `pint' and `parsec' instead of `pt' and `pc'.")) (view-mode) (message "Formatting units table...done")) (setq math-units-table-buffer-valid t) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 63b3cb03322..0588f31de15 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -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 @@ With prefix arg, also delete the region." (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 @@ To cancel the edit, simply kill the *Calc Edit* buffer." ;; generated-autoload-file: "calc-loaddefs.el" ;; End: -;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5 ;;; calc-yank.el ends here diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 418f740bb83..24ebb19a58b 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -736,14 +736,16 @@ calendar package is already loaded). Rather, use either (defcustom diary-iso-date-forms '((month "[-/]" day "[^-/0-9]") (year "[-/]" month "[-/]" day "[^0-9]") - (monthname "-" day "[^-0-9]") - (year "-" monthname "-" day "[^0-9]") + ;; Cannot allow [-/] as separators here, since it would also match + ;; the first element (bug#7377). + (monthname " *" day "[^-0-9]") + (year " *" monthname " *" day "[^0-9]") (dayname "\\W")) "List of pseudo-patterns describing the ISO style of dates. -The defaults are: MONTH[-/]DAY; YEAR[-/]MONTH[-/]DAY; MONTHNAME-DAY; -YEAR-MONTHNAME-DAY; DAYNAME. Normally you should not customize this, +The defaults are: MONTH[-/]DAY; YEAR[-/]MONTH[-/]DAY; MONTHNAME DAY; +YEAR MONTHNAME DAY; DAYNAME. Normally you should not customize this, but `diary-date-forms' (which see)." - :version "23.1" + :version "23.3" ; bug#7377 :type '(repeat (choice (cons :tag "Backup" :value (backup . nil) (const backup) @@ -2570,5 +2572,4 @@ If called by a mouse-event, pops up a menu with the result." ;; byte-compile-dynamic: t ;; End: -;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8 ;;; calendar.el ends here diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 4c485a7c47b..231c92f417d 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1,7 +1,8 @@ ;;; diary-lib.el --- diary functions ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 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: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> @@ -304,28 +305,48 @@ If this variable is nil, years must be written in full." :type 'boolean :group 'diary) +(defun diary-outlook-format-1 (body) + "Return a replace-match template for an element of `diary-outlook-formats'. +Returns a string using match elements 1-5, where: +1 = month name, 2 = day, 3 = year, 4 = time, 5 = location; also uses +%s = message subject. BODY is the string from which the matches derive." + (let* ((monthname (match-string 1 body)) + (day (match-string 2 body)) + (year (match-string 3 body)) + ;; Blech. + (month (catch 'found + (dotimes (i (length calendar-month-name-array)) + (if (string-equal (aref calendar-month-name-array i) + monthname) + (throw 'found (1+ i)))) + nil))) + ;; If we could convert the monthname to a numeric month, we can + ;; use the standard function calendar-date-string. + (concat (if month + (calendar-date-string (list month (string-to-number day) + (string-to-number year))) + (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD + ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY + (t "\\1 \\2 \\3"))) ; MDY + "\n \\4 %s, \\5"))) +;; TODO Sometimes the time is in a different time-zone to the one you +;; are in. Eg in PST, you might still get an email referring to: +;; "7:00 PM-8:00 PM. Greenwich Standard Time". +;; Note that it doesn't use a standard abbreviation for the timezone, +;; or anything helpful like that. +;; Sigh, this could cause the meeting to even be on a different day +;; to that given in the When: string. +;; These things seem to come in a multipart mail with a calendar part, +;; it's probably better to use that rather than this whole thing. +;; So this is unlikely to get improved. + +;; TODO Is the format of these messages actually documented anywhere? (defcustom diary-outlook-formats - '( - ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ... - ;; [Current UK format? The timezone is meaningless. Sometimes the - ;; Where is missing.] - ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\n+\\)? -\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*" - . "\\1\n \\2 %s, \\3") - ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ... - ;; [Old UK format?] - ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\\)?\n+" - . "\\2 \\1 \\3\n \\4 %s, \\5") - ( - ;; German format, apparently. - "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$" - . "\\1 \\2 \\3\n \\4 %s")) + '(;; When: Tuesday, November 9, 2010 7:00 PM-8:00 PM. Greenwich Standard Time + ;; Where: Meeting room B + ("[ \t\n]*When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \ +\\([0-9]\\{4\\}\\),? \\(.+\\)\n\ +\\(?:Where: \\(.+\n\\)\\)?" . diary-outlook-format-1)) "Alist of regexps matching message text and replacement text. The regexp must match the start of the message text containing an @@ -835,7 +856,7 @@ LIST-ONLY is non-nil, in which case it just returns the list." (kill-local-variable 'mode-line-format)) (defvar original-date) ; bound in diary-list-entries -(defvar number) +;(defvar number) ; already declared above (defun diary-include-other-diary-files () "Include the diary entries from other diary files with those of `diary-file'. @@ -2331,6 +2352,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." ;;; Fancy Diary Mode. +;; FIXME does not update upon changes to the name-arrays. (defvar diary-fancy-date-pattern (concat (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) @@ -2412,37 +2434,27 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." ;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail', ;; could be run from hooks to notice appointments automatically (in ;; which case they will prompt about adding to the diary). The -;; message formats recognized are customizable through -;; `diary-outlook-formats'. - -(defvar subject) ; bound in diary-from-outlook-gnus -(defvar body) +;; message formats recognized are customizable through `diary-outlook-formats'. -(defun diary-from-outlook-internal (&optional test-only) +(defun diary-from-outlook-internal (subject body &optional test-only) "Snarf a diary entry from a message assumed to be from MS Outlook. -Assumes `body' is bound to a string comprising the body of the message and -`subject' is bound to a string comprising its subject. +SUBJECT and BODY are strings giving the message subject and body. Arg TEST-ONLY non-nil means return non-nil if and only if the message contains an appointment, don't make a diary entry." (catch 'finished (let (format-string) - (dotimes (i (length diary-outlook-formats)) - (when (eq 0 (string-match (car (nth i diary-outlook-formats)) - body)) + (dolist (fmt diary-outlook-formats) + (when (eq 0 (string-match (car fmt) body)) (unless test-only - (setq format-string (cdr (nth i diary-outlook-formats))) + (setq format-string (cdr fmt)) (save-excursion (save-window-excursion - ;; Fixme: References to optional fields in the format - ;; are treated literally, not replaced by the empty - ;; string. I think this is an Emacs bug. (diary-make-entry (format (replace-match (if (functionp format-string) (funcall format-string body) format-string) t nil (match-string 0 body)) - subject)) - (save-buffer)))) + subject))))) (throw 'finished t)))) nil)) @@ -2470,9 +2482,9 @@ automatically." (save-restriction (gnus-narrow-to-body) (buffer-string))))) - (when (diary-from-outlook-internal t) + (when (diary-from-outlook-internal subject body t) (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) + (diary-from-outlook-internal subject body) (message "Diary entry added")))))) (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) @@ -2485,15 +2497,17 @@ Unless the optional argument NOCONFIRM is non-nil (which is the case when this function is called interactively), then if an entry is found the user is asked to confirm its addition." (interactive "p") + ;; FIXME maybe the body needs rmail-mm decoding, in which case + ;; there is no single buffer with both body and subject, sigh. (with-current-buffer rmail-buffer (let ((subject (mail-fetch-field "subject")) (body (buffer-substring (save-excursion (rfc822-goto-eoh) (point)) (point-max)))) - (when (diary-from-outlook-internal t) + (when (diary-from-outlook-internal subject body t) (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) + (diary-from-outlook-internal subject body) (message "Diary entry added")))))) (defun diary-from-outlook (&optional noconfirm) @@ -2513,5 +2527,4 @@ user is asked to confirm its addition." (provide 'diary-lib) -;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010 ;;; diary-lib.el ends here diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index af61fdf149e..275c8a5ca29 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -1,7 +1,8 @@ ;;; holidays.el --- holiday functions for the calendar package ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1997, 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: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> @@ -43,6 +44,9 @@ ;; explicitly load this file. ;;;###autoload +(define-obsolete-variable-alias 'general-holidays + 'holiday-general-holidays "23.1") +;;;###autoload (defcustom holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") @@ -68,11 +72,11 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-general-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'general-holidays - 'holiday-general-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'oriental-holidays + 'holiday-oriental-holidays "23.1") +;;;###autoload (defcustom holiday-oriental-holidays (mapcar 'purecopy '((holiday-chinese-new-year) @@ -93,11 +97,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-oriental-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'oriental-holidays - 'holiday-oriental-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") +;;;###autoload (defcustom holiday-local-holidays nil "Local holidays. See the documentation for `calendar-holidays' for details." @@ -105,10 +108,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-local-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") +;;;###autoload (defcustom holiday-other-holidays nil "User defined holidays. See the documentation for `calendar-holidays' for details." @@ -116,8 +119,6 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-other-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") ;;;###autoload (defvar hebrew-holidays-1 @@ -219,6 +220,9 @@ See the documentation for `calendar-holidays' for details." (make-obsolete-variable 'hebrew-holidays-4 'hebrew-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'hebrew-holidays + 'holiday-hebrew-holidays "23.1") +;;;###autoload (defcustom holiday-hebrew-holidays (mapcar 'purecopy '((holiday-hebrew-passover) @@ -235,11 +239,11 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-hebrew-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'hebrew-holidays - 'holiday-hebrew-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'christian-holidays + 'holiday-christian-holidays "23.1") +;;;###autoload (defcustom holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag @@ -257,11 +261,11 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-christian-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'christian-holidays - 'holiday-christian-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'islamic-holidays + 'holiday-islamic-holidays "23.1") +;;;###autoload (defcustom holiday-islamic-holidays (mapcar 'purecopy '((holiday-islamic-new-year) @@ -281,11 +285,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-islamic-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'islamic-holidays - 'holiday-islamic-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") +;;;###autoload (defcustom holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) @@ -305,10 +308,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-bahai-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") +;;;###autoload (defcustom holiday-solar-holidays (mapcar 'purecopy '((solar-equinoxes-solstices) @@ -328,8 +331,6 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-solar-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") ;; This one should not be autoloaded, else .emacs changes of ;; holiday-general-holidays etc have no effect. @@ -919,5 +920,4 @@ is non-nil)." (provide 'holidays) -;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 ;;; holidays.el ends here diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 84fc465f984..1bd04d7ed3b 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -112,27 +112,24 @@ If DATE lacks timezone information, GMT is assumed." ;; 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 @@ If DATE lacks timezone information, GMT is assumed." ;;;###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 @@ The Gregorian date Sunday, December 31, 1bce is imaginary." (- (/ (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) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 32e0bf61380..d28b0a56c3f 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -543,11 +543,8 @@ non-nil, the amount returned will be relative to past time worked." (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 @@ HTML-P is non-nil, HTML markup is added." (if (file-readable-p timeclock-file) (timeclock-reread-log)) -;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40 ;;; timeclock.el ends here diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index bc024355b96..efe7e4d4255 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,52 @@ +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. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * semantic/bovine/c.el (semantic-analyze-split-name): Move before use. + + * semantic/symref/cscope.el (ede-toplevel): + * semantic/symref.el (ede-toplevel): + * semantic/tag-file.el (ede-toplevel): + * ede.el (ede-toplevel): Fix declarations. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * ede/proj-elisp.el (project-compile-target): Fix previous change. + * semantic/ede-grammar.el (project-compile-target): Fix previous change. + +2010-10-31 Julien Danjou <julien@danjou.info> + + * ede/proj-elisp.el (project-compile-target): + * semantic/ede-grammar.el (project-compile-target): + Use `byte-recompile-file'. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * mode-local.el (mode-local-augment-function-help): + * semantic/analyze/debug.el (semantic-analyzer-debug-add-buttons): + * semantic/symref/list.el (semantic-symref-results-dump) + (semantic-symref-rb-toggle-expand-tag): Replace inappropriate uses + of toggle-read-only. + 2010-09-30 Chong Yidong <cyd@stupidchicken.com> * semantic/bovine/el.el: diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index fbe66d12202..849cc05019e 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1,7 +1,7 @@ ;;; ede.el --- Emacs Development Environment gloss -;; 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 @@ -56,7 +56,7 @@ (declare-function ede-directory-project-p "ede/files") (declare-function ede-find-subproject-for-directory "ede/files") (declare-function ede-project-directory-remove-hash "ede/files") -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") (declare-function ede-toplevel-project "ede/files") (declare-function ede-up-directory "ede/files") (declare-function semantic-lex-make-spp-table "semantic/lex-spp") @@ -1278,5 +1278,4 @@ is the project to use, instead of `ede-current-project'." (ede-speedbar-file-setup) (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup)) -;; arch-tag: 0e1e0eba-484f-4119-abdb-30951f725705 ;;; ede.el ends here diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index df976bf17af..7f96699a07e 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -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 @@ INDEX starts at 1." (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 @@ to Makefiles, or other files using Autoconf substitution." (provide 'ede/autoconf-edit) -;; arch-tag: 5932c433-4fd4-4d5e-ab35-8effd95a405f ;;; ede/autoconf-edit.el ends here diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index 94874d031b7..b8e7c5f61a6 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -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 @@ Argument THIS is the target that should insert stuff." (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 @@ Argument TARGETS are the targets we should depend on for TAGS." (provide 'ede/pmake) -;; arch-tag: 7ad8e19f-cdee-484c-8caf-f15cb0fc4df2 ;;; ede/pmake.el ends here diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 879f36ff4e2..744f345fcf8 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -1,7 +1,7 @@ ;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support -;; 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 @@ -129,18 +129,13 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)." (utd 0)) (mapc (lambda (src) (let* ((fsrc (expand-file-name src dir)) - (elc (concat (file-name-sans-extension fsrc) ".elc")) - ) - (if (or (not (file-exists-p elc)) - (file-newer-than-file-p fsrc elc)) - (progn - (setq comp (1+ comp)) - (byte-compile-file fsrc)) + (elc (concat (file-name-sans-extension fsrc) ".elc"))) + (if (eq (byte-recompile-file fsrc nil 0) t) + (setq comp (1+ comp)) (setq utd (1+ utd))))) (oref obj source)) (message "All Emacs Lisp sources are up to date in %s" (object-name obj)) - (cons comp utd) - )) + (cons comp utd))) (defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version) "In a Lisp file, updated a version string for THIS to VERSION. @@ -250,10 +245,7 @@ is found, such as a `-version' variable, or the standard header." (let ((path (match-string 1))) (if (string= path "nil") nil - (delete-region (save-excursion (beginning-of-line) (point)) - (save-excursion (end-of-line) - (forward-char 1) - (point)))))))))) + (delete-region (point-at-bol) (point-at-bol 2))))))))) ;;; ;; Autoload generators @@ -390,5 +382,4 @@ Argument THIS is the target which needs to insert an info file." (provide 'ede/proj-elisp) -;; arch-tag: 3802c94b-d04d-4ecf-9bab-b29ed6e77588 ;;; ede/proj-elisp.el ends here diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index 466705175ed..8658a654b16 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -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 @@ Argument DIR is the directory from which to derive the list of objects." (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 @@ INDENT is the current indentation level." ;; generated-autoload-load-name: "ede/speedbar" ;; End: -;; arch-tag: 56721fc9-8eb5-4115-8511-18cf8397ec87 ;;; ede/speedbar.el ends here diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 8d5772f0840..7943f61fee3 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -1,6 +1,7 @@ ;;; mode-local.el --- Support for mode local facilities ;; -;; Copyright (C) 2004, 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; ;; Author: David Ponce <david@dponce.com> ;; Maintainer: David Ponce <david@dponce.com> @@ -610,19 +611,16 @@ PROMPT, INITIAL, HIST, and DEFAULT are the same as for `completing-read'." SYMBOL is a function that can be overridden." (with-current-buffer "*Help*" (pop-to-buffer (current-buffer)) - (unwind-protect - (progn - (toggle-read-only -1) - (goto-char (point-min)) - (unless (re-search-forward "^$" nil t) - (goto-char (point-max)) - (beginning-of-line) - (forward-line -1)) - (insert (overload-docstring-extension symbol) "\n") - ;; NOTE TO SELF: - ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE - ) - (toggle-read-only 1)))) + (goto-char (point-min)) + (unless (re-search-forward "^$" nil t) + (goto-char (point-max)) + (beginning-of-line) + (forward-line -1)) + (let ((inhibit-read-only t)) + (insert (overload-docstring-extension symbol) "\n") + ;; NOTE TO SELF: + ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE + ))) ;; Help for mode-local bindings. (defun mode-local-print-binding (symbol) @@ -782,5 +780,4 @@ invoked interactively." (provide 'mode-local) -;; arch-tag: 14b77823-f93c-4b3d-9116-495f69a6ec07 ;;; mode-local.el ends here diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el index 490b57bf83a..cfc41e6faf1 100644 --- a/lisp/cedet/semantic/analyze/debug.el +++ b/lisp/cedet/semantic/analyze/debug.el @@ -586,34 +586,28 @@ Look for key expressions, and add push-buttons near them." (set-marker orig-buffer (point) (current-buffer)) ;; Get a buffer ready. (with-current-buffer "*Help*" - (toggle-read-only -1) - (goto-char (point-min)) - (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer) - ;; First, add do-in buttons to recommendations. - (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t) - (let ((fcn (match-string 1))) - (when (not (fboundp (intern-soft fcn))) - (error "Help Err: Can't find %s" fcn)) - (end-of-line) - (insert " ") - (insert-button "[ Do It ]" - 'mouse-face 'custom-button-pressed-face - 'do-fcn fcn - 'action `(lambda (arg) - (let ((M semantic-analyzer-debug-orig)) - (set-buffer (marker-buffer M)) - (goto-char M)) - (call-interactively (quote ,(intern-soft fcn)))) - ) - )) + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer) + ;; First, add do-in buttons to recommendations. + (while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t) + (let ((fcn (match-string 1))) + (when (not (fboundp (intern-soft fcn))) + (error "Help Err: Can't find %s" fcn)) + (end-of-line) + (insert " ") + (insert-button "[ Do It ]" + 'mouse-face 'custom-button-pressed-face + 'do-fcn fcn + 'action `(lambda (arg) + (let ((M semantic-analyzer-debug-orig)) + (set-buffer (marker-buffer M)) + (goto-char M)) + (call-interactively (quote ,(intern-soft fcn)))))))) ;; Do something else? - ;; Clean up the mess - (toggle-read-only 1) - (set-buffer-modified-p nil) - ))) + (set-buffer-modified-p nil)))) (provide 'semantic/analyze/debug) -;; arch-tag: 943db1e5-47e6-4bec-9989-78ebfadf0358 ;;; semantic/analyze/debug.el ends here diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 03d370401af..1b441a27d2b 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -94,8 +94,8 @@ NOTE: In process of obsoleting this." ;; 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 ;; @@ -1002,6 +1002,13 @@ if something is a constructor. Value should be: where typename is the name of the type, and typeoftype is \"class\" or \"struct\".") +(define-mode-local-override semantic-analyze-split-name c-mode (name) + "Split up tag names on colon (:) boundaries." + (let ((ans (split-string name ":"))) + (if (= (length ans) 1) + name + (delete "" ans)))) + (defun semantic-c-reconstitute-token (tokenpart declmods typedecl) "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL. This is so we don't have to match the same starting text several times. @@ -1559,13 +1566,6 @@ These are constants which are of type TYPE." (string= (semantic-tag-type type) "enum")) (semantic-tag-type-members type))) -(define-mode-local-override semantic-analyze-split-name c-mode (name) - "Split up tag names on colon (:) boundaries." - (let ((ans (split-string name ":"))) - (if (= (length ans) 1) - name - (delete "" ans)))) - (define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist) "Assemble the list of names NAMELIST into a namespace name." (mapconcat 'identity namelist "::")) @@ -1871,5 +1871,4 @@ For types with a :parent, create faux namespaces to put TAG into." ;; generated-autoload-load-name: "semantic/bovine/c" ;; End: -;; arch-tag: 263951a8-0f18-445d-8e73-eb8f9ac8e2a3 ;;; semantic/bovine/c.el ends here diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index 184e23c9505..90c72990ca9 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -1,6 +1,7 @@ ;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files -;;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make @@ -133,11 +134,8 @@ Lays claim to all -by.el, and -wy.el files." (save-excursion (semantic-grammar-create-package)) (save-buffer) - (let ((cf (concat (semantic-grammar-package) ".el"))) - (if (or (not (file-exists-p cf)) - (file-newer-than-file-p src cf)) - (byte-compile-file cf))))) - (oref obj source))) + (byte-recompile-file (concat (semantic-grammar-package) ".el") nil 0))) + (oref obj source))) (message "All Semantic Grammar sources are up to date in %s" (object-name obj))) ;;; Makefile generation functions @@ -197,5 +195,4 @@ Argument THIS is the target that should insert stuff." (provide 'semantic/ede-grammar) -;; arch-tag: 37a06a8d-957a-4fa2-a931-38482d28c24a ;;; semantic/ede-grammar.el ends here diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index d99ae0cb0ac..513c211ee75 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -248,10 +248,7 @@ That is tag names plus names defined in tag attribute `:rest'." (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 @@ Optional argument COLOR determines if color is added to the text." (provide 'semantic/grammar) -;; arch-tag: 12ffc9d5-557d-49af-a5fd-a66a006ddb3e ;;; semantic/grammar.el ends here diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index e0fed29b4fa..34663727a0b 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -1427,10 +1427,7 @@ Return either a paren token or a semantic list token depending on ;; 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 @@ return LENGTH tokens." ;; 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 @@ return LENGTH tokens." ;; generated-autoload-load-name: "semantic/lex" ;; End: -;; arch-tag: a47664fc-48d9-4b36-921f-cab0ea8cdf92 ;;; semantic/lex.el ends here diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index d36beffc95f..667efede9ad 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -69,7 +69,7 @@ (defvar ede-minor-mode) (declare-function data-debug-new-buffer "data-debug") (declare-function data-debug-insert-object-slots "eieio-datadebug") -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") (declare-function ede-project-root-directory "ede/files") (declare-function ede-up-directory "ede/files") @@ -508,5 +508,4 @@ over until it returns nil." ;; generated-autoload-load-name: "semantic/symref" ;; End: -;; arch-tag: 928394b7-19ef-4f76-8cb3-37e9a9891984 ;;; semantic/symref.el ends here diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el index 5847c786147..606570961bf 100644 --- a/lisp/cedet/semantic/symref/cscope.el +++ b/lisp/cedet/semantic/symref/cscope.el @@ -27,7 +27,7 @@ (require 'semantic/symref) (defvar ede-minor-mode) -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") (declare-function ede-project-root-directory "ede/files") ;;; Code: @@ -91,5 +91,4 @@ Moves cursor to end of the match." ;; generated-autoload-load-name: "semantic/symref/cscope" ;; End: -;; arch-tag: 7c0a4e02-ade4-407a-9df7-4f948bd61a19 ;;; semantic/symref/cscope.el ends here diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 53044e278ac..9be53d90b08 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -221,49 +221,38 @@ Some useful functions are found in `semantic-format-tag-functions'." (defun semantic-symref-results-dump (results) "Dump the RESULTS into the current buffer." ;; Get ready for the insert. - (toggle-read-only -1) - (erase-buffer) - - ;; Insert the contents. - (let ((lastfile nil) - ) - (dolist (T (oref results :hit-tags)) - - (when (not (equal lastfile (semantic-tag-file-name T))) - (setq lastfile (semantic-tag-file-name T)) - (insert-button lastfile - 'mouse-face 'custom-button-pressed-face - 'action 'semantic-symref-rb-goto-file + (let ((inhibit-read-only t)) + (erase-buffer) + ;; Insert the contents. + (let ((lastfile nil)) + (dolist (T (oref results :hit-tags)) + (unless (equal lastfile (semantic-tag-file-name T)) + (setq lastfile (semantic-tag-file-name T)) + (insert-button lastfile + 'mouse-face 'custom-button-pressed-face + 'action 'semantic-symref-rb-goto-file + 'tag T) + (insert "\n")) + (insert " ") + (insert-button "[+]" + 'mouse-face 'highlight + 'face nil + 'action 'semantic-symref-rb-toggle-expand-tag 'tag T - ) - (insert "\n")) - - (insert " ") - (insert-button "[+]" - 'mouse-face 'highlight - 'face nil - 'action 'semantic-symref-rb-toggle-expand-tag - 'tag T - 'state 'closed) - (insert " ") - (insert-button (funcall semantic-symref-results-summary-function - T nil t) - 'mouse-face 'custom-button-pressed-face - 'face nil - 'action 'semantic-symref-rb-goto-tag - 'tag T) - (insert "\n") - - )) - - ;; Auto expand - (when semantic-symref-auto-expand-results - (semantic-symref-list-expand-all)) - - ;; Clean up the mess - (toggle-read-only 1) - (set-buffer-modified-p nil) - ) + 'state 'closed) + (insert " ") + (insert-button (funcall semantic-symref-results-summary-function + T nil t) + 'mouse-face 'custom-button-pressed-face + 'face nil + 'action 'semantic-symref-rb-goto-tag + 'tag T) + (insert "\n"))) + ;; Auto expand + (when semantic-symref-auto-expand-results + (semantic-symref-list-expand-all))) + ;; Clean up the mess + (set-buffer-modified-p nil)) ;;; Commands for semantic-symref-results ;; @@ -283,11 +272,9 @@ BUTTON is the button that was clicked." (buff (semantic-tag-buffer tag)) (hits (semantic--tag-get-property tag :hit)) (state (button-get button 'state)) - (text nil) - ) + (text nil)) (cond ((eq state 'closed) - (toggle-read-only -1) (with-current-buffer buff (dolist (H hits) (goto-char (point-min)) @@ -295,48 +282,42 @@ BUTTON is the button that was clicked." (beginning-of-line) (back-to-indentation) (setq text (cons (buffer-substring (point) (point-at-eol)) text))) - (setq text (nreverse text)) - ) + (setq text (nreverse text))) (goto-char (button-start button)) (forward-char 1) - (delete-char 1) - (insert "-") - (button-put button 'state 'open) - (save-excursion - (end-of-line) - (while text - (insert "\n") - (insert " ") - (insert-button (car text) - 'mouse-face 'highlight - 'face nil - 'action 'semantic-symref-rb-goto-match - 'tag tag - 'line (car hits)) - (setq text (cdr text) - hits (cdr hits)))) - (toggle-read-only 1) - ) + (let ((inhibit-read-only t)) + (delete-char 1) + (insert "-") + (button-put button 'state 'open) + (save-excursion + (end-of-line) + (while text + (insert "\n") + (insert " ") + (insert-button (car text) + 'mouse-face 'highlight + 'face nil + 'action 'semantic-symref-rb-goto-match + 'tag tag + 'line (car hits)) + (setq text (cdr text) + hits (cdr hits)))))) ((eq state 'open) - (toggle-read-only -1) - (button-put button 'state 'closed) - ;; Delete the various bits. - (goto-char (button-start button)) - (forward-char 1) - (delete-char 1) - (insert "+") - (save-excursion - (end-of-line) + (let ((inhibit-read-only t)) + (button-put button 'state 'closed) + ;; Delete the various bits. + (goto-char (button-start button)) (forward-char 1) - (delete-region (point) - (save-excursion - (forward-char 1) - (forward-line (length hits)) - (point)))) - (toggle-read-only 1) - ) - )) - ) + (delete-char 1) + (insert "+") + (save-excursion + (end-of-line) + (forward-char 1) + (delete-region (point) + (save-excursion + (forward-char 1) + (forward-line (length hits)) + (point))))))))) (defun semantic-symref-rb-goto-file (&optional button) "Go to the file specified in the symref results buffer. @@ -554,5 +535,4 @@ Return the number of occurrences FUNCTION was operated upon." ;; generated-autoload-load-name: "semantic/symref/list" ;; End: -;; arch-tag: e355d9c6-26e0-42d1-9bf1-f4801a54fffa ;;; semantic/symref/list.el ends here diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index 56b3a490118..ab08ea52dd6 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -32,7 +32,7 @@ (declare-function semanticdb-table-child-p "semantic/db" t t) (declare-function semanticdb-get-buffer "semantic/db") (declare-function semantic-dependency-find-file-on-path "semantic/dep") -(declare-function ede-toplevel "ede/files") +(declare-function ede-toplevel "ede/base") ;;; Code: @@ -214,5 +214,4 @@ file prototypes belong in." ;; generated-autoload-load-name: "semantic/tag-file" ;; End: -;; arch-tag: 71d4cf18-c1ec-414c-bb0a-c2ed914c1361 ;;; semantic/tag-file.el ends here diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 371a1947304..90585399b74 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -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 @@ If optional LEFT is non-nil insert spaces on left." (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 @@ Its name is defined in constant `wisent-log-buffer-name'." `(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 @@ See also `wisent-compile-grammar' for more details on AUTOMATON." (provide 'semantic/wisent/comp) -;; arch-tag: 758ea04c-ea97-466b-9b35-aea0861033c9 ;;; semantic/wisent/comp.el ends here diff --git a/lisp/comint.el b/lisp/comint.el index f9346f64c1f..b4d06cefafb 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -244,8 +244,8 @@ This variable is buffer-local." (defcustom comint-input-ring-file-name nil "If non-nil, name of the file to read/write input history. See also `comint-read-input-ring' and `comint-write-input-ring'. - -This variable is buffer-local, and is a good thing to set in mode hooks." +`comint-mode' makes this a buffer-local variable. You probably want +to set this in a mode hook, rather than customize the default value." :type '(choice (const :tag "nil" nil) file) :group 'comint) @@ -339,13 +339,15 @@ This variable is buffer-local." ;; Ubuntu's sudo prompts like `[sudo] password for user:' ;; Some implementations of passwd use "Password (again)" as the 2nd prompt. ;; Something called "perforce" uses "Enter password:". +;; See M-x comint-testsuite--test-comint-password-prompt-regexp. (defcustom comint-password-prompt-regexp (concat - "\\(" + "\\(^ *\\|" (regexp-opt - '("Enter" "Enter same" "Old" "old" "New" "new" "'s" "login" - "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "[sudo]" "Repeat" "Bad")) - " +\\)?" + '("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the" + "Old" "old" "New" "new" "'s" "login" + "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "[sudo]" "Repeat" "Bad") t) + " +\\)" (regexp-opt '("password" "Password" "passphrase" "Passphrase" "pass phrase" "Pass phrase")) @@ -353,6 +355,7 @@ This variable is buffer-local." \\(?: for [^:]+\\)?:\\s *\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." + :version "24.1" :type 'regexp :group 'comint) @@ -2645,6 +2648,7 @@ updated using `comint-update-fence', if necessary." (let ((inhibit-read-only t)) (kill-region beg end yank-handler) (comint-update-fence)))))) +(set-advertised-calling-convention 'comint-kill-region '(beg end) "23.3") ;; Support for source-file processing commands. @@ -3748,5 +3752,4 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." (provide 'comint) -;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164 ;;; comint.el ends here diff --git a/lisp/composite.el b/lisp/composite.el index 02c78580fff..da7705cf9eb 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -743,7 +743,11 @@ When Auto Composition is enabled, text characters are automatically composed by functions registered in `composition-function-table' (which see). You can use `global-auto-composition-mode' to turn on -Auto Composition mode in all buffers (this is the default).") +Auto Composition mode in all buffers (this is the default)." + ;; It's defined in C, this stops the d-m-m macro defining it again. + :variable auto-composition-mode) +;; It's not defined with DEFVAR_PER_BUFFER though. +(make-variable-buffer-local 'auto-composition-mode) ;;;###autoload (define-minor-mode global-auto-composition-mode @@ -757,5 +761,4 @@ See `auto-composition-mode' for more information on Auto-Composition mode." -;; arch-tag: ee703d77-1723-45d4-a31f-e9f0f867aa33 ;;; composite.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index f7090bc322f..61e6881139a 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2077,7 +2077,8 @@ and `face'." (defun custom-magic-reset (widget) "Redraw the :custom-magic property of WIDGET." (let ((magic (widget-get widget :custom-magic))) - (widget-value-set magic (widget-value magic)))) + (when magic + (widget-value-set magic (widget-value magic))))) ;;; The `custom' Widget. @@ -2460,7 +2461,14 @@ The following properties have special meanings for this widget: :custom-form should be a symbol describing how to display and edit the variable---either `edit' (using edit widgets), `lisp' (as a Lisp sexp), or `mismatch' (should not happen); - if nil, use the return value of `custom-variable-default-form'." + if nil, use the return value of `custom-variable-default-form'. + +:shown-value, if non-nil, should be a list whose `car' is the + variable value to display in place of the current value. + +:custom-style describes the widget interface style; nil is the + default style, while `simple' means a simpler interface that + inhibits the magic custom-state widget." :format "%v" :help-echo "Set or reset this variable." :documentation-property #'custom-variable-documentation @@ -2512,9 +2520,13 @@ try matching its doc string against `custom-guess-doc-alist'." (get (or (get symbol 'custom-get) 'default-value)) (prefix (widget-get widget :custom-prefix)) (last (widget-get widget :custom-last)) - (value (if (default-boundp symbol) - (funcall get symbol) - (widget-get conv :value))) + (style (widget-get widget :custom-style)) + (value (let ((shown-value (widget-get widget :shown-value))) + (cond (shown-value + (car shown-value)) + ((default-boundp symbol) + (funcall get symbol)) + (t (widget-get conv :value))))) (state (or (widget-get widget :custom-state) (if (memq (custom-variable-state symbol value) (widget-get widget :hidden-states)) @@ -2543,7 +2555,7 @@ try matching its doc string against `custom-guess-doc-alist'." :on "Hide" :off-image "right" :off "Show Value" - :action 'custom-toggle-parent + :action 'custom-toggle-hide-variable nil) buttons) (insert " ") @@ -2563,7 +2575,7 @@ try matching its doc string against `custom-guess-doc-alist'." :off "Show" :on-image "down" :off-image "right" - :action 'custom-toggle-parent + :action 'custom-toggle-hide-variable t) buttons) (insert " ") @@ -2593,7 +2605,7 @@ try matching its doc string against `custom-guess-doc-alist'." :off "Show" :on-image "down" :off-image "right" - :action 'custom-toggle-parent + :action 'custom-toggle-hide-variable t) buttons) (insert " ") @@ -2622,15 +2634,18 @@ try matching its doc string against `custom-guess-doc-alist'." (unless (eq (preceding-char) ?\n) (widget-insert "\n")) ;; Create the magic button. - (let ((magic (widget-create-child-and-convert - widget 'custom-magic nil))) - (widget-put widget :custom-magic magic) - (push magic buttons)) + (unless (eq style 'simple) + (let ((magic (widget-create-child-and-convert + widget 'custom-magic nil))) + (widget-put widget :custom-magic magic) + (push magic buttons))) (widget-put widget :buttons buttons) ;; Insert documentation. (widget-put widget :documentation-indent 3) - (widget-add-documentation-string-button - widget :visibility-widget 'custom-visibility) + (unless (and (eq style 'simple) + (eq state 'hidden)) + (widget-add-documentation-string-button + widget :visibility-widget 'custom-visibility)) ;; The comment field (unless (eq state 'hidden) @@ -2657,6 +2672,31 @@ try matching its doc string against `custom-guess-doc-alist'." (custom-add-parent-links widget)) (custom-add-see-also widget))))) +(defun custom-toggle-hide-variable (visibility-widget &rest ignore) + "Toggle the visibility of a `custom-variable' parent widget. +By default, this signals an error if the parent has unsaved +changes. If the parent has a `simple' :custom-style property, +the present value is saved to its :shown-value property instead." + (let ((widget (widget-get visibility-widget :parent))) + (unless (eq (widget-type widget) 'custom-variable) + (error "Invalid widget type")) + (custom-load-widget widget) + (let ((state (widget-get widget :custom-state))) + (if (eq state 'hidden) + (widget-put widget :custom-state 'unknown) + ;; In normal interface, widget can't be hidden if modified. + (when (memq state '(invalid modified set)) + (if (eq (widget-get widget :custom-style) 'simple) + (widget-put widget :shown-value + (list (widget-value + (car-safe + (widget-get widget :children))))) + (error "There are unsaved changes"))) + (widget-put widget :documentation-shown nil) + (widget-put widget :custom-state 'hidden)) + (custom-redraw widget) + (widget-setup)))) + (defun custom-tag-action (widget &rest args) "Pass :action to first child of WIDGET's parent." (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children)) @@ -3281,12 +3321,15 @@ The following properties have special meanings for this widget: Lisp sexp), or `mismatch' (should not happen); if nil, use the return value of `custom-face-default-form'. -:display-style, if non-nil, should be a symbol describing the - style of display to use. If the value is `concise', a more - concise interface is shown. +:custom-style describes the widget interface style; nil is the + default style, while `simple' means a simpler interface that + inhibits the magic custom-state widget. -:sample-indent, if non-nil, should be an integer; this is the -number of columns to which to indent the face sample." +:sample-indent, if non-nil, is the number of columns to which to + indent the face sample (an integer). + +:shown-value, if non-nil, is the face spec to display as the value + of the widget, instead of the current face spec." :sample-face 'custom-face-tag :help-echo "Set or reset this face." :documentation-property #'face-doc-string @@ -3380,6 +3423,29 @@ WIDGET should be a `custom-face' widget." (setq spec `((t ,(face-attr-construct face (selected-frame)))))) (custom-pre-filter-face-spec spec))) +(defun custom-toggle-hide-face (visibility-widget &rest ignore) + "Toggle the visibility of a `custom-face' parent widget. +By default, this signals an error if the parent has unsaved +changes. If the parent has a `simple' :custom-style property, +the present value is saved to its :shown-value property instead." + (let ((widget (widget-get visibility-widget :parent))) + (unless (eq (widget-type widget) 'custom-face) + (error "Invalid widget type")) + (custom-load-widget widget) + (let ((state (widget-get widget :custom-state))) + (if (eq state 'hidden) + (widget-put widget :custom-state 'unknown) + ;; In normal interface, widget can't be hidden if modified. + (when (memq state '(invalid modified set)) + (if (eq (widget-get widget :custom-style) 'simple) + (widget-put widget :shown-value + (custom-face-widget-to-spec widget)) + (error "There are unsaved changes"))) + (widget-put widget :documentation-shown nil) + (widget-put widget :custom-state 'hidden)) + (custom-redraw widget) + (widget-setup)))) + (defun custom-face-value-create (widget) "Create a list of the display specifications for WIDGET." (let* ((buttons (widget-get widget :buttons)) @@ -3387,7 +3453,7 @@ WIDGET should be a `custom-face' widget." (tag (or (widget-get widget :tag) (prin1-to-string symbol))) (hiddenp (eq (widget-get widget :custom-state) 'hidden)) - (style (widget-get widget :display-style)) + (style (widget-get widget :custom-style)) children) (if (eq custom-buffer-style 'tree) @@ -3410,7 +3476,7 @@ WIDGET should be a `custom-face' widget." :help-echo "Hide or show this face." :on "Hide" :off "Show" :on-image "down" :off-image "right" - :action 'custom-toggle-parent + :action 'custom-toggle-hide-face (not hiddenp)) buttons) ;; Face name (tag). @@ -3429,20 +3495,25 @@ WIDGET should be a `custom-face' widget." (indent-to-column sample-indent))) (push (widget-create-child-and-convert widget 'item - :format "[%{%t%}]" :sample-face symbol :tag "sample") + :format "[%{%t%}]" + :sample-face (let ((spec (widget-get widget :shown-value))) + (if spec (face-spec-choose spec) symbol)) + :tag "sample") buttons) - ;; Magic. (insert "\n") - (let ((magic (widget-create-child-and-convert - widget 'custom-magic nil))) - (widget-put widget :custom-magic magic) - (push magic buttons)) + + ;; Magic. + (unless (eq (widget-get widget :custom-style) 'simple) + (let ((magic (widget-create-child-and-convert + widget 'custom-magic nil))) + (widget-put widget :custom-magic magic) + (push magic buttons))) ;; Update buttons. (widget-put widget :buttons buttons) ;; Insert documentation. - (unless (and hiddenp (eq style 'concise)) + (unless (and hiddenp (eq style 'simple)) (widget-put widget :documentation-indent 3) (widget-add-documentation-string-button widget :visibility-widget 'custom-visibility) @@ -3465,7 +3536,8 @@ WIDGET should be a `custom-face' widget." (unless (widget-get widget :custom-form) (widget-put widget :custom-form custom-face-default-form)) - (let* ((spec (custom-face-get-current-spec symbol)) + (let* ((spec (or (widget-get widget :shown-value) + (custom-face-get-current-spec symbol))) (form (widget-get widget :custom-form)) (indent (widget-get widget :indent)) face-alist face-entry spec-default spec-match editor) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a43525f8245..91aa3edf384 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -1,7 +1,7 @@ ;;; cus-start.el --- define customization properties of builtins ;; -;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: internal @@ -34,6 +34,19 @@ ;;; Code: +;; Elements of this list have the form: +;; SYMBOL GROUP TYPE VERSION REST... +;; SYMBOL is the name of the variable. +;; GROUP is the custom group to which it belongs (may also be a list +;; of groups) +;; TYPE is the defcustom :type. +;; VERSION is the defcustom :version (or nil). +;; REST is a set of :KEYWORD VALUE pairs. Accepted :KEYWORDs are: +;; :standard - standard value for SYMBOL (else use current value) +;; :set - custom-set property +;; :risky - risky-local-variable property +;; :safe - safe-local-variable property +;; :tag - custom-tag property (let ((all '(;; alloc.c (gc-cons-threshold alloc integer) (garbage-collection-messages alloc boolean) @@ -96,6 +109,16 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of "21.1") (line-spacing display (choice (const :tag "none" nil) integer) "22.1") + (cursor-in-non-selected-windows + cursor boolean nil + :tag "Cursor In Non-selected Windows" + :set #'(lambda (symbol value) + (set-default symbol value) + (force-mode-line-update t))) + (transient-mark-mode editing-basics boolean nil + :standard (not noninteractive) + :initialize custom-initialize-delay + :set custom-set-minor-mode) ;; callint.c (mark-even-if-inactive editing-basics boolean) ;; callproc.c @@ -166,6 +189,36 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; fileio.c (delete-by-moving-to-trash auto-save boolean "23.1") (auto-save-visited-file-name auto-save boolean) + ;; filelock.c + (temporary-file-directory + ;; Darwin section added 24.1, does not seem worth :version bump. + files directory nil + :standard + (file-name-as-directory + ;; FIXME ? Should there be Ftemporary_file_directory to do this + ;; more robustly (cf set_local_socket in emacsclient.c). + ;; It could be used elsewhere, eg Fcall_process_region, + ;; server-socket-dir. See bug#7135. + (cond ((memq system-type '(ms-dos windows-nt)) + (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") + "c:/temp")) + ((eq system-type 'darwin) + (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") + ;; See bug#7135. + (let ((tmp (ignore-errors + (shell-command-to-string + "getconf DARWIN_USER_TEMP_DIR")))) + (and (stringp tmp) + (setq tmp (replace-regexp-in-string + "\n\\'" "" tmp)) + ;; Handles "getconf: Unrecognized variable..." + (file-directory-p tmp) + tmp)) + "/tmp")) + (t + (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") + "/tmp")))) + :initialize custom-initialize-delay) ;; fns.c (use-dialog-box menu boolean "21.1") (use-file-dialog menu boolean "22.1") @@ -180,6 +233,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (other :tag "hidden by keypress" 1)) "22.1") (make-pointer-invisible mouse boolean "23.2") + (menu-bar-mode frames boolean nil + ;; FIXME? +; :initialize custom-initialize-default + :set custom-set-minor-mode) + (tool-bar-mode (frames mouse) boolean nil +; :initialize custom-initialize-default + :set custom-set-minor-mode) ;; fringe.c (overflow-newline-into-fringe fringe boolean) ;; indent.c @@ -260,12 +320,28 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const control) (const meta) (const alt) (const hyper) (const super)) "23.1") + (ns-right-control-modifier + ns + (choice (const :tag "No modifier (work as control)" none) + (const :tag "Use the value of ns-control-modifier" + left) + (const control) (const meta) + (const alt) (const hyper) + (const super)) "24.0") (ns-command-modifier ns (choice (const :tag "No modifier" nil) (const control) (const meta) (const alt) (const hyper) (const super)) "23.1") + (ns-right-command-modifier + ns + (choice (const :tag "No modifier (work as command)" none) + (const :tag "Use the value of ns-command-modifier" + left) + (const control) (const meta) + (const alt) (const hyper) + (const super)) "24.0") (ns-alternate-modifier ns (choice (const :tag "No modifier (work as alternate/option)" none) @@ -327,6 +403,8 @@ since it could result in memory overflow and make Emacs crash." (other :tag "Always" t)) "23.1") ;; xdisp.c + (show-trailing-whitespace whitespace-faces boolean nil + :safe booleanp) (scroll-step windows integer) (scroll-conservatively windows integer) (scroll-margin windows integer) @@ -362,6 +440,9 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Text-image-horiz" :value text-image-horiz) (const :tag "System default" :value nil)) "23.3") (tool-bar-max-label-size frames integer "23.3") + (auto-hscroll-mode scrolling boolean "21.1") + (display-hourglass cursor boolean) + (hourglass-delay cursor number) ;; xfaces.c (scalable-fonts-allowed display boolean "22.1") @@ -379,7 +460,7 @@ since it could result in memory overflow and make Emacs crash." (x-stretch-cursor display boolean "21.1") ;; xsettings.c (font-use-system-font font-selection boolean "23.2"))) - this symbol group type standard version native-p + this symbol group type standard version native-p rest prop propval ;; This function turns a value ;; into an expression which produces that value. (quoter (lambda (sexp) @@ -398,12 +479,13 @@ since it could result in memory overflow and make Emacs crash." group (nth 1 this) type (nth 2 this) version (nth 3 this) + rest (nthcdr 4 this) ;; If we did not specify any standard value expression above, ;; use the current value as the standard value. - standard (if (nthcdr 4 this) - (nth 4 this) - (when (default-boundp symbol) - (funcall quoter (default-value symbol)))) + standard (if (setq prop (memq :standard rest)) + (cadr prop) + (if (default-boundp symbol) + (funcall quoter (default-value symbol)))) ;; Don't complain about missing variables which are ;; irrelevant to this platform. native-p (save-match-data @@ -436,25 +518,44 @@ since it could result in memory overflow and make Emacs crash." ;; Save the standard value, unless we already did. (or (get symbol 'standard-value) (put symbol 'standard-value (list standard))) - ;; If this is NOT while dumping Emacs, - ;; set up the rest of the customization info. + ;; We need these properties independent of whether cus-start is loaded. + (if (setq prop (memq :safe rest)) + (put symbol 'safe-local-variable (cadr prop))) + (if (setq prop (memq :risky rest)) + (put symbol 'risky-local-variable (cadr prop))) + (if (setq prop (memq :set rest)) + (put symbol 'custom-set (cadr prop))) + ;; Note this is the _only_ initialize property we handle. + (if (eq (cadr (memq :initialize rest)) 'custom-initialize-delay) + (push symbol custom-delayed-init-variables)) + ;; If this is NOT while dumping Emacs, set up the rest of the + ;; customization info. This is the stuff that is not needed + ;; until someone does M-x customize etc. (unless purify-flag - ;; Add it to the right group. - (custom-add-to-group group symbol 'custom-variable) + ;; Add it to the right group(s). + (if (listp group) + (dolist (g group) + (custom-add-to-group g symbol 'custom-variable)) + (custom-add-to-group group symbol 'custom-variable)) ;; Set the type. (put symbol 'custom-type type) - (put symbol 'custom-version version))))) + (if version (put symbol 'custom-version version)) + (while rest + (setq prop (car rest) + propval (cadr rest) + rest (nthcdr 2 rest)) + (cond ((memq prop '(:standard :risky :safe :set))) ; handled above + ((eq prop :tag) + (put symbol 'custom-tag propval)))))))) (custom-add-to-group 'iswitchb 'read-buffer-function 'custom-variable) (custom-add-to-group 'font-lock 'open-paren-in-column-0-is-defun-start 'custom-variable) -;; Record cus-start as loaded -;; if we have set up all the info that we can set up. -;; Don't record cus-start as loaded -;; if we have set up only the standard values. +;; Record cus-start as loaded if we have set up all the info that we can. +;; Don't record it as loaded if we have only set up the standard values +;; and safe/risky properties. (unless purify-flag (provide 'cus-start)) -;; arch-tag: 4502730d-bcb3-4f5e-99a3-a86f2d54af60 ;;; cus-start.el ends here diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 197d9787d9a..e6e286f00fa 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -41,7 +41,7 @@ map) "Keymap for `custom-new-theme-mode'.") -(define-derived-mode custom-new-theme-mode nil "Cus-Theme" +(define-derived-mode custom-new-theme-mode nil "Custom-Theme" "Major mode for editing Custom themes. Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-new-theme-mode-map) @@ -50,9 +50,12 @@ Do not call this mode function yourself. It is meant for internal use." (put 'custom-new-theme-mode 'mode-class 'special) (defvar custom-theme-name nil) +;; Each element has the form (VAR CHECKBOX-WIDGET VAR-WIDGET) (defvar custom-theme-variables nil) +;; Each element has the form (FACE CHECKBOX-WIDGET FACE-WIDGET) (defvar custom-theme-faces nil) (defvar custom-theme-description nil) +(defvar custom-theme--migrate-settings nil) (defvar custom-theme-insert-variable-marker nil) (defvar custom-theme-insert-face-marker nil) @@ -78,23 +81,32 @@ Do not call this mode function yourself. It is meant for internal use." ;;;###autoload (defun customize-create-theme (&optional theme buffer) "Create or edit a custom theme. -THEME, if non-nil, should be an existing theme to edit. -BUFFER, if non-nil, should be a buffer to use." +THEME, if non-nil, should be an existing theme to edit. If THEME +is `user', provide an option to remove these as custom settings. +BUFFER, if non-nil, should be a buffer to use; the default is +named *Custom Theme*." (interactive) (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*"))) - ;; Save current faces (let ((inhibit-read-only t)) - (erase-buffer)) + (erase-buffer) + (dolist (ov (overlays-in (point-min) (point-max))) + (delete-overlay ov))) (custom-new-theme-mode) (make-local-variable 'custom-theme-name) (set (make-local-variable 'custom-theme--save-name) theme) (set (make-local-variable 'custom-theme-faces) nil) (set (make-local-variable 'custom-theme-variables) nil) (set (make-local-variable 'custom-theme-description) "") + (set (make-local-variable 'custom-theme--migrate-settings) nil) (make-local-variable 'custom-theme-insert-face-marker) (make-local-variable 'custom-theme-insert-variable-marker) (make-local-variable 'custom-theme--listed-faces) + (if (eq theme 'user) + (widget-insert "This buffer contains all the Custom settings you have made. +You can convert them into a new custom theme, and optionally +remove them from your saved Custom file.\n\n")) + (widget-create 'push-button :tag " Visit Theme " :help-echo "Insert the settings of a pre-defined theme." @@ -107,64 +119,92 @@ BUFFER, if non-nil, should be a buffer to use." :action (lambda (widget &optional event) (call-interactively 'custom-theme-merge-theme))) (widget-insert " ") - (widget-create 'push-button :notify 'revert-buffer " Revert ") + (widget-create 'push-button + :tag " Revert " + :help-echo "Revert this buffer to its original state." + :action (lambda (&rest ignored) (revert-buffer))) (widget-insert "\n\nTheme name : ") (setq custom-theme-name (widget-create 'editable-field - :value (if theme (symbol-name theme) ""))) + :value (if (and theme (not (eq theme 'user))) + (symbol-name theme) + ""))) (widget-insert "Description: ") (setq custom-theme-description (widget-create 'text :value (format-time-string "Created %Y-%m-%d."))) - (widget-insert " ") (widget-create 'push-button :notify (function custom-theme-write) " Save Theme ") - ;; Face widgets - (widget-insert "\n\n Theme faces:\n") - (let (widget) - (dolist (face custom-theme--listed-faces) - (widget-insert " ") - (setq widget (widget-create 'custom-face - :documentation-shown t - :tag (custom-unlispify-tag-name face) - :value face - :display-style 'concise - :custom-state 'hidden - :sample-indent 34)) - (custom-magic-reset widget) - (push (cons face widget) custom-theme-faces))) - (insert " ") - (setq custom-theme-insert-face-marker (point-marker)) - (insert " ") - (widget-create 'push-button - :tag "Insert Additional Face" - :help-echo "Add another face to this theme." - :follow-link 'mouse-face - :button-face 'custom-link - :mouse-face 'highlight - :pressed-face 'highlight - :action (lambda (widget &optional event) - (call-interactively 'custom-theme-add-face))) - (widget-insert "\n\n Theme variables:\n ") - (setq custom-theme-insert-variable-marker (point-marker)) - (widget-insert ?\s) - (widget-create 'push-button - :tag "Insert Variable" - :help-echo "Add another variable to this theme." - :follow-link 'mouse-face - :button-face 'custom-link - :mouse-face 'highlight - :pressed-face 'highlight - :action (lambda (widget &optional event) - (call-interactively 'custom-theme-add-variable))) - (widget-insert ?\n) - (if theme - (custom-theme-merge-theme theme)) - (widget-setup) - (goto-char (point-min)) - (message "")) + (when (eq theme 'user) + (setq custom-theme--migrate-settings t) + (widget-insert " ") + (widget-create 'checkbox + :value custom-theme--migrate-settings + :action (lambda (widget &optional event) + (when (widget-value widget) + (widget-toggle-action widget event) + (setq custom-theme--migrate-settings + (widget-value widget))))) + (widget-insert (propertize " Remove saved theme settings from Custom save file." + 'face '(variable-pitch (:height 0.9))))) + + (let (vars values faces face-specs) + + ;; Load the theme settings. + (when theme + (unless (eq theme 'user) + (load-theme theme t)) + (dolist (setting (get theme 'theme-settings)) + (if (eq (car setting) 'theme-value) + (progn (push (nth 1 setting) vars) + (push (nth 3 setting) values)) + (push (nth 1 setting) faces) + (push (nth 3 setting) face-specs)))) + + ;; If THEME is non-nil, insert all of that theme's faces. + ;; Otherwise, insert those in `custom-theme--listed-faces'. + (widget-insert "\n\n Theme faces:\n ") + (if theme + (while faces + (custom-theme-add-face-1 (pop faces) (pop face-specs))) + (dolist (face custom-theme--listed-faces) + (custom-theme-add-face-1 face nil))) + (setq custom-theme-insert-face-marker (point-marker)) + (widget-insert " ") + (widget-create 'push-button + :tag "Insert Additional Face" + :help-echo "Add another face to this theme." + :follow-link 'mouse-face + :button-face 'custom-link + :mouse-face 'highlight + :pressed-face 'highlight + :action (lambda (widget &optional event) + (call-interactively 'custom-theme-add-face))) + + ;; If THEME is non-nil, insert all of that theme's variables. + (widget-insert "\n\n Theme variables:\n ") + (if theme + (while vars + (if (eq (car vars) 'custom-enabled-themes) + (progn (pop vars) (pop values)) + (custom-theme-add-var-1 (pop vars) (pop values))))) + (setq custom-theme-insert-variable-marker (point-marker)) + (widget-insert " ") + (widget-create 'push-button + :tag "Insert Variable" + :help-echo "Add another variable to this theme." + :follow-link 'mouse-face + :button-face 'custom-link + :mouse-face 'highlight + :pressed-face 'highlight + :action (lambda (widget &optional event) + (call-interactively 'custom-theme-add-variable))) + (widget-insert ?\n) + (widget-setup) + (goto-char (point-min)) + (message ""))) (defun custom-theme-revert (ignore-auto noconfirm) (when (or noconfirm (y-or-n-p "Discard current changes? ")) @@ -172,181 +212,133 @@ BUFFER, if non-nil, should be a buffer to use." ;;; Theme variables -(defun custom-theme-add-variable (symbol) - (interactive "vVariable name: ") - (cond ((assq symbol custom-theme-variables) - (message "%s is already in the theme" (symbol-name symbol))) - ((not (boundp symbol)) - (message "%s is not defined as a variable" (symbol-name symbol))) - ((eq symbol 'custom-enabled-themes) - (message "Custom theme cannot contain `custom-enabled-themes'")) - (t - (save-excursion - (goto-char custom-theme-insert-variable-marker) - (widget-insert " ") - (let ((widget (widget-create 'custom-variable - :tag (custom-unlispify-tag-name symbol) - :custom-level 0 - :action 'custom-theme-variable-action - :custom-state 'unknown - :value symbol))) - (push (cons symbol widget) custom-theme-variables) - (custom-magic-reset widget)) - (widget-insert " ") - (move-marker custom-theme-insert-variable-marker (point)) - (widget-setup))))) - -(defvar custom-theme-variable-menu - `(("Reset to Current" custom-redraw - (lambda (widget) - (and (boundp (widget-value widget)) - (memq (widget-get widget :custom-state) - '(themed modified changed))))) - ("Reset to Theme Value" custom-variable-reset-theme - (lambda (widget) - (let ((theme (intern (widget-value custom-theme-name))) - (symbol (widget-value widget)) - found) - (and (custom-theme-p theme) - (dolist (setting (get theme 'theme-settings) found) - (if (and (eq (cadr setting) symbol) - (eq (car setting) 'theme-value)) - (setq found t))))))) - ("---" ignore ignore) - ("Delete" custom-theme-delete-variable nil)) - "Alist of actions for the `custom-variable' widget in Custom Theme Mode. -See the documentation for `custom-variable'.") - -(defun custom-theme-variable-action (widget &optional event) - "Show the Custom Theme Mode menu for a `custom-variable' widget. -Optional EVENT is the location for the menu." - (let ((custom-variable-menu custom-theme-variable-menu)) - (custom-variable-action widget event))) - -(defun custom-variable-reset-theme (widget) - "Reset WIDGET to its value for the currently edited theme." - (let ((theme (intern (widget-value custom-theme-name))) - (symbol (widget-value widget)) - found) - (dolist (setting (get theme 'theme-settings)) - (if (and (eq (cadr setting) symbol) - (eq (car setting) 'theme-value)) - (setq found setting))) - (widget-value-set (car (widget-get widget :children)) - (nth 3 found))) - (widget-put widget :custom-state 'themed) - (custom-redraw-magic widget) - (widget-setup)) - -(defun custom-theme-delete-variable (widget) - (setq custom-theme-variables - (assq-delete-all (widget-value widget) custom-theme-variables)) - (widget-delete widget)) +(defun custom-theme-add-variable (var value) + "Add a widget for VAR (a symbol) to the *New Custom Theme* buffer. +VALUE should be a value to which to set the widget; when called +interactively, this defaults to the current value of VAR." + (interactive + (let ((v (read-variable "Variable name: "))) + (list v (symbol-value v)))) + (let ((entry (assq var custom-theme-variables))) + (cond ((null entry) + ;; If VAR is not yet in the buffer, add it. + (save-excursion + (goto-char custom-theme-insert-variable-marker) + (custom-theme-add-var-1 var value) + (move-marker custom-theme-insert-variable-marker (point)) + (widget-setup))) + ;; Otherwise, alter that var widget. + (t + (widget-value-set (nth 1 entry) t) + (let ((widget (nth 2 entry))) + (widget-put widget :shown-value (list value)) + (custom-redraw widget)))))) + +(defun custom-theme-add-var-1 (symbol val) + (widget-insert " ") + (push (list symbol + (prog1 (widget-create 'checkbox + :value t + :help-echo "Enable/disable this variable.") + (widget-insert " ")) + (widget-create 'custom-variable + :tag (custom-unlispify-tag-name symbol) + :value symbol + :shown-value (list val) + :notify 'ignore + :custom-level 0 + :custom-state 'hidden + :custom-style 'simple)) + custom-theme-variables) + (widget-insert " ")) ;;; Theme faces -(defun custom-theme-add-face (symbol) - (interactive (list (read-face-name "Face name" nil nil))) - (cond ((assq symbol custom-theme-faces) - (message "%s is already in the theme" (symbol-name symbol))) - ((not (facep symbol)) - (message "%s is not defined as a face" (symbol-name symbol))) - (t - (save-excursion - (goto-char custom-theme-insert-face-marker) - (widget-insert " ") - (let ((widget (widget-create 'custom-face - :tag (custom-unlispify-tag-name symbol) - :custom-level 0 - :action 'custom-theme-face-action - :custom-state 'unknown - :display-style 'concise - :sample-indent 34 - :value symbol))) - (push (cons symbol widget) custom-theme-faces) - (custom-magic-reset widget) - (widget-insert " ") +(defun custom-theme-add-face (face &optional spec) + "Add a widget for FACE (a symbol) to the *New Custom Theme* buffer. +SPEC, if non-nil, should be a face spec to which to set the widget." + (interactive (list (read-face-name "Face name" nil nil) nil)) + (unless (or (facep face) spec) + (error "`%s' has no face definition" face)) + (let ((entry (assq face custom-theme-faces))) + (cond ((null entry) + ;; If FACE is not yet in the buffer, add it. + (save-excursion + (goto-char custom-theme-insert-face-marker) + (custom-theme-add-face-1 face spec) (move-marker custom-theme-insert-face-marker (point)) - (widget-setup)))))) - -(defvar custom-theme-face-menu - `(("Reset to Theme Value" custom-face-reset-theme - (lambda (widget) - (let ((theme (intern (widget-value custom-theme-name))) - (symbol (widget-value widget)) - found) - (and (custom-theme-p theme) - (dolist (setting (get theme 'theme-settings) found) - (if (and (eq (cadr setting) symbol) - (eq (car setting) 'theme-face)) - (setq found t))))))) - ("---" ignore ignore) - ("Delete" custom-theme-delete-face nil)) - "Alist of actions for the `custom-variable' widget in Custom Theme Mode. -See the documentation for `custom-variable'.") - -(defun custom-theme-face-action (widget &optional event) - "Show the Custom Theme Mode menu for a `custom-face' widget. -Optional EVENT is the location for the menu." - (let ((custom-face-menu custom-theme-face-menu)) - (custom-face-action widget event))) - -(defun custom-face-reset-theme (widget) - "Reset WIDGET to its value for the currently edited theme." - (let ((theme (intern (widget-value custom-theme-name))) - (symbol (widget-value widget)) - found) - (dolist (setting (get theme 'theme-settings)) - (if (and (eq (cadr setting) symbol) - (eq (car setting) 'theme-face)) - (setq found setting))) - (widget-value-set (car (widget-get widget :children)) - (nth 3 found))) - (widget-put widget :custom-state 'themed) - (custom-redraw-magic widget) - (widget-setup)) - -(defun custom-theme-delete-face (widget) - (setq custom-theme-faces - (assq-delete-all (widget-value widget) custom-theme-faces)) - (widget-delete widget)) + (widget-setup))) + ;; Otherwise, if SPEC is supplied, alter that face widget. + (spec + (widget-value-set (nth 1 entry) t) + (let ((widget (nth 2 entry))) + (widget-put widget :shown-value spec) + (custom-redraw widget))) + ((called-interactively-p 'interactive) + (error "`%s' is already present" face))))) + +(defun custom-theme-add-face-1 (symbol spec) + (widget-insert " ") + (push (list symbol + (prog1 + (widget-create 'checkbox + :value t + :help-echo "Enable/disable this face.") + (widget-insert " ")) + (widget-create 'custom-face + :tag (custom-unlispify-tag-name symbol) + :documentation-shown t + :value symbol + :custom-state 'hidden + :custom-style 'simple + :shown-value spec + :sample-indent 34)) + custom-theme-faces) + (widget-insert " ")) ;;; Reading and writing -(defun custom-theme-visit-theme () - (interactive) - (when (and (y-or-n-p "Discard current changes? ") - (progn (revert-buffer) t)) - (let ((theme (call-interactively 'custom-theme-merge-theme))) - (unless (eq theme 'user) - (widget-value-set custom-theme-name (symbol-name theme))) - (widget-value-set custom-theme-description - (or (get theme 'theme-documentation) - (format-time-string "Created %Y-%m-%d."))) - (widget-setup)))) +(defun custom-theme-visit-theme (theme) + "Load the custom theme THEME's settings into the current buffer." + (interactive + (list + (intern (completing-read "Find custom theme: " + (mapcar 'symbol-name + (custom-available-themes)))))) + (unless (custom-theme-name-valid-p theme) + (error "No valid theme named `%s'" theme)) + (cond ((not (eq major-mode 'custom-new-theme-mode)) + (customize-create-theme theme)) + ((y-or-n-p "Discard current changes? ") + (setq custom-theme--save-name theme) + (custom-theme-revert nil t)))) (defun custom-theme-merge-theme (theme) + "Merge the custom theme THEME's settings into the current buffer." (interactive (list (intern (completing-read "Merge custom theme: " (mapcar 'symbol-name (custom-available-themes)))))) - (unless (custom-theme-name-valid-p theme) - (error "Invalid theme name `%s'" theme)) - (load-theme theme) - (let ((settings (get theme 'theme-settings))) + (unless (eq theme 'user) + (unless (custom-theme-name-valid-p theme) + (error "Invalid theme name `%s'" theme)) + (load-theme theme t)) + (let ((settings (reverse (get theme 'theme-settings)))) (dolist (setting settings) - (if (eq (car setting) 'theme-value) - (custom-theme-add-variable (cadr setting)) - (custom-theme-add-face (cadr setting))))) - (disable-theme theme) + (funcall (if (eq (car setting) 'theme-value) + 'custom-theme-add-variable + 'custom-theme-add-face) + (nth 1 setting) + (nth 3 setting)))) theme) (defun custom-theme-write (&rest ignore) + "Write the current custom theme to its theme file." (interactive) (let* ((name (widget-value custom-theme-name)) - (doc (widget-value custom-theme-description)) - (vars custom-theme-variables) + (doc (widget-value custom-theme-description)) + (vars custom-theme-variables) (faces custom-theme-faces) filename) (when (string-equal name "") @@ -363,26 +355,33 @@ Optional EVENT is the location for the menu." (with-temp-buffer (emacs-lisp-mode) - (unless (file-exists-p custom-theme-directory) + (unless (file-directory-p custom-theme-directory) (make-directory (file-name-as-directory custom-theme-directory) t)) (setq buffer-file-name filename) (erase-buffer) (insert "(deftheme " name) (if doc (insert "\n \"" doc "\"")) (insert ")\n") - (custom-theme-write-variables name vars) - (custom-theme-write-faces name faces) + (custom-theme-write-variables name (reverse vars)) + (custom-theme-write-faces name (reverse faces)) (insert "\n(provide-theme '" name ")\n") (save-buffer)) - (dolist (var vars) - (when (widget-get (cdr var) :children) - (widget-put (cdr var) :custom-state 'saved) - (custom-redraw-magic (cdr var)))) - (dolist (face custom-theme-faces) - (when (widget-get (cdr face) :children) - (widget-put (cdr face) :custom-state 'saved) - (custom-redraw-magic (cdr face)))) - (message "Theme written to %s" filename))) + (message "Theme written to %s" filename) + + (when custom-theme--migrate-settings + ;; Remove these settings from the Custom file. + (let ((custom-reset-standard-variables-list '(t)) + (custom-reset-standard-faces-list '(t))) + (dolist (var vars) + (when (and (not (eq (car var) 'custom-enabled-themes)) + (widget-get (nth 1 var) :value)) + (widget-apply (nth 2 var) :custom-mark-to-reset-standard))) + (dolist (face faces) + (when (widget-get (nth 1 face) :value) + (widget-apply (nth 2 face) :custom-mark-to-reset-standard))) + (custom-save-all)) + (let ((custom-theme-load-path (list 'custom-theme-directory))) + (load-theme (intern name)))))) (defun custom-theme-write-variables (theme vars) "Write a `custom-theme-set-variables' command for THEME. @@ -394,20 +393,22 @@ It includes all variables in list VARS." (princ theme) (princ "\n") (dolist (spec vars) - (let* ((symbol (car spec)) - (child (car-safe (widget-get (cdr spec) :children))) - (value (if child - (widget-value child) - ;; For hidden widgets, use the standard value - (get symbol 'standard-value)))) - (when (boundp symbol) - (unless (bolp) - (princ "\n")) - (princ " '(") - (prin1 symbol) - (princ " ") - (prin1 (custom-quote value)) - (princ ")")))) + (when (widget-get (nth 1 spec) :value) + (let* ((symbol (nth 0 spec)) + (widget (nth 2 spec)) + (child (car-safe (widget-get widget :children))) + (value (if child + (widget-value child) + ;; Child is null if the widget is closed (hidden). + (car (widget-get widget :shown-value))))) + (when (boundp symbol) + (unless (bolp) + (princ "\n")) + (princ " '(") + (prin1 symbol) + (princ " ") + (prin1 (custom-quote value)) + (princ ")"))))) (if (bolp) (princ " ")) (princ ")") @@ -424,32 +425,21 @@ It includes all faces in list FACES." (princ theme) (princ "\n") (dolist (spec faces) - (let* ((symbol (car spec)) - (widget (cdr spec)) - (child (car-safe (widget-get widget :children))) - (state (if child - (widget-get widget :custom-state) - (custom-face-state symbol))) - (value - (cond ((eq state 'standard) - nil) ; do nothing - (child - (custom-face-widget-to-spec widget)) - (t - ;; Widget is closed (hidden), but the face has - ;; a non-standard value. Try to extract that - ;; value and save it. - (custom-face-get-current-spec symbol))))) - (when (and (facep symbol) value) - (if (bolp) - (princ " '(") - (princ "\n '(")) - (prin1 symbol) - (princ " ") - (prin1 value) - (princ ")")))) - (if (bolp) - (princ " ")) + (when (widget-get (nth 1 spec) :value) + (let* ((symbol (nth 0 spec)) + (widget (nth 2 spec)) + (value + (if (car-safe (widget-get widget :children)) + (custom-face-widget-to-spec widget) + ;; Child is null if the widget is closed (hidden). + (widget-get widget :shown-value)))) + (when (and (facep symbol) value) + (princ (if (bolp) " '(" "\n '(")) + (prin1 symbol) + (princ " ") + (prin1 value) + (princ ")"))))) + (if (bolp) (princ " ")) (princ ")") (unless (looking-at "\n") (princ "\n"))))) @@ -477,7 +467,7 @@ It includes all faces in list FACES." (prin1 theme) (princ " is a custom theme") (let ((fn (locate-file (concat (symbol-name theme) "-theme.el") - (cons custom-theme-directory load-path) + (custom-theme--load-path) '("" "c"))) doc) (when fn @@ -534,7 +524,7 @@ It includes all faces in list FACES." map) "Keymap for `custom-theme-choose-mode'.") -(define-derived-mode custom-theme-choose-mode nil "Cus-Theme" +(define-derived-mode custom-theme-choose-mode nil "Themes" "Major mode for selecting Custom themes. Do not call this mode function yourself. It is meant for internal use." (use-local-map custom-theme-choose-mode-map) @@ -566,27 +556,40 @@ omitted, a buffer named *Custom Themes* is used." "Type RET or click to enable/disable listed custom themes. Type \\[custom-describe-theme] to describe the theme at point. Theme files are named *-theme.el in `")) - (when (stringp custom-theme-directory) - (widget-create 'link :value custom-theme-directory - :button-face 'custom-link - :mouse-face 'highlight - :pressed-face 'highlight - :help-echo "Describe `custom-theme-directory'." - :keymap custom-mode-link-map - :follow-link 'mouse-face - :action (lambda (widget &rest ignore) - (describe-variable 'custom-theme-directory))) - (widget-insert "' or `")) - (widget-create 'link :value "load-path" + (widget-create 'link :value "custom-theme-load-path" :button-face 'custom-link :mouse-face 'highlight :pressed-face 'highlight - :help-echo "Describe `load-path'." + :help-echo "Describe `custom-theme-load-path'." :keymap custom-mode-link-map :follow-link 'mouse-face :action (lambda (widget &rest ignore) - (describe-variable 'load-path))) + (describe-variable 'custom-theme-load-path))) (widget-insert "'.\n\n") + + ;; If the user has made customizations, display a warning and + ;; provide buttons to disable or convert them. + (let ((user-settings (get 'user 'theme-settings))) + (unless (or (null user-settings) + (and (null (cdr user-settings)) + (eq (caar user-settings) 'theme-value) + (eq (cadr (car user-settings)) 'custom-enabled-themes))) + (widget-insert + (propertize + " Note: Your custom settings take precedence over theme settings. + To migrate your settings into a theme, click " + 'face 'font-lock-warning-face)) + (widget-create 'link :value "here" + :button-face 'custom-link + :mouse-face 'highlight + :pressed-face 'highlight + :help-echo "Migrate." + :keymap custom-mode-link-map + :follow-link 'mouse-face + :action (lambda (widget &rest ignore) + (customize-create-theme 'user))) + (widget-insert ".\n\n"))) + (widget-create 'push-button :tag " Save Theme Settings " :help-echo "Save the selected themes for future sessions." @@ -654,9 +657,8 @@ Theme files are named *-theme.el in `")) (defun custom-theme-selections-toggle (widget &optional event) (when (widget-value widget) ;; Deactivate multiple-selections. - (if (> (length (delq nil (mapcar (lambda (x) (widget-value (cdr x))) - custom--listed-themes))) - 1) + (if (< 1 (length (delq nil (mapcar (lambda (x) (widget-value (cdr x))) + custom--listed-themes)))) (error "More than one theme is currently selected"))) (widget-toggle-action widget event) (setq custom-theme-allow-multiple-selections (widget-value widget))) diff --git a/lisp/custom.el b/lisp/custom.el index c5ebe64da3c..bcb78e46a3c 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -996,9 +996,8 @@ in SYMBOL's list property `theme-value' \(using `custom-push-theme')." ;;; Defining themes. -;; A theme file should be named `THEME-theme.el' (where THEME is the theme -;; name), and found in either `custom-theme-directory' or the load path. -;; It has the following format: +;; A theme file is named `THEME-theme.el' (where THEME is the theme +;; name) found in `custom-theme-load-path'. It has this format: ;; ;; (deftheme THEME ;; DOCSTRING) @@ -1034,8 +1033,8 @@ see `custom-make-theme-feature' for more information." "Like `deftheme', but THEME is evaluated as a normal argument. FEATURE is the feature this theme provides. Normally, this is a symbol created from THEME by `custom-make-theme-feature'." - (if (memq theme '(user changed)) - (error "Custom theme cannot be named %S" theme)) + (unless (custom-theme-name-valid-p theme) + (error "Custom theme cannot be named %S" theme)) (add-to-list 'custom-known-themes theme) (put theme 'theme-feature feature) (when doc (put theme 'theme-documentation doc))) @@ -1053,16 +1052,35 @@ Every theme X has a property `provide-theme' whose value is \"X-theme\". ;;; Loading themes. -(defcustom custom-theme-directory - user-emacs-directory - "Directory in which Custom theme files should be written. -`load-theme' searches this directory in addition to load-path. -The command `customize-create-theme' writes the files it produces -into this directory." +(defcustom custom-theme-directory user-emacs-directory + "Default user directory for storing custom theme files. +The command `customize-create-theme' writes theme files into this +directory. By default, Emacs searches for custom themes in this +directory first---see `custom-theme-load-path'." :type 'string :group 'customize :version "22.1") +(defcustom custom-theme-load-path (list 'custom-theme-directory t) + "List of directories to search for custom theme files. +When loading custom themes (e.g. in `customize-themes' and +`load-theme'), Emacs searches for theme files in the specified +order. Each element in the list should be one of the following: +- the symbol `custom-theme-directory', meaning the value of + `custom-theme-directory'. +- the symbol t, meaning the built-in theme directory (a directory + named \"themes\" in `data-directory'). +- a directory name (a string). + +Each theme file is named NAME-theme.el, where THEME is the theme +name." + :type '(repeat (choice (const :tag "custom-theme-directory" + custom-theme-directory) + (const :tag "Built-in theme directory" t) + directory)) + :group 'customize + :version "24.1") + (defvar custom--inhibit-theme-enable nil "If non-nil, loading a theme does not enable it. This internal variable is set by `load-theme' when its NO-ENABLE @@ -1074,19 +1092,21 @@ argument is non-nil, and it affects `custom-theme-set-variables', This calls `provide' to provide the feature name stored in THEME's property `theme-feature' (which is usually a symbol created by `custom-make-theme-feature')." - (if (memq theme '(user changed)) - (error "Custom theme cannot be named %S" theme)) + (unless (custom-theme-name-valid-p theme) + (error "Custom theme cannot be named %S" theme)) (custom-check-theme theme) (provide (get theme 'theme-feature)) (unless custom--inhibit-theme-enable - ;; Loading a theme also enables it. + ;; By default, loading a theme also enables it. (push theme custom-enabled-themes) ;; `user' must always be the highest-precedence enabled theme. - ;; Make that remain true. (This has the effect of making user settings - ;; override the ones just loaded, too.) + ;; Make that remain true. (This has the effect of making user + ;; settings override the ones just loaded, too.) (let ((custom-enabling-themes t)) (enable-theme 'user)))) +(defvar safe-functions) ; From unsafep.el + (defun load-theme (theme &optional no-enable) "Load a theme's settings from its file. Normally, this also enables the theme; use `disable-theme' to @@ -1108,40 +1128,39 @@ the theme." (put theme 'theme-feature nil) (put theme 'theme-documentation nil)) (let ((fn (locate-file (concat (symbol-name theme) "-theme.el") - (cons custom-theme-directory load-path) + (custom-theme--load-path) '("" "c")))) (unless fn (error "Unable to find theme file for `%s'." theme)) ;; Instead of simply loading the theme file, read it manually. (with-temp-buffer (insert-file-contents fn) + (require 'unsafep) (let ((custom--inhibit-theme-enable no-enable) - sexp scar) - (while (setq sexp (let ((read-circle nil)) + (safe-functions (append '(custom-theme-set-variables + custom-theme-set-faces) + safe-functions)) + form scar) + (while (setq form (let ((read-circle nil)) (condition-case nil (read (current-buffer)) (end-of-file nil)))) - ;; Perform some checks on each sexp before evaluating it. (cond - ((not (listp sexp))) - ((eq (setq scar (car sexp)) 'deftheme) - (unless (eq (cadr sexp) theme) + ;; Check `deftheme' expressions. + ((eq (setq scar (car form)) 'deftheme) + (unless (eq (cadr form) theme) (error "Incorrect theme name in `deftheme'")) - (and (symbolp (nth 1 sexp)) - (stringp (nth 2 sexp)) - (eval (list scar (nth 1 sexp) (nth 2 sexp))))) - ((or (eq scar 'custom-theme-set-variables) - (eq scar 'custom-theme-set-faces)) - (unless (equal (nth 1 sexp) `(quote ,theme)) - (error "Incorrect theme name in theme settings")) - (dolist (entry (cddr sexp)) - (unless (eq (car-safe entry) 'quote) - (error "Unsafe expression in theme settings"))) - (eval sexp)) + (and (symbolp (nth 1 form)) + (stringp (nth 2 form)) + (eval (list scar (nth 1 form) (nth 2 form))))) + ;; Check `provide-theme' expressions. ((and (eq scar 'provide-theme) - (equal (cadr sexp) `(quote ,theme)) - (= (length sexp) 2)) - (eval sexp)))))))) + (equal (cadr form) `(quote ,theme)) + (= (length form) 2)) + (eval form)) + ;; All other expressions need to be safe. + ((not (unsafep form)) + (eval form)))))))) (defun custom-theme-name-valid-p (name) "Return t if NAME is a valid name for a Custom theme, nil otherwise. @@ -1149,28 +1168,34 @@ NAME should be a symbol." (and (symbolp name) name (not (or (zerop (length (symbol-name name))) - ;; There's a third-party package named color-theme.el. - ;; Don't treat that as a theme. - (eq name 'color) - (eq name 'cus) (eq name 'user) (eq name 'changed))))) (defun custom-available-themes () "Return a list of available Custom themes (symbols)." - (let* ((load-path (if (file-directory-p custom-theme-directory) - (cons custom-theme-directory load-path) - load-path)) - sym themes) - (dolist (dir load-path) - (dolist (file (file-expand-wildcards - (expand-file-name "*-theme.el" dir) t)) - (setq file (file-name-nondirectory file)) - (and (string-match "\\`\\(.+\\)-theme.el\\'" file) - (setq sym (intern (match-string 1 file))) - (custom-theme-name-valid-p sym) - (push sym themes)))) + (let* (sym themes) + (dolist (dir (custom-theme--load-path)) + (when (file-directory-p dir) + (dolist (file (file-expand-wildcards + (expand-file-name "*-theme.el" dir) t)) + (setq file (file-name-nondirectory file)) + (and (string-match "\\`\\(.+\\)-theme.el\\'" file) + (setq sym (intern (match-string 1 file))) + (custom-theme-name-valid-p sym) + (push sym themes))))) (delete-dups themes))) + +(defun custom-theme--load-path () + (let (lpath) + (dolist (f custom-theme-load-path) + (cond ((eq f 'custom-theme-directory) + (setq f custom-theme-directory)) + ((eq f t) + (setq f (expand-file-name "themes" data-directory)))) + (if (file-directory-p f) + (push f lpath))) + (nreverse lpath))) + ;;; Enabling and disabling loaded themes. @@ -1212,7 +1237,8 @@ This does not include the `user' theme, which is set by Customize, and always takes precedence over other Custom Themes." :group 'customize :type '(repeat symbol) - :set-after '(custom-theme-directory) ; so we can find the themes + :set-after '(custom-theme-directory custom-theme-load-path) + :risky t :set (lambda (symbol themes) ;; Avoid an infinite loop when custom-enabled-themes is ;; defined in a theme (e.g. `user'). Enabling the theme sets diff --git a/lisp/dframe.el b/lisp/dframe.el index 2e550d8dd78..9ca0a260f6d 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -1,7 +1,8 @@ ;;; dframe --- dedicate frame support modes -;;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: file, tags, tools @@ -784,8 +785,8 @@ Must be bound to EVENT." (popup-mode-menu event) (goto-char (event-closest-point event)) (beginning-of-line) - (forward-char (min 5 (- (save-excursion (end-of-line) (point)) - (save-excursion (beginning-of-line) (point))))) + (forward-char (min 5 (- (line-end-position) + (line-beginning-position)))) (popup-mode-menu)) ;; Wait for menu to bail out. `popup-mode-menu' (and other popup ;; menu functions) return immediately. @@ -991,5 +992,4 @@ mode-line. This is only useful for non-XEmacs." (provide 'dframe) -;; arch-tag: df9b91b6-e85e-4a76-a02e-b3cb5b686bd4 ;;; dframe.el ends here diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index f4b79414c6a..764d13f5a9c 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -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 @@ can be produced by `dired-get-marked-files', for example." (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 @@ command with a prefix argument (the value does not matter)." (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 @@ See Info node `(emacs)Subdir switches' for more details." ;; 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 @@ See Info node `(emacs)Subdir switches' for more details." (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 @@ See Info node `(emacs)Subdir switches' for more details." (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 @@ See Info node `(emacs)Subdir switches' for more details." (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 @@ true then the type of the file linked to by FILE is printed instead." ;; generated-autoload-file: "dired.el" ;; End: -;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60 ;;; dired-aux.el ends here diff --git a/lisp/dired.el b/lisp/dired.el index f840b60ab07..8012fcb472d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -73,15 +73,18 @@ If nil, `dired-listing-switches' is used.") ;;;###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" "/etc/chown"))) "Name of chown command (usually `chown' or `/etc/chown').") -(defvar dired-use-ls-dired (not (not (string-match "gnu" system-configuration))) - "Non-nil means Dired should use `ls --dired'.") +(defvar dired-use-ls-dired 'unspecified + "Non-nil means Dired should use \"ls --dired\". +The special value of `unspecified' means to check explicitly, and +save the result in this variable. This is performed the first +time `dired-insert-directory' is called.") (defvar dired-chmod-program "chmod" "Name of chmod command (usually `chmod').") @@ -1057,7 +1060,14 @@ If HDR is non-nil, insert a header line with the directory name." (let ((opoint (point)) (process-environment (copy-sequence process-environment)) end) - (if (or dired-use-ls-dired (file-remote-p dir)) + (if (or (if (eq dired-use-ls-dired 'unspecified) + ;; Check whether "ls --dired" gives exit code 0, and + ;; save the answer in `dired-use-ls-dired'. + (setq dired-use-ls-dired + (eq (call-process insert-directory-program nil nil nil "--dired") + 0)) + dired-use-ls-dired) + (file-remote-p dir)) (setq switches (concat "--dired " switches))) ;; We used to specify the C locale here, to force English month names; ;; but this should not be necessary any more, @@ -2011,6 +2021,14 @@ Otherwise, an error occurs in these cases." ;; with quotation marks in their names. (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file) (setq file (replace-match "\\\"" nil t file 1))) + + (when (eq system-type 'windows-nt) + (save-match-data + (let ((start 0)) + (while (string-match "\\\\" file start) + (aset file (match-beginning 0) ?/) + (setq start (match-end 0)))))) + (setq file (read (concat "\"" file "\""))) ;; The above `read' will return a unibyte string if FILE ;; contains eight-bit-control/graphic characters. @@ -2138,7 +2156,7 @@ Return the position of the beginning of the filename, or nil if none found." ;; case-fold-search is nil now, so we can test for capital F: (setq used-F (string-match "F" dired-actual-switches) opoint (point) - eol (save-excursion (end-of-line) (point)) + eol (line-end-position) hidden (and selective-display (save-excursion (search-forward "\r" eol t)))) (if hidden @@ -3539,7 +3557,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; 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" "\ @@ -4030,5 +4048,4 @@ For absolute symlinks, use \\[dired-do-symlink]. (run-hooks 'dired-load-hook) ; for your customizations -;; arch-tag: e1af7a8f-691c-41a0-aac1-ddd4d3c87517 ;;; dired.el ends here diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 4e29c51fa75..7a43459f536 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -144,7 +144,7 @@ be on a single line." :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 @@ be on a single line." :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 @@ function `dirtrack-debug-mode' to turn on debugging output." (provide 'dirtrack) -;; arch-tag: 168de071-be88-4937-aff6-2aba9f328d5a ;;; dirtrack.el ends here diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 6e307d1ab86..6b462a22d1f 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -1,7 +1,7 @@ ;;; ebuff-menu.el --- electric-buffer-list mode -;; Copyright (C) 1985, 1986, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1994, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Richard Mlynarik <mly@ai.mit.edu> ;; Maintainer: FSF @@ -282,11 +282,10 @@ Return to Electric Buffer Menu when done." (make-local-variable 'electric-buffer-overlay) (setq electric-buffer-overlay (make-overlay (point) (point))))) (move-overlay electric-buffer-overlay - (save-excursion (beginning-of-line) (point)) - (save-excursion (end-of-line) (point))) + (line-beginning-position) + (line-end-position)) (overlay-put electric-buffer-overlay 'face 'highlight))) (provide 'ebuff-menu) -;; arch-tag: 1d4509b3-eece-4d4f-95ea-77c83eaf0275 ;;; ebuff-menu.el ends here diff --git a/lisp/electric.el b/lisp/electric.el index 8e9d23be231..3ffd94d7e12 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -176,8 +176,26 @@ "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 +;; should usually set this variable by adding elements to the default +;; value, which only works well if the variable is preloaded. +;;;###autoload (defvar electric-indent-chars '(?\n) "Characters that should cause automatic reindentation.") @@ -189,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 (< (1- pos) (line-beginning-position)) + (let ((before (copy-marker (1- pos) t))) + (save-excursion + (unless (memq indent-line-function + '(indent-relative indent-relative-maybe)) + ;; Don't reindent the previous line if the indentation function + ;; is not a real one. + (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 @@ -229,10 +247,25 @@ (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. +(defcustom electric-pair-pairs + '((?\" . ?\")) + "Alist of pairs that should be used regardless of major mode." + :type '(repeat (cons character character))) + (defcustom electric-pair-skip-self t "If non-nil, skip char instead of inserting a second closing paren. When inserting a closing paren character right before the same character, @@ -243,13 +276,18 @@ This can be convenient for people who find it easier to hit ) than C-f." (defun electric-pair-post-self-insert-function () (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check. - (char-syntax last-command-event))) + (let ((x (assq last-command-event electric-pair-pairs))) + (cond + (x (if (eq (car x) (cdr x)) ?\" ?\()) + ((rassq last-command-event electric-pair-pairs) ?\)) + (t (char-syntax last-command-event)))))) ;; FIXME: when inserting the closer, we should maybe use ;; self-insert-command, although it may prove tricky running ;; post-self-insert-hook recursively, and we wouldn't want to trigger ;; blink-matching-open. (closer (if (eq syntax ?\() - (cdr (aref (syntax-table) last-command-event)) + (cdr (or (assq last-command-event electric-pair-pairs) + (aref (syntax-table) last-command-event))) last-command-event))) (cond ;; Wrap a pair around the active region. @@ -298,7 +336,51 @@ This can be convenient for people who find it easier to hit ) than C-f." #'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)) (skip-chars-backward " \t") + (unless (bolp) (insert "\n"))) + (after (insert "\n")) ; FIXME: check eolp before inserting \n? + (around (save-excursion + (goto-char (1- pos)) (skip-chars-backward " \t") + (unless (bolp) (insert "\n"))) + (insert "\n"))) ; FIXME: check eolp before inserting \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 diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 248a2cf1312..ae490550021 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -268,6 +268,7 @@ listed.") "CODINGS" "CHARSETS" "calc/INSTALL" "calc/Makefile" "vms-pp.trans" "_emacs" "batcomp.com" "notes/cpp" ; admin/ + "emacsver.texi.in" ;; MH-E stuff not in Emacs: "import-emacs" "release-utils" ;; Erc stuff not in Emacs: @@ -507,10 +508,11 @@ Changes to files in this list are not listed.") "ymakefile" "permute-index" "index.perm" "ibmrs6000.inp" - "b2m.c" + "b2m.c" "b2m.1" "b2m.pl" + "emacs.bash" "emacs.csh" "ms-kermit" "emacs.ico" "emacs21.ico" - "LPF" "LEDIT" "OTHER.EMACSES" + "BABYL" "LPF" "LEDIT" "OTHER.EMACSES" "emacs16_mac.png" "emacs24_mac.png" "emacs256_mac.png" "emacs32_mac.png" "emacs48_mac.png" "emacs512_mac.png" @@ -585,12 +587,15 @@ in the repository.") ("schema/docbook-soextbl.rnc" . "schema/docbk-soextbl.rn" ) ("texi/url.txi" . "url.texi") ("edt-user.doc" . "edt.texi") + ("DEV-NOTES" . "nextstep") ;; Moved to different directories. ("ctags.1" . "ctags.1") ("etags.1" . "etags.1") ("emacs.1" . "emacs.1") ("emacsclient.1" . "emacsclient.1") ("icons/emacs21.ico" . "emacs21.ico") + ;; Moved from admin/nt/ to nt/. + ("nt/README.W32" . "README.W32") ) "Alist of files which have been renamed during their lifetime. Elements are (OLDNAME . NEWNAME).") diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 30c384aff91..4dd1a118ebd 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -575,8 +575,8 @@ removes any prior now out-of-date autoload entries." (autoload-ensure-default-file (autoload-generated-file))) ;; This is to make generated-autoload-file have Unix EOLs, so ;; that it is portable to all platforms. - (unless (zerop (coding-system-eol-type buffer-file-coding-system)) - (set-buffer-file-coding-system 'unix)) + (or (eq 0 (coding-system-eol-type buffer-file-coding-system)) + (set-buffer-file-coding-system 'unix)) (or (> (buffer-size) 0) (error "Autoloads file %s lacks boilerplate" buffer-file-name)) (or (file-writable-p buffer-file-name) @@ -778,16 +778,17 @@ Calls `update-directory-autoloads' on the command line arguments." (with-temp-buffer (insert-file-contents mfile) (when (re-search-forward "^shortlisp= " nil t) - (setq lim (line-end-position)) - (while (re-search-forward "\\.\\./lisp/\\([^ ]+\\.el\\)c?\\>" - lim t) + (while (and (not lim) + (re-search-forward "\\.\\./lisp/\\([^ ]+\\.el\\)c?\\>" + nil t)) (push (expand-file-name (match-string 1) ldir) - autoload-excludes)))))))) + autoload-excludes) + (skip-chars-forward " \t") + (if (eolp) (setq lim t))))))))) (let ((args command-line-args-left)) (setq command-line-args-left nil) (apply 'update-directory-autoloads args))) (provide 'autoload) -;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6 ;;; autoload.el ends here diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4a073a8e2e9..24b762c9cb7 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1317,36 +1317,39 @@ "Don't call this!" ;; fetch and return the offset for the current opcode. ;; return nil if this opcode has no offset - ;; OP, PTR and BYTES are used and set dynamically - (defvar op) - (defvar ptr) - (defvar bytes) - (cond ((< op byte-nth) - (let ((tem (logand op 7))) - (setq op (logand op 248)) + ;; Used and set dynamically in byte-decompile-bytecode-1. + (defvar bytedecomp-op) + (defvar bytedecomp-ptr) + (defvar bytedecomp-bytes) + (cond ((< bytedecomp-op byte-nth) + (let ((tem (logand bytedecomp-op 7))) + (setq bytedecomp-op (logand bytedecomp-op 248)) (cond ((eq tem 6) - (setq ptr (1+ ptr)) ;offset in next byte - (aref bytes ptr)) + ;; Offset in next byte. + (setq bytedecomp-ptr (1+ bytedecomp-ptr)) + (aref bytedecomp-bytes bytedecomp-ptr)) ((eq tem 7) - (setq ptr (1+ ptr)) ;offset in next 2 bytes - (+ (aref bytes ptr) - (progn (setq ptr (1+ ptr)) - (lsh (aref bytes ptr) 8)))) + ;; Offset in next 2 bytes. + (setq bytedecomp-ptr (1+ bytedecomp-ptr)) + (+ (aref bytedecomp-bytes bytedecomp-ptr) + (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) + (lsh (aref bytedecomp-bytes bytedecomp-ptr) 8)))) (t tem)))) ;offset was in opcode - ((>= op byte-constant) - (prog1 (- op byte-constant) ;offset in opcode - (setq op byte-constant))) - ((or (and (>= op byte-constant2) - (<= op byte-goto-if-not-nil-else-pop)) - (= op byte-stack-set2)) - (setq ptr (1+ ptr)) ;offset in next 2 bytes - (+ (aref bytes ptr) - (progn (setq ptr (1+ ptr)) - (lsh (aref bytes ptr) 8)))) - ((and (>= op byte-listN) - (<= op byte-discardN)) - (setq ptr (1+ ptr)) ;offset in next byte - (aref bytes ptr)))) + ((>= bytedecomp-op byte-constant) + (prog1 (- bytedecomp-op byte-constant) ;offset in opcode + (setq bytedecomp-op byte-constant))) + ((or (and (>= bytedecomp-op byte-constant2) + (<= bytedecomp-op byte-goto-if-not-nil-else-pop)) + (= bytedecomp-op byte-stack-set2)) + ;; Offset in next 2 bytes. + (setq bytedecomp-ptr (1+ bytedecomp-ptr)) + (+ (aref bytedecomp-bytes bytedecomp-ptr) + (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) + (lsh (aref bytedecomp-bytes bytedecomp-ptr) 8)))) + ((and (>= bytedecomp-op byte-listN) + (<= bytedecomp-op byte-discardN)) + (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;offset in next byte + (aref bytedecomp-bytes bytedecomp-ptr)))) ;; This de-compiler is used for inline expansion of compiled functions, @@ -1369,19 +1372,20 @@ ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler. ;; In that case, we put a pc value into the list ;; before each insn (or its label). -(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) - (let ((length (length bytes)) - (ptr 0) optr tags op offset +(defun byte-decompile-bytecode-1 (bytedecomp-bytes constvec + &optional make-spliceable) + (let ((length (length bytedecomp-bytes)) + (bytedecomp-ptr 0) optr tags bytedecomp-op offset lap tmp endtag) - (while (not (= ptr length)) + (while (not (= bytedecomp-ptr length)) (or make-spliceable - (setq lap (cons ptr lap))) - (setq op (aref bytes ptr) - optr ptr + (setq lap (cons bytedecomp-ptr lap))) + (setq bytedecomp-op (aref bytedecomp-bytes bytedecomp-ptr) + optr bytedecomp-ptr offset (disassemble-offset)) ; this does dynamic-scope magic - (setq op (aref byte-code-vector op)) - (cond ((memq op byte-goto-ops) + (setq bytedecomp-op (aref byte-code-vector bytedecomp-op)) + (cond ((memq bytedecomp-op byte-goto-ops) ;; it's a pc (setq offset (cdr (or (assq offset tags) @@ -1389,36 +1393,37 @@ (cons (cons offset (byte-compile-make-tag)) tags))))))) - ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t) - ((memq op byte-constref-ops))) + ((cond ((eq bytedecomp-op 'byte-constant2) + (setq bytedecomp-op 'byte-constant) t) + ((memq bytedecomp-op byte-constref-ops))) (setq tmp (if (>= offset (length constvec)) (list 'out-of-range offset) (aref constvec offset)) - offset (if (eq op 'byte-constant) + offset (if (eq bytedecomp-op 'byte-constant) (byte-compile-get-constant tmp) (or (assq tmp byte-compile-variables) (car (setq byte-compile-variables (cons (list tmp) byte-compile-variables))))))) ((and make-spliceable - (eq op 'byte-return)) - (if (= ptr (1- length)) - (setq op nil) + (eq bytedecomp-op 'byte-return)) + (if (= bytedecomp-ptr (1- length)) + (setq bytedecomp-op nil) (setq offset (or endtag (setq endtag (byte-compile-make-tag))) - op 'byte-goto))) - ((eq op 'byte-stack-set2) - (setq op 'byte-stack-set)) - ((and (eq op 'byte-discardN) (>= offset #x80)) + bytedecomp-op 'byte-goto))) + ((eq bytedecomp-op 'byte-stack-set2) + (setq bytedecomp-op 'byte-stack-set)) + ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80)) ;; The top bit of the operand for byte-discardN is a flag, ;; saying whether the top-of-stack is preserved. In ;; lapcode, we represent this by using a different opcode ;; (with the flag removed from the operand). - (setq op 'byte-discardN-preserve-tos) + (setq bytedecomp-op 'byte-discardN-preserve-tos) (setq offset (- offset #x80)))) ;; lap = ( [ (pc . (op . arg)) ]* ) - (setq lap (cons (cons optr (cons op (or offset 0))) + (setq lap (cons (cons optr (cons bytedecomp-op (or offset 0))) lap)) - (setq ptr (1+ ptr))) + (setq bytedecomp-ptr (1+ bytedecomp-ptr))) ;; take off the dummy nil op that we replaced a trailing "return" with. (let ((rest lap)) (while rest @@ -2211,5 +2216,4 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." byte-optimize-lapcode)))) nil) -;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1 ;;; byte-opt.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5e975174f01..90fcf7fb8a6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -37,6 +37,7 @@ ;; ======================================================================== ;; Entry points: ;; byte-recompile-directory, byte-compile-file, +;; byte-recompile-file, ;; batch-byte-compile, batch-byte-recompile-directory, ;; byte-compile, compile-defun, ;; display-call-tree @@ -290,10 +291,14 @@ This option is enabled by default because it reduces Emacs memory usage." :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) @@ -339,21 +344,12 @@ suppress. For example, (not mapcar) will suppress warnings about mapcar." (set :menu-tag "Some" ,@(mapcar (lambda (x) `(const ,x)) byte-compile-warning-types)))) -;;;###autoload(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p) ;;;###autoload -(defun byte-compile-warnings-safe-p (x) - "Return non-nil if X is valid as a value of `byte-compile-warnings'." - (or (booleanp x) - (and (listp x) - (if (eq (car x) 'not) (setq x (cdr x)) - t) - (equal (mapcar - (lambda (e) - (when (memq e byte-compile-warning-types) - e)) - x) - x)))) +(put 'byte-compile-warnings 'safe-local-variable + (lambda (v) + (or (symbolp v) + (null (delq nil (mapcar (lambda (x) (not (symbolp x))) v)))))) (defun byte-compile-warning-enabled-p (warning) "Return non-nil if WARNING is enabled, according to `byte-compile-warnings'." @@ -1002,7 +998,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;; 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) @@ -1110,13 +1106,13 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;; (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 @@ -1147,14 +1143,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (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." @@ -1570,7 +1566,7 @@ symbol itself." (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) @@ -1632,7 +1628,7 @@ that already has a `.elc' file." 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) @@ -1669,23 +1665,10 @@ that already has a `.elc' file." (not (auto-save-file-name-p bytecomp-source)) (not (string-equal dir-locals-file (file-name-nondirectory - bytecomp-source))) - (setq bytecomp-dest - (byte-compile-dest-file bytecomp-source)) - (if (file-exists-p bytecomp-dest) - ;; File was already compiled. - (or bytecomp-force - (file-newer-than-file-p bytecomp-source - bytecomp-dest)) - ;; No compiled file exists yet. - (and bytecomp-arg - (or (eq 0 bytecomp-arg) - (y-or-n-p (concat "Compile " - bytecomp-source "? ")))))) - (progn (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." bytecomp-source)) - (let ((bytecomp-res (byte-compile-file - bytecomp-source))) + bytecomp-source)))) + (progn (let ((bytecomp-res (byte-recompile-file + bytecomp-source + bytecomp-force bytecomp-arg))) (cond ((eq bytecomp-res 'no-byte-compile) (setq skip-count (1+ skip-count))) ((eq bytecomp-res t) @@ -1713,6 +1696,60 @@ This is normally set in local file variables at the end of the elisp file: ;; Local Variables:\n;; no-byte-compile: t\n;; End: ") ;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp) +(defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load) + "Recompile BYTECOMP-FILENAME file if it needs recompilation. +This happens when its `.elc' file is older than itself. + +If the `.elc' file exists and is up-to-date, normally this +function *does not* compile BYTECOMP-FILENAME. However, if the +prefix argument BYTECOMP-FORCE is set, that means do compile +BYTECOMP-FILENAME even if the destination already exists and is +up-to-date. + +If the `.elc' file does not exist, normally this function *does +not* compile BYTECOMP-FILENAME. If BYTECOMP-ARG is 0, that means +compile the file even if it has never been compiled before. +A nonzero BYTECOMP-ARG means ask the user. + +If LOAD is set, `load' the file after compiling. + +The value returned is the value returned by `byte-compile-file', +or 'no-byte-compile if the file did not need recompilation." + (interactive + (let ((bytecomp-file buffer-file-name) + (bytecomp-file-name nil) + (bytecomp-file-dir nil)) + (and bytecomp-file + (eq (cdr (assq 'major-mode (buffer-local-variables))) + 'emacs-lisp-mode) + (setq bytecomp-file-name (file-name-nondirectory bytecomp-file) + bytecomp-file-dir (file-name-directory bytecomp-file))) + (list (read-file-name (if current-prefix-arg + "Byte compile file: " + "Byte recompile file: ") + bytecomp-file-dir bytecomp-file-name nil) + current-prefix-arg))) + (let ((bytecomp-dest + (byte-compile-dest-file bytecomp-filename)) + ;; Expand now so we get the current buffer's defaults + (bytecomp-filename (expand-file-name bytecomp-filename))) + (if (if (file-exists-p bytecomp-dest) + ;; File was already compiled + ;; Compile if forced to, or filename newer + (or bytecomp-force + (file-newer-than-file-p bytecomp-filename + bytecomp-dest)) + (and bytecomp-arg + (or (eq 0 bytecomp-arg) + (y-or-n-p (concat "Compile " + bytecomp-filename "? "))))) + (progn + (if (and noninteractive (not byte-compile-verbose)) + (message "Compiling %s..." bytecomp-filename)) + (byte-compile-file bytecomp-filename load)) + (when load (load bytecomp-filename)) + 'no-byte-compile))) + ;;;###autoload (defun byte-compile-file (bytecomp-filename &optional load) "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code. @@ -4717,5 +4754,4 @@ and corresponding effects." (run-hooks 'bytecomp-load-hook) -;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a ;;; bytecomp.el ends here diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 88da7aab3be..84bfd706afc 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -1,7 +1,7 @@ ;;; chart.el --- Draw charts (bar charts, etc) -;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 @@ -525,9 +525,9 @@ cons cells of the form (NAME . NUM). See `sort' for more details." (defun chart-zap-chars (n) "Zap up to N chars without deleting EOLs." (if (not (eobp)) - (if (< n (- (save-excursion (end-of-line) (point)) (point))) + (if (< n (- (point-at-eol) (point))) (delete-char n) - (delete-region (point) (save-excursion (end-of-line) (point)))))) + (delete-region (point) (point-at-eol))))) (defun chart-display-label (label dir zone start end &optional face) "Display LABEL in direction DIR in column/row ZONE between START and END. @@ -746,5 +746,4 @@ SORT-PRED if desired." (provide 'chart) -;; arch-tag: 43847e44-5b45-465e-adc9-e505490a6b59 ;;; chart.el ends here diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 9acad6e67cb..0a3b3c94ff6 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -201,9 +201,9 @@ without asking, and complex changes are made by asking the user first. 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 @@ system. Possible values are: 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 @@ and experimental check. Do not modify this list without setting 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 @@ CHECK is a list of four strings stating the current status of each 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 @@ style." (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 @@ style." (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 @@ assumes that the cursor is already positioned to perform the fix." "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 @@ if there is one." (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 @@ Optional argument INTERACT permits more interactive fixing." (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 @@ generating a buffered list of errors." ;; 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? @@ -1366,7 +1362,7 @@ See the style guide in the Emacs Lisp manual for more details." (setq checkdoc-autofix-flag 'never)))) (checkdoc-create-error "You should convert this comment to documentation" - (point) (save-excursion (end-of-line) (point)))) + (point) (line-end-position))) (checkdoc-create-error (if (nth 2 fp) "All interactive functions should have documentation" @@ -1374,12 +1370,8 @@ See the style guide in the Emacs Lisp manual for more details." 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) @@ -1388,7 +1380,7 @@ Depends on `checkdoc-this-string-valid' to reset the syntax table so that regexp short cuts work. FP is the function defun information." (let ((case-fold-search nil) ;; Use a marker so if an early check modifies the text, - ;; we won't accidentally loose our place. This could cause + ;; we won't accidentally lose our place. This could cause ;; end-of doc string whitespace to also delete the " char. (s (point)) (e (if (looking-at "\"") @@ -1486,12 +1478,10 @@ regexp short cuts work. FP is the function defun information." "First line not a complete sentence. Add RET here? " "\n" t) (let (l1 l2) - (forward-line 1) - (end-of-line) + (end-of-line 2) (setq l1 (current-column) l2 (save-excursion - (forward-line 1) - (end-of-line) + (end-of-line 2) (current-column))) (if (> (+ l1 l2 1) 80) (setq msg "Incomplete auto-fix; doc string \ @@ -1508,10 +1498,7 @@ may require more formatting") (forward-line 1) (beginning-of-line) (if (and (re-search-forward "[.!?:\"]\\([ \t\n]+\\|\"\\)" - (save-excursion - (end-of-line) - (point)) - t) + (line-end-position) t) (< (current-column) numc)) (if (checkdoc-autofix-ask-replace p (1+ p) @@ -1526,9 +1513,7 @@ may require more formatting") (if msg (checkdoc-create-error msg s (save-excursion (goto-char s) - (end-of-line) - (point))) - nil) )))) + (line-end-position)))))))) ;; Continuation of above. Make sure our sentence is capitalized. (save-excursion (skip-chars-forward "\"\\*") @@ -1628,7 +1613,7 @@ function,command,variable,option or symbol." ms1)))))) (if (and (< (point) e) (> (current-column) 80)) (checkdoc-create-error "Some lines are over 80 columns wide" - s (save-excursion (goto-char s) (end-of-line) (point)) )))) + s (save-excursion (goto-char s) (line-end-position)))))) ;; Here we deviate to tests based on a variable or function. ;; We must do this before checking for symbols in quotes because there ;; is a chance that just such a symbol might really be an argument. @@ -1773,9 +1758,8 @@ function,command,variable,option or symbol." ms1)))))) (end-of-line) ;; check string-continuation (if (checkdoc-char= (preceding-char) ?\\) - (progn (forward-line 1) - (end-of-line))) - (point))) + (line-end-position 2) + (point)))) (rs nil) replace original (case-fold-search t)) (while (and (not rs) (re-search-forward @@ -1999,49 +1983,45 @@ internally skip over no answers. 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) @@ -2049,43 +2029,39 @@ If the offending word is in a piece of quoted text, then it is skipped." (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 @@ -2253,8 +2229,8 @@ Code:, and others referenced in the style guide." (insert ";;; " fn fe " --- " (read-string "Summary: ") "\n")) (checkdoc-create-error "The first line should be of the form: \";;; package --- Summary\"" - (point-min) (save-excursion (goto-char (point-min)) (end-of-line) - (point)))) + (point-min) (save-excursion (goto-char (point-min)) + (line-end-position)))) nil)) (setq err @@ -2665,8 +2641,7 @@ function called to create the messages." (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") @@ -2676,5 +2651,4 @@ function called to create the messages." (provide 'checkdoc) -;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26 ;;; checkdoc.el ends here diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index db2ae88b8b7..74d7432bec6 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; 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" "c10b5cbebb5267291ef15c782c0271a6") +;;;;;; gensym) "cl-macs" "cl-macs.el" "34ea402a8756c7d74d27cdcecf35e3c3") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index f6d66c64c7a..725b98354af 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -639,7 +639,7 @@ This is compatible with Common Lisp, but note that `defun' and ;;; The "loop" macro. -(defvar args) (defvar loop-accum-var) (defvar loop-accum-vars) +(defvar loop-args) (defvar loop-accum-var) (defvar loop-accum-vars) (defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps) (defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag) (defvar loop-initially) (defvar loop-map-form) (defvar loop-name) @@ -647,7 +647,7 @@ This is compatible with Common Lisp, but note that `defun' and (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) ;;;###autoload -(defmacro loop (&rest args) +(defmacro loop (&rest loop-args) "The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, @@ -662,8 +662,8 @@ Valid clauses are: finally return EXPR, named NAME. \(fn CLAUSE...)" - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args)))))) - (list 'block nil (list* 'while t args)) + (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list loop-args)))))) + (list 'block nil (list* 'while t loop-args)) (let ((loop-name nil) (loop-bindings nil) (loop-body nil) (loop-steps nil) (loop-result nil) (loop-result-explicit nil) @@ -672,8 +672,8 @@ Valid clauses are: (loop-initially nil) (loop-finally nil) (loop-map-form nil) (loop-first-flag nil) (loop-destr-temps nil) (loop-symbol-macs nil)) - (setq args (append args '(cl-end-loop))) - (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause)) + (setq loop-args (append loop-args '(cl-end-loop))) + (while (not (eq (car loop-args) 'cl-end-loop)) (cl-parse-loop-clause)) (if loop-finish-flag (push `((,loop-finish-flag t)) loop-bindings)) (if loop-first-flag @@ -713,34 +713,34 @@ Valid clauses are: (setq body (list (list* 'symbol-macrolet loop-symbol-macs body)))) (list* 'block loop-name body))))) -(defun cl-parse-loop-clause () ; uses args, loop-* - (let ((word (pop args)) +(defun cl-parse-loop-clause () ; uses loop-* + (let ((word (pop loop-args)) (hash-types '(hash-key hash-keys hash-value hash-values)) (key-types '(key-code key-codes key-seq key-seqs key-binding key-bindings))) (cond - ((null args) + ((null loop-args) (error "Malformed `loop' macro")) ((eq word 'named) - (setq loop-name (pop args))) + (setq loop-name (pop loop-args))) ((eq word 'initially) - (if (memq (car args) '(do doing)) (pop args)) - (or (consp (car args)) (error "Syntax error on `initially' clause")) - (while (consp (car args)) - (push (pop args) loop-initially))) + (if (memq (car loop-args) '(do doing)) (pop loop-args)) + (or (consp (car loop-args)) (error "Syntax error on `initially' clause")) + (while (consp (car loop-args)) + (push (pop loop-args) loop-initially))) ((eq word 'finally) - (if (eq (car args) 'return) - (setq loop-result-explicit (or (cl-pop2 args) '(quote nil))) - (if (memq (car args) '(do doing)) (pop args)) - (or (consp (car args)) (error "Syntax error on `finally' clause")) - (if (and (eq (caar args) 'return) (null loop-name)) - (setq loop-result-explicit (or (nth 1 (pop args)) '(quote nil))) - (while (consp (car args)) - (push (pop args) loop-finally))))) + (if (eq (car loop-args) 'return) + (setq loop-result-explicit (or (cl-pop2 loop-args) '(quote nil))) + (if (memq (car loop-args) '(do doing)) (pop loop-args)) + (or (consp (car loop-args)) (error "Syntax error on `finally' clause")) + (if (and (eq (caar loop-args) 'return) (null loop-name)) + (setq loop-result-explicit (or (nth 1 (pop loop-args)) '(quote nil))) + (while (consp (car loop-args)) + (push (pop loop-args) loop-finally))))) ((memq word '(for as)) (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil) @@ -749,29 +749,29 @@ Valid clauses are: ;; Use `gensym' rather than `make-symbol'. It's important that ;; (not (eq (symbol-name var1) (symbol-name var2))) because ;; these vars get added to the cl-macro-environment. - (let ((var (or (pop args) (gensym "--cl-var--")))) - (setq word (pop args)) - (if (eq word 'being) (setq word (pop args))) - (if (memq word '(the each)) (setq word (pop args))) + (let ((var (or (pop loop-args) (gensym "--cl-var--")))) + (setq word (pop loop-args)) + (if (eq word 'being) (setq word (pop loop-args))) + (if (memq word '(the each)) (setq word (pop loop-args))) (if (memq word '(buffer buffers)) - (setq word 'in args (cons '(buffer-list) args))) + (setq word 'in loop-args (cons '(buffer-list) loop-args))) (cond ((memq word '(from downfrom upfrom to downto upto above below by)) - (push word args) - (if (memq (car args) '(downto above)) + (push word loop-args) + (if (memq (car loop-args) '(downto above)) (error "Must specify `from' value for downward loop")) - (let* ((down (or (eq (car args) 'downfrom) - (memq (caddr args) '(downto above)))) - (excl (or (memq (car args) '(above below)) - (memq (caddr args) '(above below)))) - (start (and (memq (car args) '(from upfrom downfrom)) - (cl-pop2 args))) - (end (and (memq (car args) + (let* ((down (or (eq (car loop-args) 'downfrom) + (memq (caddr loop-args) '(downto above)))) + (excl (or (memq (car loop-args) '(above below)) + (memq (caddr loop-args) '(above below)))) + (start (and (memq (car loop-args) '(from upfrom downfrom)) + (cl-pop2 loop-args))) + (end (and (memq (car loop-args) '(to upto downto above below)) - (cl-pop2 args))) - (step (and (eq (car args) 'by) (cl-pop2 args))) + (cl-pop2 loop-args))) + (step (and (eq (car loop-args) 'by) (cl-pop2 loop-args))) (end-var (and (not (cl-const-expr-p end)) (make-symbol "--cl-var--"))) (step-var (and (not (cl-const-expr-p step)) @@ -794,7 +794,7 @@ Valid clauses are: (let* ((on (eq word 'on)) (temp (if (and on (symbolp var)) var (make-symbol "--cl-var--")))) - (push (list temp (pop args)) loop-for-bindings) + (push (list temp (pop loop-args)) loop-for-bindings) (push (list 'consp temp) loop-body) (if (eq word 'in-ref) (push (list var (list 'car temp)) loop-symbol-macs) @@ -804,8 +804,8 @@ Valid clauses are: (push (list var (if on temp (list 'car temp))) loop-for-sets)))) (push (list temp - (if (eq (car args) 'by) - (let ((step (cl-pop2 args))) + (if (eq (car loop-args) 'by) + (let ((step (cl-pop2 loop-args))) (if (and (memq (car-safe step) '(quote function function*)) @@ -816,10 +816,10 @@ Valid clauses are: loop-for-steps))) ((eq word '=) - (let* ((start (pop args)) - (then (if (eq (car args) 'then) (cl-pop2 args) start))) + (let* ((start (pop loop-args)) + (then (if (eq (car loop-args) 'then) (cl-pop2 loop-args) start))) (push (list var nil) loop-for-bindings) - (if (or ands (eq (car args) 'and)) + (if (or ands (eq (car loop-args) 'and)) (progn (push `(,var (if ,(or loop-first-flag @@ -839,7 +839,7 @@ Valid clauses are: ((memq word '(across across-ref)) (let ((temp-vec (make-symbol "--cl-vec--")) (temp-idx (make-symbol "--cl-idx--"))) - (push (list temp-vec (pop args)) loop-for-bindings) + (push (list temp-vec (pop loop-args)) loop-for-bindings) (push (list temp-idx -1) loop-for-bindings) (push (list '< (list 'setq temp-idx (list '1+ temp-idx)) (list 'length temp-vec)) loop-body) @@ -851,15 +851,15 @@ Valid clauses are: loop-for-sets)))) ((memq word '(element elements)) - (let ((ref (or (memq (car args) '(in-ref of-ref)) - (and (not (memq (car args) '(in of))) + (let ((ref (or (memq (car loop-args) '(in-ref of-ref)) + (and (not (memq (car loop-args) '(in of))) (error "Expected `of'")))) - (seq (cl-pop2 args)) + (seq (cl-pop2 loop-args)) (temp-seq (make-symbol "--cl-seq--")) - (temp-idx (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) - (eq (caadr args) 'index)) - (cadr (cl-pop2 args)) + (temp-idx (if (eq (car loop-args) 'using) + (if (and (= (length (cadr loop-args)) 2) + (eq (caadr loop-args) 'index)) + (cadr (cl-pop2 loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-idx--")))) (push (list temp-seq seq) loop-for-bindings) @@ -885,13 +885,13 @@ Valid clauses are: loop-for-steps))) ((memq word hash-types) - (or (memq (car args) '(in of)) (error "Expected `of'")) - (let* ((table (cl-pop2 args)) - (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) - (memq (caadr args) hash-types) - (not (eq (caadr args) word))) - (cadr (cl-pop2 args)) + (or (memq (car loop-args) '(in of)) (error "Expected `of'")) + (let* ((table (cl-pop2 loop-args)) + (other (if (eq (car loop-args) 'using) + (if (and (= (length (cadr loop-args)) 2) + (memq (caadr loop-args) hash-types) + (not (eq (caadr loop-args) word))) + (cadr (cl-pop2 loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) (if (memq word '(hash-value hash-values)) @@ -901,16 +901,16 @@ Valid clauses are: ((memq word '(symbol present-symbol external-symbol symbols present-symbols external-symbols)) - (let ((ob (and (memq (car args) '(in of)) (cl-pop2 args)))) + (let ((ob (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args)))) (setq loop-map-form `(mapatoms (lambda (,var) . --cl-map) ,ob)))) ((memq word '(overlay overlays extent extents)) (let ((buf nil) (from nil) (to nil)) - (while (memq (car args) '(in of from to)) - (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) - ((eq (car args) 'to) (setq to (cl-pop2 args))) - (t (setq buf (cl-pop2 args))))) + (while (memq (car loop-args) '(in of from to)) + (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args))) + ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args))) + (t (setq buf (cl-pop2 loop-args))))) (setq loop-map-form `(cl-map-extents (lambda (,var ,(make-symbol "--cl-var--")) @@ -921,12 +921,12 @@ Valid clauses are: (let ((buf nil) (prop nil) (from nil) (to nil) (var1 (make-symbol "--cl-var1--")) (var2 (make-symbol "--cl-var2--"))) - (while (memq (car args) '(in of property from to)) - (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) - ((eq (car args) 'to) (setq to (cl-pop2 args))) - ((eq (car args) 'property) - (setq prop (cl-pop2 args))) - (t (setq buf (cl-pop2 args))))) + (while (memq (car loop-args) '(in of property from to)) + (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args))) + ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args))) + ((eq (car loop-args) 'property) + (setq prop (cl-pop2 loop-args))) + (t (setq buf (cl-pop2 loop-args))))) (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) (setq var1 (car var) var2 (cdr var)) (push (list var (list 'cons var1 var2)) loop-for-sets)) @@ -936,13 +936,13 @@ Valid clauses are: ,buf ,prop ,from ,to)))) ((memq word key-types) - (or (memq (car args) '(in of)) (error "Expected `of'")) - (let ((map (cl-pop2 args)) - (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) - (memq (caadr args) key-types) - (not (eq (caadr args) word))) - (cadr (cl-pop2 args)) + (or (memq (car loop-args) '(in of)) (error "Expected `of'")) + (let ((map (cl-pop2 loop-args)) + (other (if (eq (car loop-args) 'using) + (if (and (= (length (cadr loop-args)) 2) + (memq (caadr loop-args) key-types) + (not (eq (caadr loop-args) word))) + (cadr (cl-pop2 loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) (if (memq word '(key-binding key-bindings)) @@ -964,17 +964,26 @@ Valid clauses are: loop-for-steps))) ((memq word '(window windows)) - (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) - (temp (make-symbol "--cl-var--"))) + (let ((scr (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args))) + (temp (make-symbol "--cl-var--")) + (minip (make-symbol "--cl-minip--"))) (push (list var (if scr (list 'frame-selected-window scr) '(selected-window))) loop-for-bindings) + ;; If we started in the minibuffer, we need to + ;; ensure that next-window will bring us back there + ;; at some point. (Bug#7492). + ;; (Consider using walk-windows instead of loop if + ;; you care about such things.) + (push (list minip `(minibufferp (window-buffer ,var))) + loop-for-bindings) (push (list temp nil) loop-for-bindings) (push (list 'prog1 (list 'not (list 'eq var temp)) (list 'or temp (list 'setq temp var))) loop-body) - (push (list var (list 'next-window var)) loop-for-steps))) + (push (list var (list 'next-window var minip)) + loop-for-steps))) (t (let ((handler (and (symbolp word) @@ -982,9 +991,9 @@ Valid clauses are: (if handler (funcall handler var) (error "Expected a `for' preposition, found %s" word))))) - (eq (car args) 'and)) + (eq (car loop-args) 'and)) (setq ands t) - (pop args)) + (pop loop-args)) (if (and ands loop-for-bindings) (push (nreverse loop-for-bindings) loop-bindings) (setq loop-bindings (nconc (mapcar 'list loop-for-bindings) @@ -1000,11 +1009,11 @@ Valid clauses are: ((eq word 'repeat) (let ((temp (make-symbol "--cl-var--"))) - (push (list (list temp (pop args))) loop-bindings) + (push (list (list temp (pop loop-args))) loop-bindings) (push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body))) ((memq word '(collect collecting)) - (let ((what (pop args)) + (let ((what (pop loop-args)) (var (cl-loop-handle-accum nil 'nreverse))) (if (eq var loop-accum-var) (push (list 'progn (list 'push what var) t) loop-body) @@ -1013,7 +1022,7 @@ Valid clauses are: t) loop-body)))) ((memq word '(nconc nconcing append appending)) - (let ((what (pop args)) + (let ((what (pop loop-args)) (var (cl-loop-handle-accum nil 'nreverse))) (push (list 'progn (list 'setq var @@ -1028,27 +1037,27 @@ Valid clauses are: var what))) t) loop-body))) ((memq word '(concat concating)) - (let ((what (pop args)) + (let ((what (pop loop-args)) (var (cl-loop-handle-accum ""))) (push (list 'progn (list 'callf 'concat var what) t) loop-body))) ((memq word '(vconcat vconcating)) - (let ((what (pop args)) + (let ((what (pop loop-args)) (var (cl-loop-handle-accum []))) (push (list 'progn (list 'callf 'vconcat var what) t) loop-body))) ((memq word '(sum summing)) - (let ((what (pop args)) + (let ((what (pop loop-args)) (var (cl-loop-handle-accum 0))) (push (list 'progn (list 'incf var what) t) loop-body))) ((memq word '(count counting)) - (let ((what (pop args)) + (let ((what (pop loop-args)) (var (cl-loop-handle-accum 0))) (push (list 'progn (list 'if what (list 'incf var)) t) loop-body))) ((memq word '(minimize minimizing maximize maximizing)) - (let* ((what (pop args)) + (let* ((what (pop loop-args)) (temp (if (cl-simple-expr-p what) what (make-symbol "--cl-var--"))) (var (cl-loop-handle-accum nil)) (func (intern (substring (symbol-name word) 0 3))) @@ -1059,27 +1068,27 @@ Valid clauses are: ((eq word 'with) (let ((bindings nil)) - (while (progn (push (list (pop args) - (and (eq (car args) '=) (cl-pop2 args))) + (while (progn (push (list (pop loop-args) + (and (eq (car loop-args) '=) (cl-pop2 loop-args))) bindings) - (eq (car args) 'and)) - (pop args)) + (eq (car loop-args) 'and)) + (pop loop-args)) (push (nreverse bindings) loop-bindings))) ((eq word 'while) - (push (pop args) loop-body)) + (push (pop loop-args) loop-body)) ((eq word 'until) - (push (list 'not (pop args)) loop-body)) + (push (list 'not (pop loop-args)) loop-body)) ((eq word 'always) (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--"))) - (push (list 'setq loop-finish-flag (pop args)) loop-body) + (push (list 'setq loop-finish-flag (pop loop-args)) loop-body) (setq loop-result t)) ((eq word 'never) (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--"))) - (push (list 'setq loop-finish-flag (list 'not (pop args))) + (push (list 'setq loop-finish-flag (list 'not (pop loop-args))) loop-body) (setq loop-result t)) @@ -1087,20 +1096,20 @@ Valid clauses are: (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--"))) (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--"))) (push (list 'setq loop-finish-flag - (list 'not (list 'setq loop-result-var (pop args)))) + (list 'not (list 'setq loop-result-var (pop loop-args)))) loop-body)) ((memq word '(if when unless)) - (let* ((cond (pop args)) + (let* ((cond (pop loop-args)) (then (let ((loop-body nil)) (cl-parse-loop-clause) (cl-loop-build-ands (nreverse loop-body)))) (else (let ((loop-body nil)) - (if (eq (car args) 'else) - (progn (pop args) (cl-parse-loop-clause))) + (if (eq (car loop-args) 'else) + (progn (pop loop-args) (cl-parse-loop-clause))) (cl-loop-build-ands (nreverse loop-body)))) (simple (and (eq (car then) t) (eq (car else) t)))) - (if (eq (car args) 'end) (pop args)) + (if (eq (car loop-args) 'end) (pop loop-args)) (if (eq word 'unless) (setq then (prog1 else (setq else then)))) (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then)) (if simple (nth 1 else) (list (nth 2 else)))))) @@ -1114,22 +1123,22 @@ Valid clauses are: ((memq word '(do doing)) (let ((body nil)) - (or (consp (car args)) (error "Syntax error on `do' clause")) - (while (consp (car args)) (push (pop args) body)) + (or (consp (car loop-args)) (error "Syntax error on `do' clause")) + (while (consp (car loop-args)) (push (pop loop-args) body)) (push (cons 'progn (nreverse (cons t body))) loop-body))) ((eq word 'return) (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-var--"))) (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--"))) - (push (list 'setq loop-result-var (pop args) + (push (list 'setq loop-result-var (pop loop-args) loop-finish-flag nil) loop-body)) (t (let ((handler (and (symbolp word) (get word 'cl-loop-handler)))) (or handler (error "Expected a loop keyword, found %s" word)) (funcall handler)))) - (if (eq (car args) 'and) - (progn (pop args) (cl-parse-loop-clause))))) + (if (eq (car loop-args) 'and) + (progn (pop loop-args) (cl-parse-loop-clause))))) (defun cl-loop-let (specs body par) ; uses loop-* (let ((p specs) (temps nil) (new nil)) @@ -1165,9 +1174,9 @@ Valid clauses are: (list* (if par 'let 'let*) (nconc (nreverse temps) (nreverse new)) body)))) -(defun cl-loop-handle-accum (def &optional func) ; uses args, loop-* - (if (eq (car args) 'into) - (let ((var (cl-pop2 args))) +(defun cl-loop-handle-accum (def &optional func) ; uses loop-* + (if (eq (car loop-args) 'into) + (let ((var (cl-pop2 loop-args))) (or (memq var loop-accum-vars) (progn (push (list (list var def)) loop-bindings) (push var loop-accum-vars))) @@ -1748,15 +1757,6 @@ Example: (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)) @@ -2791,5 +2791,4 @@ surrounded by (block NAME ...). ;; generated-autoload-file: "cl-loaddefs.el" ;; End: -;; arch-tag: afd947a6-b553-4df1-bba5-000be6388f46 ;;; cl-macs.el ends here diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index e11572dfc62..9a703c96378 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -119,7 +119,8 @@ BODY contains code to execute each time the mode is enabled or disabled. of the variable MODE to store the state of the mode. PLACE can also be of the form (GET . SET) where GET is an expression that returns the current state and SET is a function that takes - a new state and sets it. + a new state and sets it. If you specify a :variable, this + function assumes it is defined elsewhere. For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" @@ -196,6 +197,7 @@ For example, you could write `(:group ',(intern (replace-regexp-in-string "-mode\\'" "" mode-name))))) + ;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode. (unless type (setq type '(:type 'boolean))) `(progn @@ -583,5 +585,4 @@ BODY is executed after moving to the destination location." (provide 'easy-mmode) -;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a ;;; easy-mmode.el ends here diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 145498b9059..77953b37021 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1,8 +1,8 @@ ;;; edebug.el --- a source-level debugger for Emacs Lisp -;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> ;; Maintainer: FSF @@ -2991,7 +2991,7 @@ MSG is printed after `::::} '." ;; Set up the overlay arrow at beginning-of-line in current buffer. ;; The arrow string is derived from edebug-arrow-alist and ;; edebug-execution-mode. - (let ((pos (save-excursion (beginning-of-line) (point)))) + (let ((pos (line-beginning-position))) (setq overlay-arrow-string (cdr (assq edebug-execution-mode edebug-arrow-alist))) (setq overlay-arrow-position (make-marker)) @@ -4454,5 +4454,4 @@ With prefix argument, make it a temporary breakpoint." (provide 'edebug) -;; arch-tag: 19c8d05c-4554-426e-ac72-e0fa1fcb0808 ;;; edebug.el ends here diff --git a/lisp/emacs-lisp/eieio-comp.el b/lisp/emacs-lisp/eieio-comp.el index 0e76f4bb331..e07a7b20d14 100644 --- a/lisp/emacs-lisp/eieio-comp.el +++ b/lisp/emacs-lisp/eieio-comp.el @@ -47,10 +47,6 @@ ;; This teaches the byte compiler how to do this sort of thing. (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) -;; Variables used free: -(defvar outbuffer) -(defvar filename) - (defun byte-compile-file-form-defmethod (form) "Mumble about the method we are compiling. This function is mostly ripped from `byte-compile-file-form-defun', @@ -83,14 +79,18 @@ that is called but rarely. Argument FORM is the body of the method." (class (if (listp arg1) (nth 1 arg1) nil)) (my-outbuffer (if (eval-when-compile (featurep 'xemacs)) byte-compile-outbuffer - (condition-case nil - bytecomp-outbuffer - (error outbuffer)))) - ) + (cond ((boundp 'bytecomp-outbuffer) + bytecomp-outbuffer) ; Emacs >= 23.2 + ((boundp 'outbuffer) outbuffer) + (t (error "Unable to set outbuffer")))))) (let ((name (format "%s::%s" (or class "#<generic>") meth))) (if byte-compile-verbose ;; #### filename used free - (message "Compiling %s... (%s)" (or filename "") name)) + (message "Compiling %s... (%s)" + (cond ((boundp 'bytecomp-filename) bytecomp-filename) + ((boundp 'filename) filename) + (t "")) + name)) (setq byte-compile-current-form name) ; for warnings ) ;; Flush any pending output @@ -139,5 +139,4 @@ Argument PARAMLIST is the parameter list to convert." (provide 'eieio-comp) -;; arch-tag: f2aacdd3-1da2-4ee9-b3e5-e8eac0832ee3 ;;; eieio-comp.el ends here diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index b9aa29decd0..39c45e82309 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -394,40 +394,41 @@ Return nil if there are no more forms, t otherwise." (parse-partial-sexp (point) (point-max) nil t) (not (eobp))) -(defvar env) ; from elint-init-env +(defvar elint-env) ; from elint-init-env (defun elint-init-form (form) - "Process FORM, adding to ENV if recognized." + "Process FORM, adding to ELINT-ENV if recognized." (cond ;; Eg nnmaildir seems to use [] as a form of comment syntax. ((not (listp form)) (elint-warning "Skipping non-list form `%s'" form)) ;; Add defined variable ((memq (car form) '(defvar defconst defcustom)) - (setq env (elint-env-add-var env (cadr form)))) + (setq elint-env (elint-env-add-var elint-env (cadr form)))) ;; Add function ((memq (car form) '(defun defsubst)) - (setq env (elint-env-add-func env (cadr form) (nth 2 form)))) + (setq elint-env (elint-env-add-func elint-env (cadr form) (nth 2 form)))) ;; FIXME needs a handler to say second arg is not a variable when we come ;; to scan the form. ((eq (car form) 'define-derived-mode) - (setq env (elint-env-add-func env (cadr form) ()) - env (elint-env-add-var env (cadr form)) - env (elint-env-add-var env (intern (format "%s-map" (cadr form)))))) + (setq elint-env (elint-env-add-func elint-env (cadr form) ()) + elint-env (elint-env-add-var elint-env (cadr form)) + elint-env (elint-env-add-var elint-env + (intern (format "%s-map" (cadr form)))))) ((eq (car form) 'define-minor-mode) - (setq env (elint-env-add-func env (cadr form) '(&optional arg)) + (setq elint-env (elint-env-add-func elint-env (cadr form) '(&optional arg)) ;; FIXME mode map? - env (elint-env-add-var env (cadr form)))) + elint-env (elint-env-add-var elint-env (cadr form)))) ((and (eq (car form) 'easy-menu-define) (cadr form)) - (setq env (elint-env-add-func env (cadr form) '(event)) - env (elint-env-add-var env (cadr form)))) + (setq elint-env (elint-env-add-func elint-env (cadr form) '(event)) + elint-env (elint-env-add-var elint-env (cadr form)))) ;; FIXME it would be nice to check the autoloads are correct. ((eq (car form) 'autoload) - (setq env (elint-env-add-func env (cadr (cadr form)) 'unknown))) + (setq elint-env (elint-env-add-func elint-env (cadr (cadr form)) 'unknown))) ((eq (car form) 'declare-function) - (setq env (elint-env-add-func - env (cadr form) + (setq elint-env (elint-env-add-func + elint-env (cadr form) (if (or (< (length form) 4) (eq (nth 3 form) t) (unless (stringp (nth 2 form)) @@ -440,14 +441,14 @@ Return nil if there are no more forms, t otherwise." ;; If the alias points to something already in the environment, ;; add the alias to the environment with the same arguments. ;; FIXME symbol-function, eg backquote.el? - (let ((def (elint-env-find-func env (cadr (nth 2 form))))) - (setq env (elint-env-add-func env (cadr (cadr form)) + (let ((def (elint-env-find-func elint-env (cadr (nth 2 form))))) + (setq elint-env (elint-env-add-func elint-env (cadr (cadr form)) (if def (cadr def) 'unknown))))) ;; Add macro, both as a macro and as a function ((eq (car form) 'defmacro) - (setq env (elint-env-add-macro env (cadr form) + (setq elint-env (elint-env-add-macro elint-env (cadr form) (cons 'lambda (cddr form))) - env (elint-env-add-func env (cadr form) (nth 2 form)))) + elint-env (elint-env-add-func elint-env (cadr form) (nth 2 form)))) ((and (eq (car form) 'put) (= 4 (length form)) (eq (car-safe (cadr form)) 'quote) @@ -471,12 +472,12 @@ Return nil if there are no more forms, t otherwise." (setq name 'cl-macs file nil elint-doing-cl t)) ; blech - (setq env (elint-add-required-env env name file)))))) - env) + (setq elint-env (elint-add-required-env elint-env name file)))))) + elint-env) (defun elint-init-env (forms) "Initialize the environment from FORMS." - (let ((env (elint-make-env)) + (let ((elint-env (elint-make-env)) form) (while forms (setq form (elint-top-form-form (car forms)) @@ -489,7 +490,7 @@ Return nil if there are no more forms, t otherwise." with-no-warnings)) (mapc 'elint-init-form (cdr form)) (elint-init-form form))) - env)) + elint-env)) (defun elint-add-required-env (env name file) "Augment ENV with the variables defined by feature NAME in FILE." @@ -1171,5 +1172,4 @@ If no documentation could be found args will be `unknown'." (provide 'elint) -;; arch-tag: b2f061e2-af84-4ddc-8e39-f5e969ac228f ;;; elint.el ends here diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 216d91baa7b..9d59337a7c7 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -213,6 +213,8 @@ LIBRARY should be a string (the name of the library)." (interactive (let* ((dirs (or find-function-source-path load-path)) (suffixes (find-library-suffixes)) + (table (apply-partially 'locate-file-completion-table + dirs suffixes)) (def (if (eq (function-called-at-point) 'require) ;; `function-called-at-point' may return 'require ;; with `point' anywhere on this line. So wrap the @@ -226,16 +228,12 @@ LIBRARY should be a string (the name of the library)." (thing-at-point 'symbol)) (error nil)) (thing-at-point 'symbol)))) - (when def - (setq def (and (locate-file-completion-table - dirs suffixes def nil 'lambda) - def))) + (when (and def (not (test-completion def table))) + (setq def nil)) (list (completing-read (if def (format "Library name (default %s): " def) "Library name: ") - (apply-partially 'locate-file-completion-table - dirs suffixes) - nil nil nil nil def)))) + table nil nil nil nil def)))) (let ((buf (find-file-noselect (find-library-name library)))) (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))))) diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index f213d2dba9d..371fe8af3ad 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -1,7 +1,7 @@ ;;; float-sup.el --- define some constants useful for floating point numbers. -;; Copyright (C) 1985, 1986, 1987, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -26,15 +26,8 @@ ;;; Code: -;; Provide a meaningful error message if we are running on -;; bare (non-float) emacs. - -(if (fboundp 'atan) - nil - (error "Floating point was disabled at compile time")) - -;; provide an easy hook to tell if we are running with floats or not. -;; define pi and e via math-lib calls. (much less prone to killer typos.) +;; Provide an easy hook to tell if we are running with floats or not. +;; Define pi and e via math-lib calls (much less prone to killer typos). (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") (defconst pi float-pi "Obsolete since Emacs-23.3. Use `float-pi' instead.") @@ -45,7 +38,7 @@ (defconst radians-to-degrees (/ 180.0 float-pi) "Radian to degree conversion constant.") -;; these expand to a single multiply by a float when byte compiled +;; These expand to a single multiply by a float when byte compiled. (defmacro degrees-to-radians (x) "Convert X from degrees to radians." @@ -56,5 +49,4 @@ (provide 'lisp-float-type) -;; arch-tag: e7837072-a4af-4d08-9953-8a3e755abf9d ;;; float-sup.el ends here diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index b4ac0eebf6d..c90d1394978 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -407,10 +407,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (if (and (buffer-modified-p) (y-or-n-p (format "Save buffer %s first? " (buffer-name)))) (save-buffer)) - (let ((compiled-file-name (byte-compile-dest-file buffer-file-name))) - (if (file-newer-than-file-p compiled-file-name buffer-file-name) - (load-file compiled-file-name) - (byte-compile-file buffer-file-name t)))) + (byte-recompile-file buffer-file-name nil 0 t)) (defcustom emacs-lisp-mode-hook nil "Hook run when entering Emacs Lisp mode." @@ -1078,7 +1075,7 @@ is the buffer position of the start of the containing expression." (goto-char calculate-lisp-indent-last-sexp) (or (and (looking-at ":") (setq indent (current-column))) - (and (< (save-excursion (beginning-of-line) (point)) + (and (< (line-beginning-position) (prog2 (backward-sexp) (point))) (looking-at ":") (setq indent (current-column)))) @@ -1440,5 +1437,4 @@ means don't indent that line." (provide 'lisp-mode) -;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf ;;; lisp-mode.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 61a2985226d..fecddcf16ed 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -77,7 +77,7 @@ ;; Other external functions you may want to use: ;; -;; M-x package-list-packages +;; M-x list-packages ;; Enters a mode similar to buffer-menu which lets you manage ;; packages. You can choose packages for install (mark with "i", ;; then "x" to execute) or deletion (not implemented yet), and you @@ -215,7 +215,6 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")." (declare-function url-http-parse-response "url-http" ()) (declare-function lm-header "lisp-mnt" (header)) (declare-function lm-commentary "lisp-mnt" (&optional file)) -(declare-function dired-delete-file "dired" (file &optional recursive trash)) (defvar url-http-end-of-headers) (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) @@ -278,9 +277,12 @@ contrast, `package-user-dir' contains packages for personal use." ;; until it's needed (i.e. when `package-intialize' is called). (defvar package--builtins nil "Alist of built-in packages. +The actual value is initialized by loading the library +`finder-inf'; this is not done until it is needed, e.g. by the +function `package-built-in-p'. + Each element has the form (PKG . DESC), where PKG is a package name (a symbol) and DESC is a vector that describes the package. - The vector DESC has the form [VERSION REQS DOCSTRING]. VERSION is a version list. REQS is a list of packages (symbols) required by the package. @@ -329,7 +331,9 @@ E.g., if given \"quux-23.0\", will return \"quux\"" (match-string 1 dirname))) (defun package-load-descriptor (dir package) - "Load the description file in directory DIR for package PACKAGE." + "Load the description file in directory DIR for package PACKAGE. +Here, PACKAGE is a string of the form NAME-VER, where NAME is the +package name and VER is its version." (let* ((pkg-dir (expand-file-name package dir)) (pkg-file (expand-file-name (concat (package-strip-version package) "-pkg") @@ -387,8 +391,10 @@ updates `package-alist' and `package-obsolete-alist'." "Extract the kind of download from an archive package description vector." (aref desc 3)) -(defun package--dir (name version-string) - (let* ((subdir (concat name "-" version-string)) +(defun package--dir (name version) + "Return the directory where a package is installed, or nil if none. +NAME and VERSION are both strings." + (let* ((subdir (concat name "-" version)) (dir-list (cons package-user-dir package-directory-list)) pkg-dir) (while dir-list @@ -404,7 +410,7 @@ updates `package-alist' and `package-obsolete-alist'." (version-str (package-version-join (package-desc-vers pkg-vec))) (pkg-dir (package--dir name version-str))) (unless pkg-dir - (error "Internal error: could not find directory for %s-%s" + (error "Internal error: unable to find directory for `%s-%s'" name version-str)) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) @@ -419,42 +425,46 @@ updates `package-alist' and `package-obsolete-alist'." ;; Don't return nil. t)) -(defun package--built-in (package version) - "Return true if the package is built-in to Emacs." +(defun package-built-in-p (package &optional version) + "Return true if PACKAGE, of VERSION or newer, is built-in to Emacs." + (require 'finder-inf nil t) ; For `package--builtins'. (let ((elt (assq package package--builtins))) - (and elt (version-list-= (package-desc-vers (cdr elt)) version)))) + (and elt (version-list-<= version (package-desc-vers (cdr elt)))))) -;; FIXME: return a reason instead? +;; This function goes ahead and activates a newer version of a package +;; if an older one was already activated. This is not ideal; we'd at +;; least need to check to see if the package has actually been loaded, +;; and not merely activated. (defun package-activate (package version) - "Activate a package, and recursively activate its dependencies. + "Activate package PACKAGE, of version VERSION or newer. +If PACKAGE has any dependencies, recursively activate them. Return nil if the package could not be activated." - ;; Assume the user knows what he is doing -- go ahead and activate a - ;; newer version of a package if an older one has already been - ;; activated. This is not ideal; we'd at least need to check to see - ;; if the package has actually been loaded, and not merely - ;; activated. However, don't try to activate 'emacs', as that makes - ;; no sense. - (unless (eq package 'emacs) - (let* ((pkg-desc (assq package package-alist)) - (this-version (package-desc-vers (cdr pkg-desc))) - (req-list (package-desc-reqs (cdr pkg-desc))) - ;; If the package was never activated, do it now. - (keep-going (or (not (memq package package-activated-list)) - (version-list-< version this-version)))) - (while (and req-list keep-going) - (let* ((req (car req-list)) - (req-name (car req)) - (req-version (cadr req))) - (or (package-activate req-name req-version) - (setq keep-going nil))) - (setq req-list (cdr req-list))) - (if keep-going - (package-activate-1 package (cdr pkg-desc)) - ;; We get here if a dependency failed to activate -- but we - ;; can also get here if the requested package was already - ;; activated. Return non-nil in the latter case. - (and (memq package package-activated-list) - (version-list-<= version this-version)))))) + (let ((pkg-vec (cdr (assq package package-alist))) + available-version found) + ;; Check if PACKAGE is available in `package-alist'. + (when pkg-vec + (setq available-version (package-desc-vers pkg-vec) + found (version-list-<= version available-version))) + (cond + ;; If no such package is found, maybe it's built-in. + ((null found) + (package-built-in-p package version)) + ;; If the package is already activated, just return t. + ((memq package package-activated-list) + t) + ;; Otherwise, proceed with activation. + (t + (let ((fail (catch 'dep-failure + ;; Activate its dependencies recursively. + (dolist (req (package-desc-reqs pkg-vec)) + (unless (package-activate (car req) (cadr req)) + (throw 'dep-failure req)))))) + (if fail + (warn "Unable to activate package `%s'. +Required package `%s-%s' is unavailable" + package (car fail) (package-version-join (cadr fail))) + ;; If all goes well, activate the package itself. + (package-activate-1 package pkg-vec))))))) (defun package-mark-obsolete (package pkg-vec) "Put package on the obsolete list, if not already there." @@ -470,48 +480,45 @@ Return nil if the package could not be activated." pkg-vec))) package-obsolete-alist)))) -(defun define-package (name-str version-string +(defun define-package (name-string version-string &optional docstring requirements &rest extra-properties) "Define a new package. -NAME is the name of the package, a string. -VERSION-STRING is the version of the package, a dotted sequence -of integers. -DOCSTRING is the optional description. -REQUIREMENTS is a list of requirements on other packages. +NAME-STRING is the name of the package, as a string. +VERSION-STRING is the version of the package, as a list of +integers of the form produced by `version-to-list'. +DOCSTRING is a short description of the package, a string. +REQUIREMENTS is a list of dependencies on other packages. Each requirement is of the form (OTHER-PACKAGE \"VERSION\"). EXTRA-PROPERTIES is currently unused." - (let* ((name (intern name-str)) - (pkg-desc (assq name package-alist)) - (new-version (version-to-list version-string)) + (let* ((name (intern name-string)) + (version (version-to-list version-string)) (new-pkg-desc (cons name - (vector new-version + (vector version (mapcar (lambda (elt) (list (car elt) (version-to-list (car (cdr elt))))) requirements) - docstring)))) - ;; Only redefine a package if the redefinition is newer. - (if (or (not pkg-desc) - (version-list-< (package-desc-vers (cdr pkg-desc)) - new-version)) - (progn - (when pkg-desc - ;; Remove old package and declare it obsolete. - (setq package-alist (delq pkg-desc package-alist)) - (package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) - ;; Add package to the alist. - (push new-pkg-desc package-alist)) - ;; You can have two packages with the same version, for instance - ;; one in the system package directory and one in your private - ;; directory. We just let the first one win. - (unless (version-list-= new-version - (package-desc-vers (cdr pkg-desc))) - ;; The package is born obsolete. - (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))) + docstring))) + (old-pkg (assq name package-alist))) + (cond + ;; If there's no old package, just add this to `package-alist'. + ((null old-pkg) + (push new-pkg-desc package-alist)) + ((version-list-< (package-desc-vers (cdr old-pkg)) version) + ;; Remove the old package and declare it obsolete. + (package-mark-obsolete name (cdr old-pkg)) + (setq package-alist (cons new-pkg-desc + (delq old-pkg package-alist)))) + ;; You can have two packages with the same version, e.g. one in + ;; the system package directory and one in your private + ;; directory. We just let the first one win. + ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) + ;; The package is born obsolete. + (package-mark-obsolete name (cdr new-pkg-desc)))))) ;; From Emacs 22. (defun package-autoload-ensure-default-file (file) @@ -562,12 +569,8 @@ Otherwise it uses an external `tar' program. (defun package-unpack (name version) (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version) package-user-dir))) - ;; Be careful!! (make-directory package-user-dir t) - (if (file-directory-p pkg-dir) - (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're - ; more confident - (directory-files pkg-dir t "^[^.]"))) + ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer) (package-generate-autoloads (symbol-name name) pkg-dir) @@ -605,7 +608,7 @@ Otherwise it uses an external `tar' program. (mapcar (lambda (elt) (list (car elt) - (package-version-join (car (cdr elt))))) + (package-version-join (cadr elt)))) requires)))) "\n") nil @@ -657,10 +660,14 @@ It will move point to somewhere in the headers." (kill-buffer tar-buffer)))) (defun package-installed-p (package &optional min-version) + "Return true if PACKAGE, of VERSION or newer, is installed. +Built-in packages also qualify." (let ((pkg-desc (assq package package-alist))) - (and pkg-desc - (version-list-<= min-version - (package-desc-vers (cdr pkg-desc)))))) + (if pkg-desc + (version-list-<= min-version + (package-desc-vers (cdr pkg-desc))) + ;; Also check built-in packages. + (package-built-in-p package min-version)))) (defun package-compute-transaction (package-list requirements) "Return a list of packages to be installed, including PACKAGE-LIST. @@ -691,17 +698,18 @@ not included in this list." ((null (stringp hold)) (error "Invalid element in `package-load-list'")) ((version-list-< (version-to-list hold) next-version) - (error "Package '%s' held at version %s, \ + (error "Package `%s' held at version %s, \ but version %s required" (symbol-name next-pkg) hold (package-version-join next-version))))) (unless pkg-desc - (error "Package '%s' is not available for installation" - (symbol-name next-pkg))) + (error "Package `%s-%s' is unavailable" + (symbol-name next-pkg) + (package-version-join next-version))) (unless (version-list-<= next-version (package-desc-vers (cdr pkg-desc))) (error - "Need package '%s' with version %s, but only %s is available" + "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) (package-version-join (package-desc-vers (cdr pkg-desc))))) ;; Only add to the transaction if we don't already have it. @@ -745,6 +753,7 @@ Will throw an error if the archive version is too new." (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)))) @@ -811,7 +820,7 @@ The package is found on one of the archives in `package-archives'." nil t)))) (let ((pkg-desc (assq name package-archive-contents))) (unless pkg-desc - (error "Package '%s' is not available for installation" + (error "Package `%s' is not available for installation" (symbol-name name))) (package-download-transaction (package-compute-transaction (list name) @@ -968,11 +977,16 @@ The file can either be a tar file or an Emacs Lisp file." (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) (defun package-delete (name version) - (require 'dired) ; for dired-delete-file - (dired-delete-file (expand-file-name (concat name "-" version) - package-user-dir) - ;; FIXME: query user? - 'always)) + (let ((dir (package--dir name version))) + (if (string-equal (file-name-directory dir) + (file-name-as-directory + (expand-file-name package-user-dir))) + (progn + (delete-directory dir t t) + (message "Package `%s-%s' deleted." name version)) + ;; Don't delete "system" packages + (error "Package `%s-%s' is a system package, not deleting" + name version)))) (defun package-archive-url (name) "Return the archive containing the package NAME." @@ -1014,21 +1028,22 @@ makes them available for download." (car archive))))) (package-read-all-archive-contents)) +(defvar package--initialized nil) + ;;;###autoload -(defun package-initialize () +(defun package-initialize (&optional no-activate) "Load Emacs Lisp packages, and activate them. -The variable `package-load-list' controls which packages to load." +The variable `package-load-list' controls which packages to load. +If optional arg NO-ACTIVATE is non-nil, don't activate packages." (interactive) - (require 'finder-inf nil t) - (setq package-alist package--builtins) - (setq package-activated-list (mapcar #'car package-alist)) - (setq package-obsolete-alist nil) + (setq package-alist nil + package-obsolete-alist nil) (package-load-all-descriptors) (package-read-all-archive-contents) - ;; Try to activate all our packages. - (mapc (lambda (elt) - (package-activate (car elt) (package-desc-vers (cdr elt)))) - package-alist)) + (unless no-activate + (dolist (elt package-alist) + (package-activate (car elt) (package-desc-vers (cdr elt))))) + (setq package--initialized t)) ;;;; Package description buffer. @@ -1037,10 +1052,15 @@ The variable `package-load-list' controls which packages to load." (defun describe-package (package) "Display the full documentation of PACKAGE (a symbol)." (interactive - (let* ((packages (append (mapcar 'car package-alist) - (mapcar 'car package-archive-contents))) - (guess (function-called-at-point)) - val) + (let* ((guess (function-called-at-point)) + packages val) + (require 'finder-inf nil t) + ;; Load the package list if necessary (but don't activate them). + (unless package--initialized + (package-initialize t)) + (setq packages (append (mapcar 'car package-alist) + (mapcar 'car package-archive-contents) + (mapcar 'car package--builtins))) (unless (memq guess packages) (setq guess nil)) (setq packages (mapcar 'symbol-name packages)) @@ -1051,8 +1071,8 @@ The variable `package-load-list' controls which packages to load." "Describe package: ") packages nil t nil nil guess)) (list (if (equal val "") guess (intern val))))) - (if (or (null package) (null (symbolp package))) - (message "You did not specify a package") + (if (or (null package) (not (symbolp package))) + (message "No package specified") (help-setup-xref (list #'describe-package package) (called-interactively-p 'interactive)) (with-help-window (help-buffer) @@ -1066,22 +1086,27 @@ The variable `package-load-list' controls which packages to load." desc pkg-dir reqs version installable) (prin1 package) (princ " is ") - (if (setq desc (cdr (assq package package-alist))) - ;; This package is loaded (i.e. in `package-alist'). - (progn - (setq version (package-version-join (package-desc-vers desc))) - (cond (built-in - (princ "a built-in package.\n\n")) - ((setq pkg-dir (package--dir package-name version)) - (insert "an installed package.\n\n")) - (t ;; This normally does not happen. - (insert "a deleted package.\n\n") - (setq version nil)))) - ;; This package is not installed. - (setq desc (cdr (assq package package-archive-contents)) - version (package-version-join (package-desc-vers desc)) + (cond + ;; Loaded packages are in `package-alist'. + ((setq desc (cdr (assq package package-alist))) + (setq version (package-version-join (package-desc-vers desc))) + (if (setq pkg-dir (package--dir package-name version)) + (insert "an installed package.\n\n") + ;; This normally does not happen. + (insert "a deleted package.\n\n"))) + ;; Available packages are in `package-archive-contents'. + ((setq desc (cdr (assq package package-archive-contents))) + (setq version (package-version-join (package-desc-vers desc)) installable t) - (insert "an uninstalled package.\n\n")) + (if built-in + (insert "a built-in package.\n\n") + (insert "an uninstalled package.\n\n"))) + (built-in + (setq desc (cdr built-in) + version (package-version-join (package-desc-vers desc))) + (insert "a built-in package.\n\n")) + (t + (insert "an orphan package.\n\n"))) (insert " " (propertize "Status" 'font-lock-face 'bold) ": ") (cond (pkg-dir @@ -1091,32 +1116,35 @@ The variable `package-load-list' controls which packages to load." ;; Todo: Add button for uninstalling. (help-insert-xref-button (file-name-as-directory pkg-dir) 'help-package-def pkg-dir) - (insert "'.")) + (if built-in + (insert "',\n shadowing a " + (propertize "built-in package" + 'font-lock-face 'font-lock-builtin-face) + ".") + (insert "'."))) (installable - (insert "Available -- ") - (let ((button-text (if (display-graphic-p) - "Install" - "[Install]")) + (if built-in + (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) + " Alternate version available -- ") + (insert "Available -- ")) + (let ((button-text (if (display-graphic-p) "Install" "[Install]")) (button-face (if (display-graphic-p) '(:box (:line-width 2 :color "dark grey") :background "light grey" :foreground "black") 'link))) - (insert-text-button button-text - 'face button-face - 'follow-link t + (insert-text-button button-text 'face button-face 'follow-link t 'package-symbol package 'action 'package-install-button-action))) (built-in - (insert (propertize "Built-in" - 'font-lock-face 'font-lock-builtin-face) ".")) + (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) (t (insert "Deleted."))) (insert "\n") - (and version - (> (length version) 0) + (and version (> (length version) 0) (insert " " (propertize "Version" 'font-lock-face 'bold) ": " version "\n")) - (setq reqs (package-desc-reqs desc)) + + (setq reqs (if desc (package-desc-reqs desc))) (when reqs (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ") (let ((first t) @@ -1134,9 +1162,9 @@ The variable `package-load-list' controls which packages to load." (help-insert-xref-button text 'help-package name)) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (package-desc-doc desc) "\n\n") + ": " (if desc (package-desc-doc desc)) "\n\n") - (if (assq package package--builtins) + (if built-in ;; For built-in packages, insert the commentary. (let ((fn (locate-file (concat package-name ".el") load-path load-file-rep-suffixes)) @@ -1187,7 +1215,7 @@ The variable `package-load-list' controls which packages to load." (defvar package-menu-mode-map (let ((map (make-keymap)) (menu-map (make-sparse-keymap "Package"))) - (suppress-keymap map) + (set-keymap-parent map button-buffer-map) (define-key map "\C-m" 'package-menu-describe-package) (define-key map "q" 'quit-window) (define-key map "n" 'next-line) @@ -1340,12 +1368,16 @@ buffers. The arguments are ignored." (defun package-menu-mark-delete (num) "Mark a package for deletion and move to the next line." (interactive "p") - (package-menu-mark-internal "D")) + (if (string-equal (package-menu-get-status) "installed") + (package-menu-mark-internal "D") + (forward-line))) (defun package-menu-mark-install (num) "Mark a package for installation and move to the next line." (interactive "p") - (package-menu-mark-internal "I")) + (if (string-equal (package-menu-get-status) "available") + (package-menu-mark-internal "I") + (forward-line))) (defun package-menu-mark-unmark (num) "Clear any marks on a package and move to the next line." @@ -1399,34 +1431,58 @@ buffers. The arguments are ignored." ""))) (defun package-menu-execute () - "Perform all the marked actions. -Packages marked for installation will be downloaded and -installed. Packages marked for deletion will be removed. -Note that after installing packages you will want to restart -Emacs." + "Perform marked Package Menu actions. +Packages marked for installation are downloaded and installed; +packages marked for deletion are removed." (interactive) - (goto-char (point-min)) - (while (not (eobp)) - (let ((cmd (char-after)) - (pkg-name (package-menu-get-package)) - (pkg-vers (package-menu-get-version)) - (pkg-status (package-menu-get-status))) - (cond - ((eq cmd ?D) - (when (and (string= pkg-status "installed") - (string= pkg-name "package")) - ;; FIXME: actually, we could be tricky and remove all info. - ;; But that is drastic and the user can do that instead. - (error "Can't delete most recent version of `package'")) - ;; Ask for confirmation here? Maybe if package status is ""? - ;; Or if any lisp from package is actually loaded? - (message "Deleting %s-%s..." pkg-name pkg-vers) - (package-delete pkg-name pkg-vers) - (message "Deleting %s-%s... done" pkg-name pkg-vers)) - ((eq cmd ?I) - (package-install (intern pkg-name))))) - (forward-line)) - (package-menu-revert)) + (let (install-list delete-list cmd) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (setq cmd (char-after)) + (cond + ((eq cmd ?\s) t) + ((eq cmd ?D) + (push (cons (package-menu-get-package) + (package-menu-get-version)) + delete-list)) + ((eq cmd ?I) + (push (package-menu-get-package) install-list))) + (forward-line))) + ;; Delete packages, prompting if necessary. + (when delete-list + (if (yes-or-no-p + (if (= (length delete-list) 1) + (format "Delete package `%s-%s'? " + (caar delete-list) + (cdr (car delete-list))) + (format "Delete these %d packages (%s)? " + (length delete-list) + (mapconcat (lambda (elt) + (concat (car elt) "-" (cdr elt))) + delete-list + ", ")))) + (dolist (elt delete-list) + (condition-case err + (package-delete (car elt) (cdr elt)) + (error (message (cadr err))))) + (error "Aborted"))) + (when install-list + (if (yes-or-no-p + (if (= (length install-list) 1) + (format "Install package `%s'? " (car install-list)) + (format "Install these %d packages (%s)? " + (length install-list) + (mapconcat 'identity install-list ", ")))) + (dolist (elt install-list) + (package-install (intern elt))))) + ;; If we deleted anything, regenerate `package-alist'. This is done + ;; automatically if we installed a package. + (and delete-list (null install-list) + (package-initialize)) + (if (or delete-list install-list) + (package-menu-revert) + (message "No operations specified.")))) (defun package-print-package (package version key desc) (let ((face @@ -1471,32 +1527,36 @@ A value of nil means to display all packages.") (defun package--generate-package-list () "Populate the current Package Menu buffer." - (package-initialize) (let ((inhibit-read-only t) info-list name desc hold builtin) - (setq buffer-read-only nil) (erase-buffer) ;; List installed packages (dolist (elt package-alist) (setq name (car elt)) - (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. - (or (null package-menu-package-list) - (memq name package-menu-package-list))) + (when (or (null package-menu-package-list) + (memq name package-menu-package-list)) (setq desc (cdr elt) - hold (cadr (assq name package-load-list)) - builtin (cdr (assq name package--builtins))) + hold (cadr (assq name package-load-list))) (setq info-list (package-list-maybe-add name (package-desc-vers desc) ;; FIXME: it turns out to be tricky to see if this ;; package is presently activated. - (cond ((stringp hold) "held") - ((and builtin - (version-list-= - (package-desc-vers builtin) - (package-desc-vers desc))) - "built-in") - (t "installed")) + (if (stringp hold) "held" "installed") + (package-desc-doc desc) + info-list)))) + + ;; List built-in packages + (dolist (elt package--builtins) + (setq name (car elt)) + (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (or (null package-menu-package-list) + (memq name package-menu-package-list))) + (setq desc (cdr elt)) + (setq info-list + (package-list-maybe-add + name (package-desc-vers desc) + "built-in" (package-desc-doc desc) info-list)))) @@ -1602,6 +1662,7 @@ A value of nil means to display all packages.") "Generate and pop to the *Packages* buffer. Optional PACKAGES is a list of names of packages (symbols) to list; the default is to display everything in `package-alist'." + (require 'finder-inf nil t) (with-current-buffer (get-buffer-create "*Packages*") (package-menu-mode) (set (make-local-variable 'package-menu-package-list) packages) @@ -1618,6 +1679,9 @@ list; the default is to display everything in `package-alist'." Fetches the updated list of packages before displaying. The list is displayed in a buffer named `*Packages*'." (interactive) + ;; Initialize the package system if necessary. + (unless package--initialized + (package-initialize t)) (package-refresh-contents) (package--list-packages)) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index b922e0b0233..5ff26b3dbc0 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -25,6 +25,16 @@ ;; ML-style pattern matching. ;; The entry points are autoloaded. +;; Todo: + +;; - provide ways to extend the set of primitives, with some kind of +;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP) +;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)). +;; But better would be if we could define new ways to match by having the +;; extension provide its own `pcase--split-<foo>' thingy. +;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to +;; generate a lex-style DFA to decide whether to run E1 or E2. + ;;; Code: (eval-when-compile (require 'cl)) @@ -36,6 +46,8 @@ ;; over and over again. (defconst pcase-memoize (make-hash-table :weakness t :test 'equal)) +(defconst pcase--dontcare-upats '(t _ dontcare)) + ;;;###autoload (defmacro pcase (exp &rest cases) "Perform ML-style pattern matching on EXP. @@ -48,10 +60,12 @@ UPatterns can take the following forms: (and UPAT...) matches if all the patterns match. `QPAT matches if the QPattern QPAT matches. (pred PRED) matches if PRED applied to the object returns non-nil. + (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. QPatterns can take the following forms: (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. ,UPAT matches if the UPattern UPAT matches. + STRING matches if the object is `equal' to STRING. ATOM matches if the object is `eq' to ATOM. QPatterns for vectors are not implemented yet. @@ -63,38 +77,64 @@ PRED patterns can refer to variables bound earlier in the pattern. 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) + (pcase--expand exp cases) pcase-memoize))) ;;;###autoload -(defmacro pcase-let* (bindings body) +(defmacro pcase-let* (bindings &rest body) "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)." - (if (null bindings) body + (declare (indent 1) (debug let)) + (cond + ((null bindings) (if (> (length body) 1) `(progn ,@body) (car body))) + ((pcase--trivial-upat-p (caar bindings)) + `(let (,(car bindings)) (pcase-let* ,(cdr bindings) ,@body))) + (t `(pcase ,(cadr (car bindings)) - (,(caar bindings) (pcase-let* ,(cdr bindings) ,body)) - (t (error "Pattern match failure in `pcase-let'"))))) + (,(caar bindings) (pcase-let* ,(cdr bindings) ,@body)) + ;; We can either signal an error here, or just use `dontcare' which + ;; generates more efficient code. In practice, if we use `dontcare' we + ;; will still often get an error and the few cases where we don't do not + ;; matter that much, so it's a better choice. + (dontcare nil))))) ;;;###autoload -(defmacro pcase-let (bindings body) +(defmacro pcase-let (bindings &rest body) "Like `let' but where you can use `pcase' patterns for bindings. -BODY should be an expression, and BINDINGS should be a list of bindings +BODY should be a list of expressions, 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)) - `(let ,(mapcar (lambda (binding) (list (nth 0 binding) (nth 2 binding))) - bindings) - (pcase-let* - ,(mapcar (lambda (binding) (list (nth 1 binding) (nth 0 binding))) - bindings) - ,body)))) - -(defun pcase-expand (exp cases) + `(pcase-let* ,bindings ,@body) + (let ((matches '())) + (dolist (binding (prog1 bindings (setq bindings nil))) + (cond + ((memq (car binding) pcase--dontcare-upats) + (push (cons (make-symbol "_") (cdr binding)) bindings)) + ((pcase--trivial-upat-p (car binding)) (push binding bindings)) + (t + (let ((tmpvar (make-symbol (format "x%d" (length bindings))))) + (push (cons tmpvar (cdr binding)) bindings) + (push (list (car binding) tmpvar) matches))))) + `(let ,(nreverse bindings) (pcase-let* ,matches ,@body))))) + +(defmacro pcase-dolist (spec &rest body) + (if (pcase--trivial-upat-p (car spec)) + `(dolist ,spec ,@body) + (let ((tmpvar (make-symbol "x"))) + `(dolist (,tmpvar ,@(cdr spec)) + (pcase-let* ((,(car spec) ,tmpvar)) + ,@body))))) + + +(defun pcase--trivial-upat-p (upat) + (and (symbolp upat) (not (memq upat pcase--dontcare-upats)))) + +(defun pcase--expand (exp cases) (let* ((defs (if (symbolp exp) '() (let ((sym (make-symbol "x"))) (prog1 `((,sym ,exp)) (setq exp sym))))) @@ -137,23 +177,24 @@ of the form (UPAT EXP)." (mapcar #'car vars))) `(funcall ,res ,@args))))))) (main - (pcase-u + (pcase--u (mapcar (lambda (case) `((match ,exp . ,(car case)) ,(apply-partially - (if (pcase-small-branch-p (cdr case)) + (if (pcase--small-branch-p (cdr case)) ;; Don't bother sharing multiple ;; occurrences of this leaf since it's small. #'pcase-codegen codegen) (cdr case)))) cases)))) - `(let ,defs ,main))) + (if (null defs) main + `(let ,defs ,main)))) (defun pcase-codegen (code vars) `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) ,@code)) -(defun pcase-small-branch-p (code) +(defun pcase--small-branch-p (code) (and (= 1 (length code)) (or (not (consp (car code))) (let ((small t)) @@ -163,19 +204,26 @@ of the form (UPAT EXP)." ;; Try to use `cond' rather than a sequence of `if's, so as to reduce ;; the depth of the generated tree. -(defun pcase-if (test then else) +(defun pcase--if (test then else) (cond - ((eq else :pcase-dontcare) then) + ((eq else :pcase--dontcare) then) ((eq (car-safe else) 'if) - `(cond (,test ,then) - (,(nth 1 else) ,(nth 2 else)) - (t ,@(nthcdr 3 else)))) + (if (equal test (nth 1 else)) + ;; Doing a test a second time: get rid of the redundancy. + ;; FIXME: ideally, this should never happen because the pcase--split-* + ;; funs should have eliminated such things, but pcase--split-member + ;; is imprecise, so in practice it can happen occasionally. + `(if ,test ,then ,@(nthcdr 3 else)) + `(cond (,test ,then) + (,(nth 1 else) ,(nth 2 else)) + (t ,@(nthcdr 3 else))))) ((eq (car-safe else) 'cond) `(cond (,test ,then) - ,@(cdr else))) + ;; Doing a test a second time: get rid of the redundancy, as above. + ,@(remove (assoc test else) (cdr else)))) (t `(if ,test ,then ,else)))) -(defun pcase-upat (qpattern) +(defun pcase--upat (qpattern) (cond ((eq (car-safe qpattern) '\,) (cadr qpattern)) (t (list '\` qpattern)))) @@ -198,7 +246,7 @@ of the form (UPAT EXP)." ;; canonicalize them to one form over another, but we do occasionally ;; turn one into the other. -(defun pcase-u (branches) +(defun pcase--u (branches) "Expand matcher for rules BRANCHES. Each BRANCH has the form (MATCH CODE . VARS) where CODE is the code generator for that branch. @@ -209,12 +257,12 @@ MATCH is the pattern that needs to be matched, of the form: (or MATCH ...)" (when (setq branches (delq nil branches)) (destructuring-bind (match code &rest vars) (car branches) - (pcase-u1 (list match) code vars (cdr branches))))) + (pcase--u1 (list match) code vars (cdr branches))))) -(defun pcase-and (match matches) +(defun pcase--and (match matches) (if matches `(and ,match ,@matches) match)) -(defun pcase-split-match (sym splitter match) +(defun pcase--split-match (sym splitter match) (case (car match) ((match) (if (not (eq sym (cadr match))) @@ -223,20 +271,21 @@ MATCH is the pattern that needs to be matched, of the form: (cond ;; Hoist `or' and `and' patterns to `or' and `and' matches. ((memq (car-safe pat) '(or and)) - (pcase-split-match sym splitter - (cons (car pat) - (mapcar (lambda (alt) - `(match ,sym . ,alt)) - (cdr pat))))) + (pcase--split-match sym splitter + (cons (car pat) + (mapcar (lambda (alt) + `(match ,sym . ,alt)) + (cdr pat))))) (t (let ((res (funcall splitter (cddr match)))) (cons (or (car res) match) (or (cdr res) match)))))))) ((or and) (let ((then-alts '()) (else-alts '()) - (neutral-elem (if (eq 'or (car match)) :pcase-fail :pcase-succeed)) - (zero-elem (if (eq 'or (car match)) :pcase-succeed :pcase-fail))) + (neutral-elem (if (eq 'or (car match)) + :pcase--fail :pcase--succeed)) + (zero-elem (if (eq 'or (car match)) :pcase--succeed :pcase--fail))) (dolist (alt (cdr match)) - (let ((split (pcase-split-match sym splitter alt))) + (let ((split (pcase--split-match sym splitter alt))) (unless (eq (car split) neutral-elem) (push (car split) then-alts)) (unless (eq (cdr split) neutral-elem) @@ -251,50 +300,50 @@ MATCH is the pattern that needs to be matched, of the form: (t (cons (car match) (nreverse else-alts))))))) (t (error "Uknown MATCH %s" match)))) -(defun pcase-split-rest (sym splitter rest) +(defun pcase--split-rest (sym splitter rest) (let ((then-rest '()) (else-rest '())) (dolist (branch rest) (let* ((match (car branch)) (code&vars (cdr branch)) (splitted - (pcase-split-match sym splitter match))) - (unless (eq (car splitted) :pcase-fail) + (pcase--split-match sym splitter match))) + (unless (eq (car splitted) :pcase--fail) (push (cons (car splitted) code&vars) then-rest)) - (unless (eq (cdr splitted) :pcase-fail) + (unless (eq (cdr splitted) :pcase--fail) (push (cons (cdr splitted) code&vars) else-rest)))) (cons (nreverse then-rest) (nreverse else-rest)))) -(defun pcase-split-consp (syma symd pat) +(defun pcase--split-consp (syma symd pat) (cond ;; A QPattern for a cons, can only go the `then' side. ((and (eq (car-safe pat) '\`) (consp (cadr pat))) (let ((qpat (cadr pat))) - (cons `(and (match ,syma . ,(pcase-upat (car qpat))) - (match ,symd . ,(pcase-upat (cdr qpat)))) - :pcase-fail))) + (cons `(and (match ,syma . ,(pcase--upat (car qpat))) + (match ,symd . ,(pcase--upat (cdr qpat)))) + :pcase--fail))) ;; A QPattern but not for a cons, can only go the `else' side. - ((eq (car-safe pat) '\`) (cons :pcase-fail nil)))) + ((eq (car-safe pat) '\`) (cons :pcase--fail nil)))) -(defun pcase-split-eq (elem pat) +(defun pcase--split-equal (elem pat) (cond ;; The same match will give the same result. ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) - (cons :pcase-succeed :pcase-fail)) + (cons :pcase--succeed :pcase--fail)) ;; A different match will fail if this one succeeds. ((and (eq (car-safe pat) '\`) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase-fail nil)))) + (cons :pcase--fail nil)))) -(defun pcase-split-memq (elems pat) - ;; Based on pcase-split-eq. +(defun pcase--split-member (elems pat) + ;; Based on pcase--split-equal. (cond - ;; The same match will give the same result, but we don't know how - ;; to check it. + ;; The same match (or a match of membership in a superset) will + ;; give the same result, but we don't know how to check it. ;; (??? - ;; (cons :pcase-succeed nil)) + ;; (cons :pcase--succeed nil)) ;; A match for one of the elements may succeed or fail. ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) nil) @@ -303,26 +352,26 @@ MATCH is the pattern that needs to be matched, of the form: ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase-fail nil)))) + (cons :pcase--fail nil)))) -(defun pcase-split-pred (upat pat) +(defun pcase--split-pred (upat pat) ;; FIXME: For predicates like (pred (> a)), two such predicates may ;; actually refer to different variables `a'. (if (equal upat pat) - (cons :pcase-succeed :pcase-fail))) + (cons :pcase--succeed :pcase--fail))) -(defun pcase-fgrep (vars sexp) +(defun pcase--fgrep (vars sexp) "Check which of the symbols VARS appear in SEXP." (let ((res '())) (while (consp sexp) - (dolist (var (pcase-fgrep vars (pop sexp))) + (dolist (var (pcase--fgrep vars (pop sexp))) (unless (memq var res) (push var res)))) (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) res)) ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. -(defun pcase-u1 (matches code vars rest) +(defun pcase--u1 (matches code vars rest) "Return code that runs CODE (with VARS) if MATCHES match. and otherwise defers to REST which is a list of branches of the form \(ELSE-MATCH ELSE-CODE . ELSE-VARS)." @@ -333,11 +382,11 @@ and otherwise defers to REST which is a list of branches of the form ;; between matches. So we don't bother trying to reorder anything. (cond ((null matches) (funcall code vars)) - ((eq :pcase-fail (car matches)) (pcase-u rest)) - ((eq :pcase-succeed (car matches)) - (pcase-u1 (cdr matches) code vars rest)) + ((eq :pcase--fail (car matches)) (pcase--u rest)) + ((eq :pcase--succeed (car matches)) + (pcase--u1 (cdr matches) code vars rest)) ((eq 'and (caar matches)) - (pcase-u1 (append (cdar matches) (cdr matches)) code vars rest)) + (pcase--u1 (append (cdar matches) (cdr matches)) code vars rest)) ((eq 'or (caar matches)) (let* ((alts (cdar matches)) (var (if (eq (caar alts) 'match) (cadr (car alts)))) @@ -347,119 +396,126 @@ and otherwise defers to REST which is a list of branches of the form (if (and (eq (car alt) 'match) (eq var (cadr alt)) (let ((upat (cddr alt))) (and (eq (car-safe upat) '\`) - (or (integerp (cadr upat)) (symbolp (cadr upat)))))) + (or (integerp (cadr upat)) (symbolp (cadr upat)) + (stringp (cadr upat)))))) (push (cddr alt) simples) (push alt others)))) (cond - ((null alts) (error "Please avoid it") (pcase-u rest)) + ((null alts) (error "Please avoid it") (pcase--u rest)) ((> (length simples) 1) ;; De-hoist the `or' MATCH into an `or' pattern that will be ;; turned into a `memq' below. - (pcase-u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches)) - code vars - (if (null others) rest - (cons (list* - (pcase-and (if (cdr others) - (cons 'or (nreverse others)) - (car others)) - (cdr matches)) - code vars) - rest)))) + (pcase--u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches)) + code vars + (if (null others) rest + (cons (list* + (pcase--and (if (cdr others) + (cons 'or (nreverse others)) + (car others)) + (cdr matches)) + code vars) + rest)))) (t - (pcase-u1 (cons (pop alts) (cdr matches)) code vars - (if (null alts) (progn (error "Please avoid it") rest) - (cons (list* - (pcase-and (if (cdr alts) - (cons 'or alts) (car alts)) - (cdr matches)) - code vars) - rest))))))) + (pcase--u1 (cons (pop alts) (cdr matches)) code vars + (if (null alts) (progn (error "Please avoid it") rest) + (cons (list* + (pcase--and (if (cdr alts) + (cons 'or alts) (car alts)) + (cdr matches)) + code vars) + rest))))))) ((eq 'match (caar matches)) (destructuring-bind (op sym &rest upat) (pop matches) (cond - ((memq upat '(t _)) (pcase-u1 matches code vars rest)) - ((eq upat 'dontcare) :pcase-dontcare) + ((memq upat '(t _)) (pcase--u1 matches code vars rest)) + ((eq upat 'dontcare) :pcase--dontcare) ((functionp upat) (error "Feature removed, use (pred %s)" upat)) - ((eq (car-safe upat) 'pred) + ((memq (car-safe upat) '(guard pred)) (destructuring-bind (then-rest &rest else-rest) - (pcase-split-rest - sym (apply-partially 'pcase-split-pred upat) rest) - (pcase-if (if (symbolp (cadr upat)) - `(,(cadr upat) ,sym) - (let* ((exp (cadr upat)) - ;; `vs' is an upper bound on the vars we need. - (vs (pcase-fgrep (mapcar #'car vars) exp)) - (call (if (functionp exp) - `(,exp ,sym) `(,@exp ,sym)))) - (if (null vs) - call - ;; Let's not replace `vars' in `exp' since it's - ;; too difficult to do it right, instead just - ;; let-bind `vars' around `exp'. - `(let ,(mapcar (lambda (var) - (list var (cdr (assq var vars)))) - vs) - ;; FIXME: `vars' can capture `sym'. E.g. - ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) - ,call)))) - (pcase-u1 matches code vars then-rest) - (pcase-u else-rest)))) + (pcase--split-rest + sym (apply-partially #'pcase--split-pred upat) rest) + (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) + `(,(cadr upat) ,sym) + (let* ((exp (cadr upat)) + ;; `vs' is an upper bound on the vars we need. + (vs (pcase--fgrep (mapcar #'car vars) exp)) + (call (cond + ((eq 'guard (car upat)) exp) + ((functionp exp) `(,exp ,sym)) + (t `(,@exp ,sym))))) + (if (null vs) + call + ;; Let's not replace `vars' in `exp' since it's + ;; too difficult to do it right, instead just + ;; let-bind `vars' around `exp'. + `(let ,(mapcar (lambda (var) + (list var (cdr (assq var vars)))) + vs) + ;; FIXME: `vars' can capture `sym'. E.g. + ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) + ,call)))) + (pcase--u1 matches code vars then-rest) + (pcase--u else-rest)))) ((symbolp upat) - (pcase-u1 matches code (cons (cons upat sym) vars) rest)) + (pcase--u1 matches code (cons (cons upat sym) vars) rest)) ((eq (car-safe upat) '\`) - (pcase-q1 sym (cadr upat) matches code vars rest)) + (pcase--q1 sym (cadr upat) matches code vars rest)) ((eq (car-safe upat) 'or) - (let ((all (> (length (cdr upat)) 1))) + (let ((all (> (length (cdr upat)) 1)) + (memq-fine t)) (when all (dolist (alt (cdr upat)) (unless (and (eq (car-safe alt) '\`) - (or (symbolp (cadr alt)) (integerp (cadr alt)))) + (or (symbolp (cadr alt)) (integerp (cadr alt)) + (setq memq-fine nil) + (stringp (cadr alt)))) (setq all nil)))) (if all ;; Use memq for (or `a `b `c `d) rather than a big tree. (let ((elems (mapcar 'cadr (cdr upat)))) (destructuring-bind (then-rest &rest else-rest) - (pcase-split-rest - sym (apply-partially 'pcase-split-memq elems) rest) - (pcase-if `(memq ,sym ',elems) - (pcase-u1 matches code vars then-rest) - (pcase-u else-rest)))) - (pcase-u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars - (append (mapcar (lambda (upat) - `((and (match ,sym . ,upat) ,@matches) - ,code ,@vars)) - (cddr upat)) - rest))))) + (pcase--split-rest + sym (apply-partially #'pcase--split-member elems) rest) + (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) + (pcase--u1 matches code vars then-rest) + (pcase--u else-rest)))) + (pcase--u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars + (append (mapcar (lambda (upat) + `((and (match ,sym . ,upat) ,@matches) + ,code ,@vars)) + (cddr upat)) + rest))))) ((eq (car-safe upat) 'and) - (pcase-u1 (append (mapcar (lambda (upat) `(match ,sym ,@upat)) (cdr upat)) - matches) - code vars rest)) + (pcase--u1 (append (mapcar (lambda (upat) `(match ,sym ,@upat)) + (cdr upat)) + matches) + code vars rest)) ((eq (car-safe upat) 'not) ;; FIXME: The implementation below is naive and results in ;; inefficient code. - ;; To make it work right, we would need to turn pcase-u1's + ;; To make it work right, we would need to turn pcase--u1's ;; `code' and `vars' into a single argument of the same form as ;; `rest'. We would also need to split this new `then-rest' argument ;; for every test (currently we don't bother to do it since ;; it's only useful for odd patterns like (and `(PAT1 . PAT2) ;; `(PAT3 . PAT4)) which the programmer can easily rewrite ;; to the more efficient `(,(and PAT1 PAT3) . ,(and PAT2 PAT4))). - (pcase-u1 `((match ,sym . ,(cadr upat))) - (lexical-let ((rest rest)) - ;; FIXME: This codegen is not careful to share its - ;; code if used several times: code blow up is likely. - (lambda (vars) - ;; `vars' will likely contain bindings which are - ;; not always available in other paths to - ;; `rest', so there' no point trying to pass - ;; them down. - (pcase-u rest))) - vars - (list `((and . ,matches) ,code . ,vars)))) + (pcase--u1 `((match ,sym . ,(cadr upat))) + (lexical-let ((rest rest)) + ;; FIXME: This codegen is not careful to share its + ;; code if used several times: code blow up is likely. + (lambda (vars) + ;; `vars' will likely contain bindings which are + ;; not always available in other paths to + ;; `rest', so there' no point trying to pass + ;; them down. + (pcase--u rest))) + vars + (list `((and . ,matches) ,code . ,vars)))) (t (error "Unknown upattern `%s'" upat))))) (t (error "Incorrect MATCH %s" (car matches))))) -(defun pcase-q1 (sym qpat matches code vars rest) +(defun pcase--q1 (sym qpat matches code vars rest) "Return code that runs CODE if SYM matches QPAT and if MATCHES match. and if not, defers to REST which is a list of branches of the form \(OTHER_MATCH OTHER-CODE . OTHER-VARS)." @@ -473,22 +529,23 @@ and if not, defers to REST which is a list of branches of the form (let ((syma (make-symbol "xcar")) (symd (make-symbol "xcdr"))) (destructuring-bind (then-rest &rest else-rest) - (pcase-split-rest sym (apply-partially 'pcase-split-consp syma symd) - rest) - (pcase-if `(consp ,sym) - `(let ((,syma (car ,sym)) - (,symd (cdr ,sym))) - ,(pcase-u1 `((match ,syma . ,(pcase-upat (car qpat))) - (match ,symd . ,(pcase-upat (cdr qpat))) - ,@matches) - code vars then-rest)) - (pcase-u else-rest))))) - ((or (integerp qpat) (symbolp qpat)) + (pcase--split-rest sym + (apply-partially #'pcase--split-consp syma symd) + rest) + (pcase--if `(consp ,sym) + `(let ((,syma (car ,sym)) + (,symd (cdr ,sym))) + ,(pcase--u1 `((match ,syma . ,(pcase--upat (car qpat))) + (match ,symd . ,(pcase--upat (cdr qpat))) + ,@matches) + code vars then-rest)) + (pcase--u else-rest))))) + ((or (integerp qpat) (symbolp qpat) (stringp qpat)) (destructuring-bind (then-rest &rest else-rest) - (pcase-split-rest sym (apply-partially 'pcase-split-eq qpat) rest) - (pcase-if `(eq ,sym ',qpat) - (pcase-u1 matches code vars then-rest) - (pcase-u else-rest)))) + (pcase--split-rest sym (apply-partially 'pcase--split-equal qpat) rest) + (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat) + (pcase--u1 matches code vars then-rest) + (pcase--u else-rest)))) (t (error "Unkown QPattern %s" qpat)))) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 6389b62ea04..116d7b93d90 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -141,11 +141,10 @@ This means the number of non-shy regexp grouping constructs (require 'cl)) (defun regexp-opt-group (strings &optional paren lax) - ;; Return a regexp to match a string in the sorted list STRINGS. - ;; If PAREN non-nil, output regexp parentheses around returned regexp. - ;; If LAX non-nil, don't output parentheses if it doesn't require them. - ;; Merges keywords to avoid backtracking in Emacs' regexp matcher. - + "Return a regexp to match a string in the sorted list STRINGS. +If PAREN non-nil, output regexp parentheses around returned regexp. +If LAX non-nil, don't output parentheses if it doesn't require them. +Merges keywords to avoid backtracking in Emacs' regexp matcher." ;; The basic idea is to find the shortest common prefix or suffix, remove it ;; and recurse. If there is no prefix, we divide the list into two so that ;; \(at least) one half will have at least a one-character common prefix. @@ -239,9 +238,7 @@ This means the number of non-shy regexp grouping constructs (defun regexp-opt-charset (chars) - ;; - ;; Return a regexp to match a character in CHARS. - ;; + "Return a regexp to match a character in CHARS." ;; The basic idea is to find character ranges. Also we take care in the ;; position of character set meta characters in the character set regexp. ;; diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 4f5b2046150..a7021b3cf7b 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -52,9 +52,9 @@ ;; error because the parser just automatically does something. Better yet, ;; we can afford to use a sloppy grammar. -;; The development (especially the parts building the 2D precedence -;; tables and then computing the precedence levels from it) is largely -;; inspired from page 187-194 of "Parsing techniques" by Dick Grune +;; A good background to understand the development (especially the parts +;; building the 2D precedence tables and then computing the precedence levels +;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune ;; and Ceriel Jacobs (BookBody.pdf available at ;; http://www.cs.vu.nl/~dick/PTAPG.html). ;; @@ -63,13 +63,36 @@ ;; Since then, some of that code has been beaten into submission, but the ;; smie-indent-keyword is still pretty obscure. -;;; Code: +;; Conflict resolution: +;; +;; - One source of conflicts is when you have: +;; (exp ("IF" exp "ELSE" exp "END") ("CASE" cases "END")) +;; (cases (cases "ELSE" insts) ...) +;; The IF-rule implies ELSE=END and the CASE-rule implies ELSE>END. +;; FIXME: we could try to resolve such conflicts automatically by changing +;; the way BNF rules such as the IF-rule is handled. I.e. rather than +;; IF=ELSE and ELSE=END, we could turn them into IF<ELSE and ELSE>END +;; and IF=END, + +;; TODO & BUGS: +;; +;; - Using the structural information SMIE gives us, it should be possible to +;; implement a `smie-align' command that would automatically figure out what +;; there is to align and how to do it (something like: align the token of +;; lowest precedence that appears the same number of times on all lines, +;; and then do the same on each side of that token). +;; - Maybe accept two juxtaposed non-terminals in the BNF under the condition +;; that the first always ends with a terminal, or that the second always +;; starts with a terminal. -;; FIXME: I think the behavior on empty lines is wrong. It shouldn't -;; look at the next token on subsequent lines. +;;; Code: (eval-when-compile (require 'cl)) +(defgroup smie nil + "Simple Minded Indentation Engine." + :group 'languages) + (defvar comment-continue) (declare-function comment-string-strip "newcomment" (str beforep afterp)) @@ -87,9 +110,9 @@ ;; - a 2 dimensional precedence table (key word "prec2"), is a 2D ;; table recording the precedence relation (can be `<', `=', `>', or ;; nil) between each pair of tokens. -;; - a precedence-level table (key word "levels"), while is a alist +;; - a precedence-level table (key word "grammar"), which is a alist ;; giving for each token its left and right precedence level (a -;; number or nil). This is used in `smie-op-levels'. +;; number or nil). This is used in `smie-grammar'. ;; The prec2 tables are only intermediate data structures: the source ;; code normally provides a mix of BNF and precs tables, and then ;; turns them into a levels table, which is what's used by the rest of @@ -109,7 +132,8 @@ (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))) (puthash key val table)))) -(defun smie-precs-precedence-table (precs) +(put 'smie-precs->prec2 'pure t) +(defun smie-precs->prec2 (precs) "Compute a 2D precedence table from a list of precedences. PRECS should be a list, sorted by precedence (e.g. \"+\" will come before \"*\"), of elements of the form \(left OP ...) @@ -132,6 +156,7 @@ one of those elements share the same precedence level and associativity." (smie-set-prec2tab prec2-table other-op op op1))))))) prec2-table)) +(put 'smie-merge-prec2s 'pure t) (defun smie-merge-prec2s (&rest tables) (if (null (cdr tables)) (car tables) @@ -147,7 +172,13 @@ one of those elements share the same precedence level and associativity." table)) prec2))) -(defun smie-bnf-precedence-table (bnf &rest precs) +(put 'smie-bnf->prec2 'pure t) +(defun smie-bnf->prec2 (bnf &rest precs) + ;; FIXME: Add repetition operator like (repeat <separator> <elems>). + ;; Maybe also add (or <elem1> <elem2>...) for things like + ;; (exp (exp (or "+" "*" "=" ..) exp)). + ;; Basically, make it EBNF (except for the specification of a separator in + ;; the repetition). (let ((nts (mapcar 'car bnf)) ;Non-terminals (first-ops-table ()) (last-ops-table ()) @@ -155,7 +186,7 @@ one of those elements share the same precedence level and associativity." (last-nts-table ()) (prec2 (make-hash-table :test 'equal)) (override (apply 'smie-merge-prec2s - (mapcar 'smie-precs-precedence-table precs))) + (mapcar 'smie-precs->prec2 precs))) again) (dolist (rules bnf) (let ((nt (car rules)) @@ -231,8 +262,9 @@ one of those elements share the same precedence level and associativity." (t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override))) (setq rhs (cdr rhs))))) ;; Keep track of which tokens are openers/closer, so they can get a nil - ;; precedence in smie-prec2-levels. + ;; precedence in smie-prec2->grammar. (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2) + (puthash :smie-closer-alist (smie-bnf-closer-alist bnf) prec2) prec2)) ;; (defun smie-prec2-closer-alist (prec2 include-inners) @@ -314,11 +346,12 @@ from the table, e.g. the table will not include things like (\"if\" . \"else\"). (unless (member term nts) (pushnew (cons (car rhs) term) alist :test #'equal))))))) (nreverse alist))) - + (defun smie-bnf-classify (bnf) "Return a table classifying terminals. Each terminal can either be an `opener', a `closer', or neither." (let ((table (make-hash-table :test #'equal)) + (nts (mapcar #'car bnf)) (alist '())) (dolist (category bnf) (puthash (car category) 'neither table) ;Remove non-terminals. @@ -328,14 +361,22 @@ Each terminal can either be an `opener', a `closer', or neither." (let ((first (pop rhs))) (puthash first (if (memq (gethash first table) '(nil opener)) - 'opener 'neither) + 'opener + (unless (member first nts) + (error "SMIE: token %s is both opener and non-opener" + first)) + 'neither) table)) (while (cdr rhs) (puthash (pop rhs) 'neither table)) ;Remove internals. (let ((last (pop rhs))) (puthash last (if (memq (gethash last table) '(nil closer)) - 'closer 'neither) + 'closer + (unless (member last nts) + (error "SMIE: token %s is both closer and non-closer" + last)) + 'neither) table))))) (maphash (lambda (tok v) (when (memq v '(closer opener)) @@ -359,7 +400,7 @@ CSTS is a list of pairs representing arcs in a graph." (push (cons (car path) (cons (cdr cst) (cdr path))) paths)))))) (cons (car cycle) (nreverse (cdr cycle))))) - + (defun smie-debug--describe-cycle (table cycle) (let ((names (mapcar (lambda (val) @@ -377,16 +418,23 @@ CSTS is a list of pairs representing arcs in a graph." (append names (list (car names))) " < "))) -(defun smie-prec2-levels (prec2) - ;; FIXME: Rather than only return an alist of precedence levels, we should - ;; also extract other useful data from it: - ;; - better default indentation rules (i.e. non-zero indentation after inner - ;; keywords like the "in" of "let..in..end") for smie-indent-after-keyword. - ;; Of course, maybe those things would be even better handled in the - ;; bnf->prec function. +;; (defun smie-check-grammar (grammar prec2 &optional dummy) +;; (maphash (lambda (k v) +;; (when (consp k) +;; (let ((left (nth 2 (assoc (car k) grammar))) +;; (right (nth 1 (assoc (cdr k) grammar)))) +;; (when (and left right) +;; (cond +;; ((< left right) (assert (eq v '<))) +;; ((> left right) (assert (eq v '>))) +;; (t (assert (eq v '=)))))))) +;; prec2)) + +(put 'smie-prec2->grammar 'pure t) +(defun smie-prec2->grammar (prec2) "Take a 2D precedence table and turn it into an alist of precedence levels. -PREC2 is a table as returned by `smie-precs-precedence-table' or -`smie-bnf-precedence-table'." +PREC2 is a table as returned by `smie-precs->prec2' or +`smie-bnf->prec2'." ;; For each operator, we create two "variables" (corresponding to ;; the left and right precedence level), which are represented by ;; cons cells. Those are the very cons cells that appear in the @@ -420,7 +468,7 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or (to (cdar eqs))) (setq eqs (cdr eqs)) (if (eq to from) - nil ;Nothing to do. + nil ;Nothing to do. (dolist (other-eq eqs) (if (eq from (cdr other-eq)) (setcdr other-eq to)) (when (eq from (car other-eq)) @@ -450,6 +498,7 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or ;; left = right). (unless (caar cst) (setcar (car cst) i) + ;; (smie-check-grammar table prec2 'step1) (incf i)) (setq csts (delq cst csts)))) (unless progress @@ -459,37 +508,51 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or (incf i 10)) ;; Propagate equalities back to their source. (dolist (eq (nreverse eqs)) - (assert (or (null (caar eq)) (eq (car eq) (cdr eq)))) - (setcar (car eq) (cadr eq))) - ;; Finally, fill in the remaining vars (which only appeared on the - ;; right side of the < constraints). - (let ((classification-table (gethash :smie-open/close-alist prec2))) - (dolist (x table) - ;; When both sides are nil, it means this operator binds very - ;; very tight, but it's still just an operator, so we give it - ;; the highest precedence. - ;; OTOH if only one side is nil, it usually means it's like an - ;; open-paren, which is very important for indentation purposes, - ;; so we keep it nil if so, to make it easier to recognize. - (unless (or (nth 1 x) - (eq 'opener (cdr (assoc (car x) classification-table)))) - (setf (nth 1 x) i) - (incf i)) ;See other (incf i) above. - (unless (or (nth 2 x) - (eq 'closer (cdr (assoc (car x) classification-table)))) - (setf (nth 2 x) i) - (incf i))))) ;See other (incf i) above. + (when (null (cadr eq)) + ;; There's an equality constraint, but we still haven't given + ;; it a value: that means it binds tighter than anything else, + ;; and it can't be an opener/closer (those don't have equality + ;; constraints). + ;; So set it here rather than below since doing it below + ;; makes it more difficult to obey the equality constraints. + (setcar (cdr eq) i) + (incf i)) + (assert (or (null (caar eq)) (eq (caar eq) (cadr eq)))) + (setcar (car eq) (cadr eq)) + ;; (smie-check-grammar table prec2 'step2) + ) + ;; Finally, fill in the remaining vars (which did not appear on the + ;; left side of any < constraint). + (dolist (x table) + (unless (nth 1 x) + (setf (nth 1 x) i) + (incf i)) ;See other (incf i) above. + (unless (nth 2 x) + (setf (nth 2 x) i) + (incf i)))) ;See other (incf i) above. + ;; Mark closers and openers. + (dolist (x (gethash :smie-open/close-alist prec2)) + (let* ((token (car x)) + (cons (case (cdr x) + (closer (cddr (assoc token table))) + (opener (cdr (assoc token table)))))) + (assert (numberp (car cons))) + (setf (car cons) (list (car cons))))) + (let ((ca (gethash :smie-closer-alist prec2))) + (when ca (push (cons :smie-closer-alist ca) table))) + ;; (smie-check-grammar table prec2 'step3) table)) ;;; Parsing using a precedence level table. -(defvar smie-op-levels 'unset +(defvar smie-grammar 'unset "List of token parsing info. +This list is normally built by `smie-prec2->grammar'. Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL). Parsing is done using an operator precedence parser. -LEFT-LEVEL and RIGHT-LEVEL can be either numbers or nil, where nil +LEFT-LEVEL and RIGHT-LEVEL can be either numbers or a list, where a list means that this operator does not bind on the corresponding side, -i.e. a LEFT-LEVEL of nil means this is a token that behaves somewhat like +e.g. a LEFT-LEVEL of nil means this is a token that behaves somewhat like an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something like a close-paren.") @@ -527,7 +590,7 @@ it should move backward to the beginning of the previous token.") (defun smie--associative-p (toklevels) ;; in "a + b + c" we want to stop at each +, but in ;; "if a then b elsif c then d else c" we don't want to stop at each keyword. - ;; To distinguish the two cases, we made smie-prec2-levels choose + ;; To distinguish the two cases, we made smie-prec2->grammar choose ;; different levels for each part of "if a then b else c", so that ;; by checking if the left-level is equal to the right level, we can ;; figure out that it's an associative operator. @@ -545,6 +608,8 @@ OP-FORW is the accessor to the forward level of the level data. OP-BACK is the accessor to the backward level of the level data. HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the first token we see is an operator, skip over its left-hand-side argument. +HALFSEXP can also be a token, in which case it means to parse as if +we had just successfully passed this token. Possible return values: (FORW-LEVEL POS TOKEN): we couldn't skip TOKEN because its back-level is too high. FORW-LEVEL is the forw-level of TOKEN, @@ -553,11 +618,14 @@ Possible return values: (nil POS TOKEN): we skipped over a paren-like pair. nil: we skipped over an identifier, matched parentheses, ..." (catch 'return - (let ((levels ())) + (let ((levels + (if (stringp halfsexp) + (prog1 (list (cdr (assoc halfsexp smie-grammar))) + (setq halfsexp nil))))) (while (let* ((pos (point)) (token (funcall next-token)) - (toklevels (cdr (assoc token smie-op-levels)))) + (toklevels (cdr (assoc token smie-grammar)))) (cond ((null toklevels) (when (zerop (length token)) @@ -573,9 +641,10 @@ Possible return values: (if (eq pos (point)) ;; We did not move, so let's abort the loop. (throw 'return (list t (point)))))) - ((null (funcall op-back toklevels)) + ((not (numberp (funcall op-back toklevels))) ;; A token like a paren-close. - (assert (funcall op-forw toklevels)) ;Otherwise, why mention it? + (assert (numberp ; Otherwise, why mention it in smie-grammar. + (funcall op-forw toklevels))) (push toklevels levels)) (t (while (and levels (< (funcall op-back toklevels) @@ -583,7 +652,7 @@ Possible return values: (setq levels (cdr levels))) (cond ((null levels) - (if (and halfsexp (funcall op-forw toklevels)) + (if (and halfsexp (numberp (funcall op-forw toklevels))) (push toklevels levels) (throw 'return (prog1 (list (or (car toklevels) t) (point) token) @@ -599,15 +668,15 @@ Possible return values: ;; Keep looking as long as we haven't matched the ;; topmost operator. (levels - (if (funcall op-forw toklevels) + (if (numberp (funcall op-forw toklevels)) (push toklevels levels))) ;; We matched the topmost operator. If the new operator ;; is the last in the corresponding BNF rule, we're done. - ((null (funcall op-forw toklevels)) + ((not (numberp (funcall op-forw toklevels))) ;; It is the last element, let's stop here. (throw 'return (list nil (point) token))) ;; If the new operator is not the last in the BNF rule, - ;; ans is not associative, it's one of the inner operators + ;; and is not associative, it's one of the inner operators ;; (like the "in" in "let .. in .. end"), so keep looking. ((not (smie--associative-p toklevels)) (push toklevels levels)) @@ -630,6 +699,8 @@ Possible return values: "Skip over one sexp. HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the first token we see is an operator, skip over its left-hand-side argument. +HALFSEXP can also be a token, in which case we should skip the text +assuming it is the left-hand-side argument of that token. Possible return values: (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level is too high. LEFT-LEVEL is the left-level of TOKEN, @@ -647,7 +718,9 @@ Possible return values: (defun smie-forward-sexp (&optional halfsexp) "Skip over one sexp. HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the -first token we see is an operator, skip over its left-hand-side argument. +first token we see is an operator, skip over its right-hand-side argument. +HALFSEXP can also be a token, in which case we should skip the text +assuming it is the right-hand-side argument of that token. Possible return values: (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level is too high. RIGHT-LEVEL is the right-level of TOKEN, @@ -699,7 +772,7 @@ Possible return values: (string (cdr (syntax-after (point)))) (let* ((open (funcall smie-forward-token-function)) (closer (cdr (assoc open smie-closer-alist))) - (levels (list (assoc open smie-op-levels))) + (levels (list (assoc open smie-grammar))) (seen '()) (found '())) (cond @@ -708,25 +781,23 @@ Possible return values: ;; intervention, e.g. for Octave's use of `until' ;; as a pseudo-closer of `do'. (closer) - ((or (equal levels '(nil)) (nth 1 (car levels))) + ((or (equal levels '(nil)) (numberp (nth 1 (car levels)))) (error "Doesn't look like a block")) (t - ;; FIXME: With grammars like Octave's, every closer ("end", - ;; "endif", "endwhile", ...) has the same level, so we'd need - ;; to look at the BNF or at least at the 2D prec-table, in - ;; order to find the right closer for a given opener. + ;; Now that smie-setup automatically sets smie-closer-alist + ;; from the BNF, this is not really needed any more. (while levels (let ((level (pop levels))) - (dolist (other smie-op-levels) + (dolist (other smie-grammar) (when (and (eq (nth 2 level) (nth 1 other)) (not (memq other seen))) (push other seen) - (if (nth 2 other) + (if (numberp (nth 2 other)) (push other levels) (push (car other) found)))))) (cond ((null found) (error "No known closer for opener %s" open)) - ;; FIXME: what should we do if there are various closers? + ;; What should we do if there are various closers? (t (car found)))))))))) (unless (save-excursion (skip-chars-backward " \t") (bolp)) (newline)) @@ -752,7 +823,7 @@ This command assumes point is not in a string or comment." (while (let* ((pos (point)) (token (funcall next-token)) - (levels (assoc token smie-op-levels))) + (levels (assoc token smie-grammar))) (cond ((zerop (length token)) (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point))) @@ -762,8 +833,8 @@ This command assumes point is not in a string or comment." (progn (goto-char start) (down-list inc) nil) (forward-sexp inc) (/= (point) pos))) - ((and levels (null (nth (+ 1 offset) levels))) nil) - ((and levels (null (nth (- 2 offset) levels))) + ((and levels (not (numberp (nth (+ 1 offset) levels)))) nil) + ((and levels (not (numberp (nth (- 2 offset) levels)))) (let ((end (point))) (goto-char start) (signal 'scan-error @@ -783,7 +854,8 @@ I.e. a good choice can be: (defcustom smie-blink-matching-inners t "Whether SMIE should blink to matching opener for inner keywords. If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." - :type 'boolean) + :type 'boolean + :group 'smie) (defun smie-blink-matching-check (start end) (save-excursion @@ -803,14 +875,22 @@ If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\" (defun smie-blink-matching-open () "Blink the matching opener when applicable. This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." - (when (and blink-matching-paren - smie-closer-alist ; Optimization. - (eq (char-before) last-command-event) ; Sanity check. - (memq last-command-event smie-blink-matching-triggers) - (not (nth 8 (syntax-ppss)))) - (save-excursion - (let ((pos (point)) - (token (funcall smie-backward-token-function))) + (let ((pos (point)) ;Position after the close token. + token) + (when (and blink-matching-paren + smie-closer-alist ; Optimization. + (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))))) + (memq last-command-event smie-blink-matching-triggers) + (not (nth 8 (syntax-ppss)))) + (save-excursion + (setq token (funcall smie-backward-token-function)) (when (and (eq (point) (1- pos)) (= 1 (length token)) (not (rassoc token smie-closer-alist))) @@ -818,17 +898,20 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'. ;; closers (e.g. ?\; in Octave mode), so go back to the ;; previous token. (setq pos (point)) - (setq token (save-excursion - (funcall smie-backward-token-function)))) + (setq token (funcall smie-backward-token-function))) (when (rassoc token smie-closer-alist) ;; We're after a close token. Let's still make sure we ;; didn't skip a comment to find that token. (funcall smie-forward-token-function) (when (and (save-excursion - ;; Trigger can be SPC, or reindent. - (skip-chars-forward " \n\t") + ;; Skip the trigger char, if applicable. + (if (eq (char-after) last-command-event) + (forward-char 1)) + (if (eq ?\n last-command-event) + ;; Skip any auto-indentation, if applicable. + (skip-chars-forward " \t")) (>= (point) pos)) - ;; If token ends with a trigger char, so don't blink for + ;; If token ends with a trigger char, don't blink for ;; anything else than this trigger char, lest we'd blink ;; both when inserting the trigger char and when ;; inserting a subsequent trigger char like SPC. @@ -836,7 +919,7 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'. (not (memq (char-before) smie-blink-matching-triggers))) (or smie-blink-matching-inners - (null (nth 2 (assoc token smie-op-levels))))) + (not (numberp (nth 2 (assoc token smie-grammar)))))) ;; The major mode might set blink-matching-check-function ;; buffer-locally so that interactive calls to ;; blink-matching-open work right, but let's not presume @@ -848,192 +931,258 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'. (defcustom smie-indent-basic 4 "Basic amount of indentation." - :type 'integer) - -(defvar smie-indent-rules 'unset - ;; TODO: For SML, we need more rule formats, so as to handle - ;; structure Foo = - ;; Bar (toto) - ;; and - ;; structure Foo = - ;; struct ... end - ;; I.e. the indentation after "=" depends on the parent ("structure") - ;; as well as on the following token ("struct"). - "Rules of the following form. -\((:before . TOK) . OFFSET-RULES) how to indent TOK itself. -\(TOK . OFFSET-RULES) how to indent right after TOK. -\(list-intro . TOKENS) declare TOKENS as being followed by what may look like - a funcall but is just a sequence of expressions. -\(t . OFFSET) basic indentation step. -\(args . OFFSET) indentation of arguments. -\((T1 . T2) OFFSET) like ((:before . T2) (:parent T1 OFFSET)). - -OFFSET-RULES is a list of elements which can each either be: - -\(:hanging . OFFSET-RULES) if TOK is hanging, use OFFSET-RULES. -\(:parent PARENT . OFFSET-RULES) if TOK's parent is PARENT, use OFFSET-RULES. -\(:next TOKEN . OFFSET-RULES) if TOK is followed by TOKEN, use OFFSET-RULES. -\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use -\(:bolp . OFFSET-RULES) If TOK is first on a line, use OFFSET-RULES. -OFFSET the offset to use. - -PARENT can be either the name of the parent or a list of such names. - -OFFSET can be of the form: -`point' align with the token. -`parent' align with the parent. -NUMBER offset by NUMBER. -\(+ OFFSETS...) use the sum of OFFSETS. -VARIABLE use the value of VARIABLE as offset. - -The precise meaning of `point' depends on various details: it can -either mean the position of the token we're indenting, or the -position of its parent, or the position right after its parent. - -A nil offset for indentation after an opening token defaults -to `smie-indent-basic'.") - + :type 'integer + :group 'smie) + +(defvar smie-rules-function 'ignore + "Function providing the indentation rules. +It takes two arguments METHOD and ARG where the meaning of ARG +and the expected return value depends on METHOD. +METHOD can be: +- :after, in which case ARG is a token and the function should return the + OFFSET to use for indentation after ARG. +- :before, in which case ARG is a token and the function should return the + OFFSET to use to indent ARG itself. +- :elem, in which case the function should return either: + - the offset to use to indent function arguments (ARG = `arg') + - the basic indentation step (ARG = `basic'). +- :list-intro, in which case ARG is a token and the function should return + non-nil if TOKEN is followed by a list of expressions (not separated by any + token) rather than an expression. + +When ARG is a token, the function is called with point just before that token. +A return value of nil always means to fallback on the default behavior, so the +function should return nil for arguments it does not expect. + +OFFSET can be: +nil use the default indentation rule. +`(column . COLUMN) indent to column COLUMN. +NUMBER offset by NUMBER, relative to a base token + which is the current token for :after and + its parent for :before. + +The functions whose name starts with \"smie-rule-\" are helper functions +designed specifically for use in this function.") + +(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) (defun smie-indent--hanging-p () - ;; A hanging keyword is one that's at the end of a line except it's not at - ;; the beginning of a line. - (and (save-excursion - (when (zerop (length (funcall smie-forward-token-function))) - ;; Could be an open-paren. - (forward-char 1)) - (skip-chars-forward " \t") - (eolp)) - (not (smie-indent--bolp)))) + "Return non-nil if the current token is \"hanging\". +A hanging keyword is one that's at the end of a line except it's not at +the beginning of a line." + (and (not (smie-indent--bolp)) + (save-excursion + (<= (line-end-position) + (progn + (when (zerop (length (funcall smie-forward-token-function))) + ;; Could be an open-paren. + (forward-char 1)) + (skip-chars-forward " \t") + (or (eolp) + (and (looking-at comment-start-skip) + (forward-comment (point-max)))) + (point)))))) +(defalias 'smie-rule-bolp 'smie-indent--bolp) (defun smie-indent--bolp () + "Return non-nil if the current token is the first on the line." (save-excursion (skip-chars-backward " \t") (bolp))) +;; Dynamically scoped. +(defvar smie--parent) (defvar smie--after) (defvar smie--token) + +(defun smie-indent--parent () + (or smie--parent + (save-excursion + (let* ((pos (point)) + (tok (funcall smie-forward-token-function))) + (unless (numberp (cadr (assoc tok smie-grammar))) + (goto-char pos)) + (setq smie--parent + (smie-backward-sexp 'halfsexp)))))) + +(defun smie-rule-parent-p (&rest parents) + "Return non-nil if the current token's parent is among PARENTS. +Only meaningful when called from within `smie-rules-function'." + (member (nth 2 (smie-indent--parent)) parents)) + +(defun smie-rule-next-p (&rest tokens) + "Return non-nil if the next token is among TOKENS. +Only meaningful when called from within `smie-rules-function'." + (let ((next + (save-excursion + (unless smie--after + (smie-indent-forward-token) (setq smie--after (point))) + (goto-char smie--after) + (smie-indent-forward-token)))) + (member (car next) tokens))) + +(defun smie-rule-prev-p (&rest tokens) + "Return non-nil if the previous token is among TOKENS." + (let ((prev (save-excursion + (smie-indent-backward-token)))) + (member (car prev) tokens))) + +(defun smie-rule-sibling-p () + "Return non-nil if the parent is actually a sibling. +Only meaningful when called from within `smie-rules-function'." + (eq (car (smie-indent--parent)) + (cadr (assoc smie--token smie-grammar)))) + +(defun smie-rule-parent (&optional offset) + "Align with parent. +If non-nil, OFFSET should be an integer giving an additional offset to apply. +Only meaningful when called from within `smie-rules-function'." + (save-excursion + (goto-char (cadr (smie-indent--parent))) + (cons 'column + (+ (or offset 0) + ;; Use smie-indent-virtual when indenting relative to an opener: + ;; this will also by default use current-column unless + ;; that opener is hanging, but will additionally consult + ;; rules-function, so it gives it a chance to tweak + ;; indentation (e.g. by forcing indentation relative to + ;; its own parent, as in fn a => fn b => fn c =>). + (if (or (listp (car smie--parent)) (smie-indent--hanging-p)) + (smie-indent-virtual) (current-column)))))) + +(defvar smie-rule-separator-outdent 2) + +(defun smie-indent--separator-outdent () + ;; FIXME: Here we actually have several reasonable behaviors. + ;; E.g. for a parent token of "FOO" and a separator ";" we may want to: + ;; 1- left-align ; with FOO. + ;; 2- right-align ; with FOO. + ;; 3- align content after ; with content after FOO. + ;; 4- align content plus add/remove spaces so as to align ; with FOO. + ;; Currently, we try to align the contents (option 3) which actually behaves + ;; just like option 2 (if the number of spaces after FOO and ; is equal). + (let ((afterpos (save-excursion + (let ((tok (funcall smie-forward-token-function))) + (unless tok + (with-demoted-errors + (error "smie-rule-separator: can't skip token %s" + smie--token)))) + (skip-chars-forward " ") + (unless (eolp) (point))))) + (or (and afterpos + ;; This should always be true, unless + ;; smie-forward-token-function skipped a \n. + (< afterpos (line-end-position)) + (- afterpos (point))) + smie-rule-separator-outdent))) + +(defun smie-rule-separator (method) + "Indent current token as a \"separator\". +By \"separator\", we mean here a token whose sole purpose is to separate +various elements within some enclosing syntactic construct, and which does +not have any semantic significance in itself (i.e. it would typically no exist +as a node in an abstract syntax tree). +Such a token is expected to have an associative syntax and be closely tied +to its syntactic parent. Typical examples are \",\" in lists of arguments +\(enclosed inside parentheses), or \";\" in sequences of instructions (enclosed +in a {..} or begin..end block). +METHOD should be the method name that was passed to `smie-rules-function'. +Only meaningful when called from within `smie-rules-function'." + ;; FIXME: The code below works OK for cases where the separators + ;; are placed consistently always at beginning or always at the end, + ;; but not if some are at the beginning and others are at the end. + ;; I.e. it gets confused in cases such as: + ;; ( a + ;; , a, + ;; b + ;; , c, + ;; d + ;; ) + ;; + ;; Assuming token is associative, the default rule for associative + ;; tokens (which assumes an infix operator) works fine for many cases. + ;; We mostly need to take care of the case where token is at beginning of + ;; line, in which case we want to align it with its enclosing parent. + (cond + ((and (eq method :before) (smie-rule-bolp) (not (smie-rule-sibling-p))) + (let ((parent-col (cdr (smie-rule-parent))) + (parent-pos-col ;FIXME: we knew this when computing smie--parent. + (save-excursion + (goto-char (cadr smie--parent)) + (smie-indent-forward-token) + (forward-comment (point-max)) + (current-column)))) + (cons 'column + (max parent-col + (min parent-pos-col + (- parent-pos-col (smie-indent--separator-outdent))))))) + ((and (eq method :after) (smie-indent--bolp)) + (smie-indent--separator-outdent)))) + (defun smie-indent--offset (elem) - (or (cdr (assq elem smie-indent-rules)) - (cdr (assq t smie-indent-rules)) + (or (funcall smie-rules-function :elem elem) + (if (not (eq elem 'basic)) + (funcall smie-rules-function :elem 'basic)) smie-indent-basic)) -(defvar smie-indent-debug-log) - -(defun smie-indent--offset-rule (tokinfo &optional after parent) - "Apply the OFFSET-RULES in TOKINFO. -Point is expected to be right in front of the token corresponding to TOKINFO. -If computing the indentation after the token, then AFTER is the position -after the token, otherwise it should be nil. -PARENT if non-nil should be the parent info returned by `smie-backward-sexp'." - (let ((rules (cdr tokinfo)) - next prev - offset) - (while (consp rules) - (let ((rule (pop rules))) - (cond - ((not (consp rule)) (setq offset rule)) - ((eq (car rule) '+) (setq offset rule)) - ((eq (car rule) :hanging) - (when (smie-indent--hanging-p) - (setq rules (cdr rule)))) - ((eq (car rule) :bolp) - (when (smie-indent--bolp) - (setq rules (cdr rule)))) - ((eq (car rule) :eolp) - (unless after - (error "Can't use :eolp in :before indentation rules")) - (when (> after (line-end-position)) - (setq rules (cdr rule)))) - ((eq (car rule) :prev) - (unless prev - (save-excursion - (setq prev (smie-indent-backward-token)))) - (when (equal (car prev) (cadr rule)) - (setq rules (cddr rule)))) - ((eq (car rule) :next) - (unless next - (unless after - (error "Can't use :next in :before indentation rules")) - (save-excursion - (goto-char after) - (setq next (smie-indent-forward-token)))) - (when (equal (car next) (cadr rule)) - (setq rules (cddr rule)))) - ((eq (car rule) :parent) - (unless parent - (save-excursion - (if after (goto-char after)) - (setq parent (smie-backward-sexp 'halfsexp)))) - (when (if (listp (cadr rule)) - (member (nth 2 parent) (cadr rule)) - (equal (nth 2 parent) (cadr rule))) - (setq rules (cddr rule)))) - (t (error "Unknown rule %s for indentation of %s" - rule (car tokinfo)))))) - ;; If `offset' is not set yet, use `rules' to handle the case where - ;; the tokinfo uses the old-style ((PARENT . TOK). OFFSET). - (unless offset (setq offset rules)) - (when (boundp 'smie-indent-debug-log) - (push (list (point) offset tokinfo) smie-indent-debug-log)) - offset)) - -(defun smie-indent--column (offset &optional base parent virtual-point) - "Compute the actual column to use for a given OFFSET. -BASE is the base position to use, and PARENT is the parent info, if any. -If VIRTUAL-POINT is non-nil, then `point' is virtual." - (cond - ((eq (car-safe offset) '+) - (apply '+ (mapcar (lambda (offset) (smie-indent--column offset nil parent)) - (cdr offset)))) - ((integerp offset) - (+ offset - (case base - ((nil) 0) - (parent (goto-char (cadr parent)) - (smie-indent-virtual)) - (t - (goto-char base) - ;; For indentation after "(let" in SML-mode, we end up accumulating - ;; the offset of "(" and the offset of "let", so we use `min' to try - ;; and get it right either way. - (min (smie-indent-virtual) (current-column)))))) - ((eq offset 'point) - ;; In indent-keyword, if we're indenting `then' wrt `if', we want to use - ;; indent-virtual rather than use just current-column, so that we can - ;; apply the (:before . "if") rule which does the "else if" dance in SML. - ;; But in other cases, we do not want to use indent-virtual - ;; (e.g. indentation of "*" w.r.t "+", or ";" wrt "("). We could just - ;; always use indent-virtual and then have indent-rules say explicitly - ;; to use `point' after things like "(" or "+" when they're not at EOL, - ;; but you'd end up with lots of those rules. - ;; So we use a heuristic here, which is that we only use virtual if - ;; the parent is tightly linked to the child token (they're part of - ;; the same BNF rule). - (if (and virtual-point (null (car parent))) ;Black magic :-( - (smie-indent-virtual) (current-column))) - ((eq offset 'parent) - (unless parent - (setq parent (or (smie-backward-sexp 'halfsexp) :notfound))) - (if (consp parent) (goto-char (cadr parent))) - (smie-indent-virtual)) - ((eq offset nil) nil) - ((and (symbolp offset) (boundp 'offset)) - (smie-indent--column (symbol-value offset) base parent virtual-point)) - (t (error "Unknown indentation offset %s" offset)))) +(defun smie-indent--rule (method token + ;; FIXME: Too many parameters. + &optional after parent base-pos) + "Compute indentation column according to `indent-rule-functions'. +METHOD and TOKEN are passed to `indent-rule-functions'. +AFTER is the position after TOKEN, if known. +PARENT is the parent info returned by `smie-backward-sexp', if known. +BASE-POS is the position relative to which offsets should be applied." + ;; This is currently called in 3 cases: + ;; - :before opener, where rest=nil but base-pos could as well be parent. + ;; - :before other, where + ;; ; after=nil + ;; ; parent is set + ;; ; base-pos=parent + ;; - :after tok, where + ;; ; after is set; parent=nil; base-pos=point; + (save-excursion + (let ((offset + (let ((smie--parent parent) + (smie--token token) + (smie--after after)) + (funcall smie-rules-function method token)))) + (cond + ((not offset) nil) + ((eq (car-safe offset) 'column) (cdr offset)) + ((integerp offset) + (+ offset + (if (null base-pos) 0 + (goto-char base-pos) + ;; Use smie-indent-virtual when indenting relative to an opener: + ;; this will also by default use current-column unless + ;; that opener is hanging, but will additionally consult + ;; rules-function, so it gives it a chance to tweak indentation + ;; (e.g. by forcing indentation relative to its own parent, as in + ;; fn a => fn b => fn c =>). + ;; When parent==nil it doesn't matter because the only case + ;; where it's really used is when the base-pos is hanging anyway. + (if (or (and parent (null (car parent))) + (smie-indent--hanging-p)) + (smie-indent-virtual) (current-column))))) + (t (error "Unknown indentation offset %s" offset)))))) (defun smie-indent-forward-token () "Skip token forward and return it, along with its levels." (let ((tok (funcall smie-forward-token-function))) (cond - ((< 0 (length tok)) (assoc tok smie-op-levels)) - ((looking-at "\\s(") + ((< 0 (length tok)) (assoc tok smie-grammar)) + ((looking-at "\\s(\\|\\s)\\(\\)") (forward-char 1) - (list (buffer-substring (1- (point)) (point)) nil 0))))) + (cons (buffer-substring (1- (point)) (point)) + (if (match-end 1) '(0 nil) '(nil 0))))))) (defun smie-indent-backward-token () "Skip token backward and return it, along with its levels." - (let ((tok (funcall smie-backward-token-function))) + (let ((tok (funcall smie-backward-token-function)) + class) (cond - ((< 0 (length tok)) (assoc tok smie-op-levels)) - ;; 4 == Open paren syntax. - ((eq 4 (syntax-class (syntax-after (1- (point))))) + ((< 0 (length tok)) (assoc tok smie-grammar)) + ;; 4 == open paren syntax, 5 == close. + ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5)) (forward-char -1) - (list (buffer-substring (point) (1+ (point))) nil 0))))) + (cons (buffer-substring (point) (1+ (point))) + (if (eq class 4) '(nil 0) '(0 nil))))))) (defun smie-indent-virtual () ;; We used to take an optional arg (with value :not-hanging) to specify that @@ -1079,54 +1228,48 @@ in order to figure out the indentation of some other (further down) point." (smie-indent-virtual)) ;:not-hanging (scan-error nil))))) -(defun smie-indent-keyword () - ;; Align closing token with the corresponding opening one. - ;; (e.g. "of" with "case", or "in" with "let"). +(defun smie-indent-keyword (&optional token) + "Indent point based on the token that follows it immediately. +If TOKEN is non-nil, assume that that is the token that follows point. +Returns either a column number or nil if it considers that indentation +should not be computed on the basis of the following token." (save-excursion (let* ((pos (point)) - (toklevels (smie-indent-forward-token)) - (token (pop toklevels))) - (if (null (car toklevels)) - (save-excursion - (goto-char pos) - ;; Different cases: - ;; - smie-indent--bolp: "indent according to others". - ;; - common hanging: "indent according to others". - ;; - SML-let hanging: "indent like parent". - ;; - if-after-else: "indent-like parent". - ;; - middle-of-line: "trust current position". - (cond - ((null (cdr toklevels)) nil) ;Not a keyword. - ((smie-indent--bolp) - ;; For an open-paren-like thingy at BOL, always indent only - ;; based on other rules (typically smie-indent-after-keyword). - nil) - (t - ;; We're only ever here for virtual-indent, which is why - ;; we can use (current-column) as answer for `point'. - (let* ((tokinfo (or (assoc (cons :before token) - smie-indent-rules) - ;; By default use point unless we're hanging. - `((:before . ,token) (:hanging nil) point))) - ;; (after (prog1 (point) (goto-char pos))) - (offset (smie-indent--offset-rule tokinfo))) - (smie-indent--column offset))))) - + (toklevels + (if token + (assoc token smie-grammar) + (let* ((res (smie-indent-forward-token))) + ;; Ignore tokens on subsequent lines. + (if (and (< pos (line-beginning-position)) + ;; Make sure `token' also *starts* on another line. + (save-excursion + (smie-indent-backward-token) + (< pos (line-beginning-position)))) + nil + (goto-char pos) + res))))) + (setq token (pop toklevels)) + (cond + ((null (cdr toklevels)) nil) ;Not a keyword. + ((not (numberp (car toklevels))) + ;; Different cases: + ;; - smie-indent--bolp: "indent according to others". + ;; - common hanging: "indent according to others". + ;; - SML-let hanging: "indent like parent". + ;; - if-after-else: "indent-like parent". + ;; - middle-of-line: "trust current position". + (cond + ((smie-indent--rule :before token)) + ((smie-indent--bolp) ;I.e. non-virtual indent. + ;; For an open-paren-like thingy at BOL, always indent only + ;; based on other rules (typically smie-indent-after-keyword). + nil) + (t + ;; By default use point unless we're hanging. + (unless (smie-indent--hanging-p) (current-column))))) + (t ;; FIXME: This still looks too much like black magic!! - ;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we - ;; want a single rule for TOKEN with different cases for each PARENT. - (let* ((parent (smie-backward-sexp 'halfsexp)) - (tokinfo - (or (assoc (cons (caddr parent) token) - smie-indent-rules) - (assoc (cons :before token) smie-indent-rules) - ;; Default rule. - `((:before . ,token) - ;; (:parent open 0) - point))) - (offset (save-excursion - (goto-char pos) - (smie-indent--offset-rule tokinfo nil parent)))) + (let* ((parent (smie-backward-sexp token))) ;; Different behaviors: ;; - align with parent. ;; - parent + offset. @@ -1149,21 +1292,15 @@ in order to figure out the indentation of some other (further down) point." ;; maybe when an infix or close-paren is at the beginning ;; of a buffer. nil) + ((save-excursion + (goto-char pos) + (smie-indent--rule :before token nil parent (cadr parent)))) ((eq (car parent) (car toklevels)) - ;; We bumped into a same-level operator. align with it. + ;; We bumped into a same-level operator; align with it. (if (and (smie-indent--bolp) (/= (point) pos) (save-excursion (goto-char (goto-char (cadr parent))) - (not (smie-indent--bolp))) - ;; Check the offset of `token' rather then its parent - ;; because its parent may have used a special rule. E.g. - ;; function foo; - ;; line2; - ;; line3; - ;; The ; on the first line had a special rule, but when - ;; indenting line3, we don't care about it and want to - ;; align with line2. - (memq offset '(point nil))) + (not (smie-indent--bolp)))) ;; If the parent is at EOL and its children are indented like ;; itself, then we can just obey the indentation chosen for the ;; child. @@ -1190,19 +1327,27 @@ in order to figure out the indentation of some other (further down) point." ;; -> d ;; So as to align with the earliest appropriate place. (smie-indent-virtual))) - (tokinfo - (if (and (= (point) pos) (smie-indent--bolp) - (or (eq offset 'point) - (and (consp offset) (memq 'point offset)))) + (t + (if (and (= (point) pos) (smie-indent--bolp)) ;; Since we started at BOL, we're not computing a virtual ;; indentation, and we're still at the starting point, so ;; we can't use `current-column' which would cause - ;; indentation to depend on itself. + ;; indentation to depend on itself and we can't use + ;; smie-indent-virtual since that would be an inf-loop. nil - (smie-indent--column offset 'parent parent - ;; If we're still at pos, indent-virtual - ;; will inf-loop. - (unless (= (point) pos) 'virtual)))))))))) + ;; In indent-keyword, if we're indenting `then' wrt `if', we + ;; want to use indent-virtual rather than use just + ;; current-column, so that we can apply the (:before . "if") + ;; rule which does the "else if" dance in SML. But in other + ;; cases, we do not want to use indent-virtual (e.g. indentation + ;; of "*" w.r.t "+", or ";" wrt "("). We could just always use + ;; indent-virtual and then have indent-rules say explicitly to + ;; use `point' after things like "(" or "+" when they're not at + ;; EOL, but you'd end up with lots of those rules. + ;; So we use a heuristic here, which is that we only use virtual + ;; if the parent is tightly linked to the child token (they're + ;; part of the same BNF rule). + (if (car parent) (current-column) (smie-indent-virtual))))))))))) (defun smie-indent-comment () "Compute indentation of a comment." @@ -1240,10 +1385,19 @@ in order to figure out the indentation of some other (further down) point." comment-end-skip (not (looking-at " \t*$")) ;Not just a \n comment-closer. (looking-at comment-end-skip) - (nth 4 (syntax-ppss)) - (save-excursion - (goto-char (nth 8 (syntax-ppss))) - (current-column)))) + (let ((end (match-string 0))) + (and (nth 4 (syntax-ppss)) + (save-excursion + (goto-char (nth 8 (syntax-ppss))) + (and (looking-at comment-start-skip) + (let ((start (match-string 0))) + ;; Align the common substring between starter + ;; and ender, if possible. + (if (string-match "\\(.+\\).*\n\\(.*?\\)\\1" + (concat start "\n" end)) + (+ (current-column) (match-beginning 0) + (- (match-beginning 2) (match-end 2))) + (current-column))))))))) (defun smie-indent-comment-inside () (and (nth 4 (syntax-ppss)) @@ -1254,27 +1408,18 @@ in order to figure out the indentation of some other (further down) point." (save-excursion (let* ((pos (point)) (toklevel (smie-indent-backward-token)) - (tok (car toklevel)) - (tokinfo (assoc tok smie-indent-rules))) - ;; Set some default indent rules. - (if (and toklevel (null (cadr toklevel)) (null tokinfo)) - (setq tokinfo (list (car toklevel)))) - ;; (if (and tokinfo (null toklevel)) - ;; (error "Token %S has indent rule but has no parsing info" tok)) - (when toklevel - (unless tokinfo - ;; The default indentation after a keyword/operator is 0 for - ;; infix and t for prefix. - ;; Using the BNF syntax, we could come up with better - ;; defaults, but we only have the precedence levels here. - (setq tokinfo (list tok 'default-rule - (if (cadr toklevel) 0 (smie-indent--offset t))))) - (let ((offset - (or (smie-indent--offset-rule tokinfo pos) - (smie-indent--offset t)))) - (let ((before (point))) - (goto-char pos) - (smie-indent--column offset before))))))) + (tok (car toklevel))) + (cond + ((null toklevel) nil) + ((smie-indent--rule :after tok pos nil (point))) + ;; The default indentation after a keyword/operator is + ;; 0 for infix, t for prefix, and use another rule + ;; for postfix. + ((not (numberp (nth 2 toklevel))) nil) ;A closer. + ((or (not (numberp (nth 1 toklevel))) ;An opener. + (rassoc tok smie-closer-alist)) ;An inner. + (+ (smie-indent-virtual) (smie-indent--offset 'basic))) ; + (t (smie-indent-virtual)))))) ;An infix. (defun smie-indent-exps () ;; Indentation of sequences of simple expressions without @@ -1301,9 +1446,10 @@ in order to figure out the indentation of some other (further down) point." (save-excursion ;; Figure out if the atom we just skipped is an argument rather ;; than a function. - (setq arg (or (null (car (smie-backward-sexp))) - (member (funcall smie-backward-token-function) - (cdr (assoc 'list-intro smie-indent-rules)))))) + (setq arg + (or (null (car (smie-backward-sexp))) + (funcall smie-rules-function :list-intro + (funcall smie-backward-token-function))))) (cond ((null positions) ;; We're the first expression of the list. In that case, the @@ -1322,7 +1468,6 @@ in order to figure out the indentation of some other (further down) point." (positions ;; We're the first arg. (goto-char (car positions)) - ;; FIXME: Use smie-indent--column. (+ (smie-indent--offset 'args) ;; We used to use (smie-indent-virtual), but that ;; doesn't seem right since it might then indent args less than @@ -1331,9 +1476,9 @@ in order to figure out the indentation of some other (further down) point." (defvar smie-indent-functions '(smie-indent-fixindent smie-indent-bob smie-indent-close - smie-indent-comment smie-indent-comment-continue smie-indent-comment-close - smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword - smie-indent-exps) + smie-indent-comment smie-indent-comment-continue smie-indent-comment-close + smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword + smie-indent-exps) "Functions to compute the indentation. Each function is called with no argument, shouldn't move point, and should return either nil if it has no opinion, or an integer representing the column @@ -1347,13 +1492,13 @@ to which that point should be aligned, if we were to reindent it.") "Indent current line using the SMIE indentation engine." (interactive) (let* ((savep (point)) - (indent (condition-case-no-debug nil - (save-excursion - (forward-line 0) - (skip-chars-forward " \t") - (if (>= (point) savep) (setq savep nil)) - (or (smie-indent-calculate) 0)) - (error 0)))) + (indent (or (with-demoted-errors + (save-excursion + (forward-line 0) + (skip-chars-forward " \t") + (if (>= (point) savep) (setq savep nil)) + (or (smie-indent-calculate) 0))) + 0))) (if (not (numberp indent)) ;; If something funny is used (e.g. `noindent'), return it. indent @@ -1362,18 +1507,51 @@ to which that point should be aligned, if we were to reindent it.") (save-excursion (indent-line-to indent)) (indent-line-to indent))))) -(defun smie-indent-debug () - "Show the rules used to compute indentation of current line." - (interactive) - (let ((smie-indent-debug-log '())) - (smie-indent-calculate) - ;; FIXME: please improve! - (message "%S" smie-indent-debug-log))) - -(defun smie-setup (op-levels indent-rules) - (set (make-local-variable 'smie-indent-rules) indent-rules) - (set (make-local-variable 'smie-op-levels) op-levels) - (set (make-local-variable 'indent-line-function) 'smie-indent-line)) +(defun smie-setup (grammar rules-function &rest keywords) + "Setup SMIE navigation and indentation. +GRAMMAR is a grammar table generated by `smie-prec2->grammar'. +RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'. +KEYWORDS are additional arguments, which can use the following keywords: +- :forward-token FUN +- :backward-token FUN" + (set (make-local-variable 'smie-rules-function) rules-function) + (set (make-local-variable 'smie-grammar) grammar) + (set (make-local-variable 'indent-line-function) 'smie-indent-line) + (set (make-local-variable 'forward-sexp-function) + 'smie-forward-sexp-command) + (while keywords + (let ((k (pop keywords)) + (v (pop keywords))) + (case k + (:forward-token + (set (make-local-variable 'smie-forward-token-function) v)) + (:backward-token + (set (make-local-variable 'smie-backward-token-function) v)) + (t (message "smie-setup: ignoring unknown keyword %s" k))))) + (let ((ca (cdr (assq :smie-closer-alist grammar)))) + (when ca + (set (make-local-variable 'smie-closer-alist) ca) + ;; Only needed for interactive calls to blink-matching-open. + (set (make-local-variable 'blink-matching-check-function) + #'smie-blink-matching-check) + (add-hook 'post-self-insert-hook + #'smie-blink-matching-open 'append 'local) + (set (make-local-variable 'smie-blink-matching-triggers) + (append smie-blink-matching-triggers + ;; Rather than wait for SPC to blink, try to blink as + ;; soon as we type the last char of a block ender. + (let ((closers (sort (mapcar #'cdr smie-closer-alist) + #'string-lessp)) + (triggers ()) + closer) + (while (setq closer (pop closers)) + (unless (and closers + ;; FIXME: this eliminates prefixes of other + ;; closers, but we should probably elimnate + ;; prefixes of other keywords as well. + (string-prefix-p closer (car closers))) + (push (aref closer (1- (length closer))) triggers))) + (delete-dups triggers))))))) (provide 'smie) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 6ae6a86857e..b12d9068676 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -93,31 +93,20 @@ fire each time Emacs is idle for that many seconds." More precisely, the next value, after TIME, that is an integral multiple of SECS seconds since the epoch. SECS may be a fraction." (let ((time-base (ash 1 16))) - (if (fboundp 'atan) - ;; Use floating point, taking care to not lose precision. - (let* ((float-time-base (float time-base)) - (million 1000000.0) - (time-usec (+ (* million - (+ (* float-time-base (nth 0 time)) - (nth 1 time))) - (nth 2 time))) - (secs-usec (* million secs)) - (mod-usec (mod time-usec secs-usec)) - (next-usec (+ (- time-usec mod-usec) secs-usec)) - (time-base-million (* float-time-base million))) - (list (floor next-usec time-base-million) - (floor (mod next-usec time-base-million) million) - (floor (mod next-usec million)))) - ;; Floating point is not supported. - ;; Use integer arithmetic, avoiding overflow if possible. - (let* ((mod-sec (mod (+ (* (mod time-base secs) - (mod (nth 0 time) secs)) - (nth 1 time)) - secs)) - (next-1-sec (+ (- (nth 1 time) mod-sec) secs))) - (list (+ (nth 0 time) (floor next-1-sec time-base)) - (mod next-1-sec time-base) - 0))))) + ;; Use floating point, taking care to not lose precision. + (let* ((float-time-base (float time-base)) + (million 1000000.0) + (time-usec (+ (* million + (+ (* float-time-base (nth 0 time)) + (nth 1 time))) + (nth 2 time))) + (secs-usec (* million secs)) + (mod-usec (mod time-usec secs-usec)) + (next-usec (+ (- time-usec mod-usec) secs-usec)) + (time-base-million (* float-time-base million))) + (list (floor next-usec time-base-million) + (floor (mod next-usec time-base-million) million) + (floor (mod next-usec million)))))) (defun timer-relative-time (time secs &optional usecs) "Advance TIME by SECS seconds and optionally USECS microseconds. @@ -543,5 +532,4 @@ If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." (provide 'timer) -;; arch-tag: b1a9237b-7787-4382-9e46-8f2c3b3273e0 ;;; timer.el ends here diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el index 851a1f7652b..a62f8de4010 100644 --- a/lisp/emacs-lisp/unsafep.el +++ b/lisp/emacs-lisp/unsafep.el @@ -101,15 +101,13 @@ in the parse.") (dolist (x '(;;Special forms and catch if or prog1 prog2 progn while unwind-protect ;;Safe subrs that have some side-effects - ding error message minibuffer-message random read-minibuffer - signal sleep-for string-match throw y-or-n-p yes-or-no-p + ding error random signal sleep-for string-match throw ;;Defsubst functions from subr.el caar cadr cdar cddr ;;Macros from subr.el - save-match-data unless when with-temp-message + save-match-data unless when ;;Functions from subr.el that have side effects - read-passwd split-string replace-regexp-in-string - play-sound-file)) + split-string replace-regexp-in-string play-sound-file)) (put x 'safe-function t)) ;;;###autoload diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index f088706afb0..bc64608a284 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1,7 +1,7 @@ ;;; cua-base.el --- emulate CUA key bindings -;; 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: Kim F. Storm <storm@cua.dk> ;; Keywords: keyboard emulations convenience cua @@ -300,8 +300,7 @@ is not turned on." :type 'boolean :group 'cua) -(defcustom cua-prefix-override-inhibit-delay - (if (featurep 'lisp-float-type) (/ (float 1) (float 5)) nil) +(defcustom cua-prefix-override-inhibit-delay 0.2 "If non-nil, time in seconds to delay before overriding prefix key. If there is additional input within this time, the prefix key is used as a normal prefix key. So typing a key sequence quickly will @@ -1637,5 +1636,4 @@ shifted movement key, set `cua-highlight-region-shift-only'." (provide 'cua-base) -;; arch-tag: 21fb6289-ba25-4fee-bfdc-f9fb351acf05 ;;; cua-base.el ends here diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 1e017075d84..bfed09e0df3 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -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 @@ Argument NUM is the number of lines to move." (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 @@ Argument NUM is the number of lines to move." "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 @@ Optional argument FIND is t if this function is called from `edt-find'." (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 BOTTOM is the bottom margin in number of lines or percent of window." 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." 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 sentences to move." 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." 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 @@ G-C-\\: Split Window | FNDNXT | Yank | CUT | (provide 'edt) -;; arch-tag: 18d1c54f-6900-4078-8bbc-7c2292f48941 ;;; edt.el ends here diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index bcd67d4aff7..f77cf23d81e 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -2438,7 +2438,7 @@ If FILE is nil, try to load a default file. The default file names are ;;;### (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" "\ diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el index dbad4f787a0..311b8e2516d 100644 --- a/lisp/emulation/tpu-extras.el +++ b/lisp/emulation/tpu-extras.el @@ -276,36 +276,41 @@ Prefix argument serves as repeat count." ;;; 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 @@ A repeat count means move that many paragraphs." "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 @@ A repeat count means scroll that many sections." (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 @@ A repeat count means scroll that many sections." ;; generated-autoload-file: "tpu-edt.el" ;; End: -;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a ;;; tpu-extras.el ends here diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 07719ba45be..4e90889ddd0 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -1,7 +1,7 @@ ;;; viper-cmd.el --- Vi command support 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 @@ -42,7 +42,7 @@ (defvar quail-current-str) (defvar mark-even-if-inactive) (defvar init-message) -(defvar initial) +(defvar viper-initial) (defvar undo-beg-posn) (defvar undo-end-posn) @@ -2065,23 +2065,22 @@ Undo previous insertion and inserts new." (funcall hook) )) -;; Thie is a temp hook that uses free variables init-message and initial. +;; This is a temp hook that uses free variables init-message and viper-initial. ;; A dirty feature, but it is the simplest way to have it do the right thing. -;; The INIT-MESSAGE and INITIAL vars come from the scope set by +;; The INIT-MESSAGE and VIPER-INITIAL vars come from the scope set by ;; viper-read-string-with-history (defun viper-minibuffer-standard-hook () (if (stringp init-message) (viper-tmp-insert-at-eob init-message)) - (if (stringp initial) - (progn - ;; don't wait if we have unread events or in kbd macro - (or unread-command-events - executing-kbd-macro - (sit-for 840)) - (if (fboundp 'minibuffer-prompt-end) - (delete-region (minibuffer-prompt-end) (point-max)) - (erase-buffer)) - (insert initial)))) + (when (stringp viper-initial) + ;; don't wait if we have unread events or in kbd macro + (or unread-command-events + executing-kbd-macro + (sit-for 840)) + (if (fboundp 'minibuffer-prompt-end) + (delete-region (minibuffer-prompt-end) (point-max)) + (erase-buffer)) + (insert viper-initial))) (defsubst viper-minibuffer-real-start () (if (fboundp 'minibuffer-prompt-end) @@ -2180,10 +2179,10 @@ problems." ;;; Reading string with history -(defun viper-read-string-with-history (prompt &optional initial +(defun viper-read-string-with-history (prompt &optional viper-initial history-var default keymap init-message) - ;; Read string, prompting with PROMPT and inserting the INITIAL + ;; Read string, prompting with PROMPT and inserting the VIPER-INITIAL ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the ;; input is an empty string. ;; Default value is displayed until the user types something in the @@ -2206,14 +2205,14 @@ problems." temp-msg) (setq keymap (or keymap minibuffer-local-map) - initial (or initial "") + viper-initial (or viper-initial "") temp-msg (if default (format "(default %s) " default) "")) (setq viper-incomplete-ex-cmd nil) (setq val (read-from-minibuffer prompt - (concat temp-msg initial val padding) + (concat temp-msg viper-initial val padding) keymap nil history-var)) (setq minibuffer-setup-hook nil padding (viper-array-to-string (this-command-keys)) @@ -3499,11 +3498,8 @@ controlled by the sign of prefix numeric value." (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)) @@ -4626,9 +4622,7 @@ One can use `` and '' to temporarily jump 1 step back." (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 @@ -4712,9 +4706,7 @@ One can use `` and '' to temporarily jump 1 step back." (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) @@ -5093,5 +5085,4 @@ Mail anyway (y or n)? ") -;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2 ;;; viper-cmd.el ends here diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index ebd18d47e15..5af96922171 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -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) @@ -784,7 +785,7 @@ Related buffers can be cycled through via :R and :P commands." ;; These two vars control the interaction of jumps performed by ' and `. ;; In this new version, '' doesn't erase the marks set by ``, so one can -;; use both kinds of jumps interchangeably and without loosing positions +;; use both kinds of jumps interchangeably and without losing positions ;; inside the lines. ;; Remembers position of the last jump done using ``'. @@ -996,5 +997,4 @@ on a dumb terminal." ;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) ;; End: -;; arch-tag: 4efa2416-1fcb-4690-be10-1a2a0248d250 ;;; viper-init.el ends here diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 09b30868115..ab47cbf60bc 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -117,23 +117,29 @@ Don't use this command in Lisp programs!" (save-excursion (let ((verbose current-prefix-arg) (context (epg-make-context epa-protocol)) - recipients recipient-key) + recipients-string recipients recipient-key) (goto-char (point-min)) (save-restriction (narrow-to-region (point) (if (search-forward mail-header-separator nil 0) (match-beginning 0) (point))) + (setq recipients-string + (mapconcat #'identity + (nconc (mail-fetch-field "to" nil nil t) + (mail-fetch-field "cc" nil nil t) + (mail-fetch-field "bcc" nil nil t)) + ",")) (setq recipients (mail-strip-quoted-names - (mapconcat #'identity - (nconc (mail-fetch-field "to" nil nil t) - (mail-fetch-field "cc" nil nil t) - (mail-fetch-field "bcc" nil nil t)) - ",")))) + (with-temp-buffer + (insert "to: " recipients-string "\n") + (expand-mail-aliases (point-min) (point-max)) + (car (mail-fetch-field "to" nil nil t)))))) (if recipients (setq recipients (delete "" - (split-string recipients "[ \t\n]+")))) + (split-string recipients + "[ \t\n]*,[ \t\n]*")))) (goto-char (point-min)) (if (search-forward mail-header-separator nil t) (forward-line)) @@ -154,7 +160,9 @@ If no one is selected, symmetric encryption will be performed. " (epa-mail--find-usable-key (epg-list-keys (epg-make-context epa-protocol) - (concat "<" recipient ">")) + (if (string-match "@" recipient) + (concat "<" recipient ">") + recipient)) 'encrypt)) (unless (or recipient-key (y-or-n-p diff --git a/lisp/epa.el b/lisp/epa.el index ca0f07d5bae..687a31a8c3a 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -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 @@ If ARG is non-nil, mark the key." '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 @@ between START and END." (provide 'epa) -;; arch-tag: 38d20ced-20d5-4137-b17a-f206335423d7 ;;; epa.el ends here diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 37c5d01fb1d..a439fa0480e 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -37,7 +37,9 @@ :version "23.1" :group 'data) -(defcustom epg-gpg-program "gpg" +(defcustom epg-gpg-program (or (executable-find "gpg") + (executable-find "gpg2") + "gpg") "The `gpg' executable." :group 'epg :type 'string) diff --git a/lisp/epg.el b/lisp/epg.el index fae896c4ae0..a1541361b4b 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -67,7 +67,7 @@ (defconst epg-digest-algorithm-alist '((1 . "MD5") (2 . "SHA1") - (3 . "RMD160") + (3 . "RIPEMD160") (8 . "SHA256") (9 . "SHA384") (10 . "SHA512") @@ -337,7 +337,13 @@ PASSPHRASE-CALLBACK is either a function, or a cons-cell whose car is a function and cdr is a callback data. The function gets three arguments: the context, the key-id in -question, and the callback data (if any)." +question, and the callback data (if any). + +The callback may not be called if you use GnuPG 2.x, which relies +on the external program called `gpg-agent' for passphrase query. +If you really want to intercept passphrase query, consider +installing GnuPG 1.x _along with_ GnuPG 2.x, which does passphrase +query by itself and Emacs can intercept them." (unless (eq (car-safe context) 'epg-context) (signal 'wrong-type-argument (list 'epg-context-p context))) (aset (cdr context) 7 (if (consp passphrase-callback) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 81bdf5446ec..210f6985dc9 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,19 @@ +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. + (erc-decode-string-from-target): Use it. + +2010-10-24 Julien Danjou <julien@danjou.info> + + * erc-backend.el (erc-server-JOIN): Set the correct target list on join. + + * erc-backend.el (erc-process-sentinel): Check that buffer is alive + before setting it as current buffer. + 2010-10-14 Juanma Barranquero <lekktu@gmail.com> * erc-xdcc.el (erc-xdcc-help-text): Fix typo in docstring. diff --git a/lisp/erc/ChangeLog.06 b/lisp/erc/ChangeLog.06 index 9ca4396e88a..a1a196b79aa 100644 --- a/lisp/erc/ChangeLog.06 +++ b/lisp/erc/ChangeLog.06 @@ -174,7 +174,7 @@ * erc-nicklist.el (erc-nicklist-insert-contents): Add missing parenthesis. Thanks to Stephan Stahl for the report. -2006-09-10 Eric Hanchrow <offby1@blarg.net> (tiny change) +2006-09-10 Eric Hanchrow <offby1@blarg.net> * erc.el (erc-cmd-IGNORE): Prompt user if this might be a regexp instead of a single user. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9a237d47d55..3bc56989f4f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -324,6 +324,13 @@ Good luck." :type 'integer :group 'erc-server) +(defcustom erc-coding-system-precedence '(utf-8 undecided) + "List of coding systems to be preferred when receiving a string from the server. +This will only be consulted if the coding system in +`erc-server-coding-system' is `undecided'." + :group 'erc-server + :type '(repeat coding-system)) + (defcustom erc-server-coding-system (if (and (fboundp 'coding-system-p) (coding-system-p 'undecided) (coding-system-p 'utf-8)) @@ -334,7 +341,9 @@ This is either a coding system, a cons, a function, or nil. If a cons, the encoding system for outgoing text is in the car and the decoding system for incoming text is in the cdr. The most -interesting use for this is to put `undecided' in the cdr. +interesting use for this is to put `undecided' in the cdr. This +means that `erc-coding-system-precedence' will be consulted, and the +first match there will be used. If a function, it is called with the argument `target' and should return a coding system or a cons as described above. @@ -653,30 +662,31 @@ Conditionally try to reconnect and take appropriate action." (defun erc-process-sentinel (cproc event) "Sentinel function for ERC process." - (with-current-buffer (process-buffer cproc) - (erc-log (format - "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" - cproc (process-status cproc) event erc-server-quitting)) - (if (string-match "^open" event) - ;; newly opened connection (no wait) - (erc-login) - ;; assume event is 'failed - (let ((buf (process-buffer cproc))) - (erc-with-all-buffers-of-server cproc nil - (setq erc-server-connected nil)) - (when erc-server-ping-handler - (progn (erc-cancel-timer erc-server-ping-handler) - (setq erc-server-ping-handler nil))) - (run-hook-with-args 'erc-disconnected-hook - (erc-current-nick) (system-name) "") - ;; Remove the prompt - (goto-char (or (marker-position erc-input-marker) (point-max))) - (forward-line 0) - (erc-remove-text-properties-region (point) (point-max)) - (delete-region (point) (point-max)) - ;; Decide what to do with the buffer - ;; Restart if disconnected - (erc-process-sentinel-1 event buf))))) + (let ((buf (process-buffer cproc))) + (when (buffer-live-p buf) + (with-current-buffer buf + (erc-log (format + "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" + cproc (process-status cproc) event erc-server-quitting)) + (if (string-match "^open" event) + ;; newly opened connection (no wait) + (erc-login) + ;; assume event is 'failed + (erc-with-all-buffers-of-server cproc nil + (setq erc-server-connected nil)) + (when erc-server-ping-handler + (progn (erc-cancel-timer erc-server-ping-handler) + (setq erc-server-ping-handler nil))) + (run-hook-with-args 'erc-disconnected-hook + (erc-current-nick) (system-name) "") + ;; Remove the prompt + (goto-char (or (marker-position erc-input-marker) (point-max))) + (forward-line 0) + (erc-remove-text-properties-region (point) (point-max)) + (delete-region (point) (point-max)) + ;; Decide what to do with the buffer + ;; Restart if disconnected + (erc-process-sentinel-1 event buf)))))) ;;;; Sending messages @@ -704,6 +714,14 @@ This is indicated by `erc-encoding-coding-alist', defaulting to the value of (let ((coding (erc-coding-system-for-target target))) (when (consp coding) (setq coding (cdr coding))) + (when (eq coding 'undecided) + (let ((codings (detect-coding-string str)) + (precedence erc-coding-system-precedence)) + (while (and precedence + (not (memq (car precedence) codings))) + (pop precedence)) + (when precedence + (setq coding (car precedence))))) (erc-decode-coding-string str coding))) ;; proposed name, not used by anything yet @@ -1195,7 +1213,7 @@ add things to `%s' instead." (setq buffer (erc-open erc-session-server erc-session-port nick erc-session-user-full-name nil nil - erc-default-recipients chnl + (list chnl) chnl erc-server-process)) (when buffer (set-buffer buffer) diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el index 89e36a733e4..a7e971acc61 100644 --- a/lisp/erc/erc-lang.el +++ b/lisp/erc/erc-lang.el @@ -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 @@ Normungsinstitut (ON), Postfach 130, A-1021 Vienna, Austria.") 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 diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 2f29f3d0aee..6996bdbb7a0 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -246,7 +246,7 @@ the form: (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 @@ the form: (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 @@ the form: "\\`\\."))) (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 @@ the form: (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 @@ the form: ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: d0548f54-fb7c-4978-a88e-f7c26f7f68ca ;;; em-glob.el ends here diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index db2a21cd319..84af53efe58 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -612,11 +612,11 @@ In Eshell's implementation of ls, ENTRIES is always reversed." (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 @@ to use, and each member of which is the width of that column ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: 9295181c-0cb2-499c-999b-89f5359842cb ;;; em-ls.el ends here diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 15a3deea30c..2b5cb1a0dc4 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -427,7 +427,7 @@ returning the resultant string." (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 @@ returning the resultant string." (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 @@ returning the resultant string." '< (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 @@ that 'ls -l' will show in the first column of its display. " ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: 8b5ce022-17f3-4c40-93c7-5faafaa63f31 ;;; em-pred.el ends here diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index 183faa1dd77..21a5d804073 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -90,23 +90,25 @@ Comments begin with '#'." (interactive "f") (let ((orig (point)) (here (point-max)) - (inhibit-point-motion-hooks t) - after-change-functions) + (inhibit-point-motion-hooks t)) (goto-char (point-max)) - (insert-file-contents file) - (goto-char (point-max)) - (throw 'eshell-replace-command - (prog1 - (list 'let - (list (list 'eshell-command-name (list 'quote file)) - (list 'eshell-command-arguments - (list 'quote args))) - (let ((cmd (eshell-parse-command (cons here (point))))) - (if subcommand-p - (setq cmd (list 'eshell-as-subcommand cmd))) - cmd)) - (delete-region here (point)) - (goto-char orig))))) + (with-silent-modifications + ;; FIXME: Why not use a temporary buffer and avoid this + ;; "insert&delete" business? --Stef + (insert-file-contents file) + (goto-char (point-max)) + (throw 'eshell-replace-command + (prog1 + (list 'let + (list (list 'eshell-command-name (list 'quote file)) + (list 'eshell-command-arguments + (list 'quote args))) + (let ((cmd (eshell-parse-command (cons here (point))))) + (if subcommand-p + (setq cmd (list 'eshell-as-subcommand cmd))) + cmd)) + (delete-region here (point)) + (goto-char orig)))))) (defun eshell/source (&rest args) "Source a file in a subshell environment." diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 7d0ff22ceb6..d4f62415084 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -154,10 +154,10 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (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." @@ -203,32 +203,26 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (eshell-error "rm: cannot remove `.' or `..'\n")) (if (and (file-directory-p (car files)) (not (file-symlink-p (car files)))) - (let ((dir (file-name-as-directory (car files)))) - (eshell-remove-entries dir - (mapcar - (function - (lambda (file) - (concat dir file))) - (directory-files dir))) - (if verbose + (progn + (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)))) - (if verbose + (eshell-funcalln 'delete-directory (car files) t t))) + (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)))))) - (eshell-funcalln 'delete-file (car files))))) + (eshell-funcalln 'delete-file (car files) t)))) (setq files (cdr files)))) (defun eshell/rm (&rest args) @@ -241,21 +235,21 @@ argument." "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)) @@ -264,37 +258,37 @@ Remove (unlink) the FILE(s).") (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))) @@ -339,8 +333,6 @@ Remove the DIRECTORY(ies), if they are empty.") (put 'eshell/rmdir 'eshell-no-numeric-conversions t) (defvar no-dereference) -(defvar preview) -(defvar verbose) (defvar eshell-warn-dot-directories t) @@ -348,9 +340,9 @@ Remove the DIRECTORY(ies), if they are empty.") "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)) @@ -387,7 +379,7 @@ Remove the DIRECTORY(ies), if they are empty.") (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) @@ -405,11 +397,11 @@ Remove the DIRECTORY(ies), if they are empty.") (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 @@ -420,16 +412,16 @@ Remove the DIRECTORY(ies), if they are empty.") (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 @@ -454,7 +446,7 @@ Remove the DIRECTORY(ies), if they are empty.") (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))) @@ -487,7 +479,7 @@ Remove the DIRECTORY(ies), if they are empty.") (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))) @@ -501,11 +493,11 @@ Remove the DIRECTORY(ies), if they are empty.") "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 @@ -532,15 +524,15 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. "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 @@ -550,7 +542,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. 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))) @@ -564,12 +556,12 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") '((?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 @@ -920,9 +912,7 @@ Summarize disk usage of each FILE, recursively for directories.") (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)) @@ -948,7 +938,7 @@ Summarize disk usage of each FILE, recursively for directories.") :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 @@ -1127,5 +1117,4 @@ Execute a COMMAND as the superuser or another USER.") ;; generated-autoload-file: "esh-groups.el" ;; End: -;; arch-tag: 2462edd2-a76a-4cf2-897d-92e9a82ac1c9 ;;; em-unix.el ends here diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 6395fe22d87..e6d73acd434 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -123,7 +123,7 @@ treated as a literal character." :type 'hook :group 'eshell-arg) -(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ? ?\t ?\n) +(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n) "List of characters to recognize as argument separators." :type '(repeat character) :group 'eshell-arg) @@ -214,25 +214,24 @@ Point is left at the end of the arguments." (narrow-to-region beg end) (let ((inhibit-point-motion-hooks t) (args (list t)) - after-change-functions delim) - (remove-text-properties (point-min) (point-max) - '(arg-begin nil arg-end nil)) - (if (setq - delim - (catch 'eshell-incomplete - (while (not (eobp)) - (let* ((here (point)) - (arg (eshell-parse-argument))) - (if (= (point) here) - (error "Failed to parse argument '%s'" - (buffer-substring here (point-max)))) - (and arg (nconc args (list arg))))))) - (if (listp delim) - (throw 'eshell-incomplete delim) - (throw 'eshell-incomplete - (list delim (point) (cdr args))))) - (cdr args))))) + (with-silent-modifications + (remove-text-properties (point-min) (point-max) + '(arg-begin nil arg-end nil)) + (if (setq + delim + (catch 'eshell-incomplete + (while (not (eobp)) + (let* ((here (point)) + (arg (eshell-parse-argument))) + (if (= (point) here) + (error "Failed to parse argument '%s'" + (buffer-substring here (point-max)))) + (and arg (nconc args (list arg))))))) + (throw 'eshell-incomplete (if (listp delim) + delim + (list delim (point) (cdr args))))) + (cdr args)))))) (defun eshell-parse-argument () "Get the next argument. Leave point after it." diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 0dc1cb26fa9..a12d8fb7f3b 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -355,12 +355,14 @@ hooks should be run before and after the command." (if (consp command) (eshell-parse-arguments (car command) (cdr command)) (let ((here (point)) - (inhibit-point-motion-hooks t) - after-change-functions) - (insert command) - (prog1 - (eshell-parse-arguments here (point)) - (delete-region here (point))))) + (inhibit-point-motion-hooks t)) + (with-silent-modifications + ;; FIXME: Why not use a temporary buffer and avoid this + ;; "insert&delete" business? --Stef + (insert command) + (prog1 + (eshell-parse-arguments here (point)) + (delete-region here (point)))))) args)) (commands (mapcar diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 91ba13be896..7662217237a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -64,10 +64,9 @@ interned variable `args' (created using a `let' form)." 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 @@ interned variable `args' (created using a `let' form)." (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 @@ This assumes that symbols have been intern'd by `eshell-with-options'." (setq index (1+ index))))))))) args) -;; arch-tag: 45c6c2d0-8091-46a1-a205-2f4bafd8230c ;;; esh-opt.el ends here diff --git a/lisp/eshell/esh-test.el b/lisp/eshell/esh-test.el index 971d0cd63e6..50d0a8e861c 100644 --- a/lisp/eshell/esh-test.el +++ b/lisp/eshell/esh-test.el @@ -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 diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 377fd6b08e4..0a2ebba528f 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -341,20 +341,6 @@ Prepend remote identification of `default-directory', if any." "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 @@ list." "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 @@ list." "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 @@ -536,25 +522,18 @@ list." (eshell-read-hosts eshell-hosts-file 'eshell-host-names 'eshell-host-timestamp))) -(unless (fboundp 'line-end-position) - (defsubst line-end-position (&optional N) - (save-excursion (end-of-line N) (point)))) - -(unless (fboundp 'line-beginning-position) - (defsubst line-beginning-position (&optional N) - (save-excursion (beginning-of-line N) (point)))) - -(unless (fboundp 'subst-char-in-string) - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. +(and (featurep 'xemacs) + (not (fboundp 'subst-char-in-string)) + (defun subst-char-in-string (fromchar tochar string &optional inplace) + "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr))) + (let ((i (length string)) + (newstr (if inplace string (copy-sequence string)))) + (while (> i 0) + (setq i (1- i)) + (if (eq (aref newstr i) fromchar) + (aset newstr i tochar))) + newstr))) (defsubst eshell-copy-environment () "Return an unrelated copy of `process-environment'." @@ -594,8 +573,9 @@ Unless optional argument INPLACE is non-nil, return a new string." (substring string 0 sublen) string))) -(unless (fboundp 'directory-files-and-attributes) - (defun directory-files-and-attributes (directory &optional full match nosort id-format) +(and (featurep 'xemacs) + (not (fboundp 'directory-files-and-attributes)) + (defun directory-files-and-attributes (directory &optional full match nosort id-format) "Return a list of names of files and their attributes in DIRECTORY. There are three optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names @@ -607,7 +587,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. (mapcar (function (lambda (file) - (cons file (eshell-file-attributes (expand-file-name file directory))))) + (cons file (eshell-file-attributes (expand-file-name file directory))))) (directory-files directory full match nosort))))) (defvar ange-cache) @@ -802,5 +782,4 @@ gid format. Valid values are 'string and 'integer, defaulting to (provide 'esh-util) -;; arch-tag: 70159778-5c7a-480a-bae4-3ad332fca19d ;;; esh-util.el ends here diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 5067221585b..f7f469b0ccc 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -312,7 +312,7 @@ a top-level keymap, `text-scale-increase' or (when step (text-scale-increase step) (setq inc 1 first nil) - (setq ev (read-event)))) + (setq ev (read-event "+,-,0 for further adjustment: ")))) (push ev unread-command-events))) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 5249538d711..f2a7958d93b 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -358,7 +358,7 @@ inserted. Moving point or switching buffers before typing a character to insert cancels the specification." (interactive (list (progn (barf-if-buffer-read-only) - (facemenu-read-color "Foreground color: ")) + (read-color "Foreground color: ")) (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) @@ -380,7 +380,7 @@ inserted. Moving point or switching buffers before typing a character to insert cancels the specification." (interactive (list (progn (barf-if-buffer-read-only) - (facemenu-read-color "Background color: ")) + (read-color "Background color: ")) (if (and mark-active (not current-prefix-arg)) (region-beginning)) (if (and mark-active (not current-prefix-arg)) @@ -462,23 +462,7 @@ These special properties include `invisible', `intangible' and `read-only'." (remove-text-properties start end '(invisible nil intangible nil read-only nil)))) -(defun facemenu-read-color (&optional prompt) - "Read a color using the minibuffer." - (let* ((completion-ignore-case t) - (color-list (or facemenu-color-alist (defined-colors))) - (completer - (lambda (string pred all-completions) - (if all-completions - (or (all-completions string color-list pred) - (if (color-defined-p string) - (list string))) - (or (try-completion string color-list pred) - (if (color-defined-p string) - string))))) - (col (completing-read (or prompt "Color: ") completer nil t))) - (if (equal "" col) - nil - col))) +(defalias 'facemenu-read-color 'read-color) (defun color-rgb-to-hsv (r g b) "For R, G, B color components return a list of hue, saturation, value. diff --git a/lisp/faces.el b/lisp/faces.el index 23dc51e33ed..ba8535aac4f 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -30,7 +30,7 @@ (eval-when-compile (require 'cl)) -(declare-function xw-defined-colors "term/x-win" (&optional frame)) +(declare-function xw-defined-colors "term/common-win" (&optional frame)) (defvar help-xref-stack-item) @@ -1676,89 +1676,76 @@ If omitted or nil, that stands for the selected frame's display." (t (> (tty-color-gray-shades display) 2))))) -(defun read-color (&optional prompt convert-to-RGB-p allow-empty-name-p msg-p) - "Read a color name or RGB hex value: #RRRRGGGGBBBB. -Completion is available for color names, but not for RGB hex strings. -If the user inputs an RGB hex string, it must have the form -#XXXXXXXXXXXX or XXXXXXXXXXXX, where each X is a hex digit. The -number of Xs must be a multiple of 3, with the same number of Xs for -each of red, green, and blue. The order is red, green, blue. +(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg) + "Read a color name or RGB triplet of the form \"#RRRRGGGGBBBB\". +Completion is available for color names, but not for RGB triplets. -In addition to standard color names and RGB hex values, the following -are available as color candidates. In each case, the corresponding -color is used. +RGB triplets have the form #XXXXXXXXXXXX, where each X is a hex +digit. The number of Xs must be a multiple of 3, with the same +number of Xs for each of red, green, and blue. The order is red, +green, blue. + +In addition to standard color names and RGB hex values, the +following are available as color candidates. In each case, the +corresponding color is used. * `foreground at point' - foreground under the cursor * `background at point' - background under the cursor -Checks input to be sure it represents a valid color. If not, raises -an error (but see exception for empty input with non-nil -ALLOW-EMPTY-NAME-P). - -Optional arg PROMPT is the prompt; if nil, uses a default prompt. +Optional arg PROMPT is the prompt; if nil, use a default prompt. -Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, converts -an input color name to an RGB hex string. Returns the RGB hex string. +Interactively, or with optional arg CONVERT-TO-RGB-P non-nil, +convert an input color name to an RGB hex string. Return the RGB +hex string. -Optional arg ALLOW-EMPTY-NAME-P controls what happens if the user -enters an empty color name (that is, just hits `RET'). If non-nil, -then returns an empty color name, \"\". If nil, then raises an error. -Programs must test for \"\" if ALLOW-EMPTY-NAME-P is non-nil. They -can then perform an appropriate action in case of empty input. +If optional arg ALLOW-EMPTY-NAME is non-nil, the user is allowed +to enter an empty color name (the empty string). -Interactively, or with optional arg MSG-P non-nil, echoes the color in -a message." +Interactively, or with optional arg MSG non-nil, print the +resulting color name in the echo area." (interactive "i\np\ni\np") ; Always convert to RGB interactively. (let* ((completion-ignore-case t) - (colors (append '("foreground at point" "background at point") - (defined-colors))) - (color (completing-read (or prompt "Color (name or #R+G+B+): ") - colors)) - hex-string) - (cond ((string= "foreground at point" color) - (setq color (foreground-color-at-point))) - ((string= "background at point" color) - (setq color (background-color-at-point)))) - (unless color - (setq color "")) - (setq hex-string - (string-match "^#?\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color)) - (if (and allow-empty-name-p (string= "" color)) - "" - (when (and hex-string (not (eq (aref color 0) ?#))) - (setq color (concat "#" color))) ; No #; add it. - (unless hex-string - (when (or (string= "" color) (not (test-completion color colors))) - (error "No such color: %S" color)) - (when convert-to-RGB-p - (let ((components (x-color-values color))) - (unless components (error "No such color: %S" color)) - (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) - (setq color (format "#%04X%04X%04X" - (logand 65535 (nth 0 components)) - (logand 65535 (nth 1 components)) - (logand 65535 (nth 2 components)))))))) - (when msg-p (message "Color: `%s'" color)) - color))) - -;; Commented out because I decided it is better to include the -;; duplicates in read-color's completion list. - -;; (defun defined-colors-without-duplicates () -;; "Return the list of defined colors, without the no-space versions. -;; For each color name, we keep the variant that DOES have spaces." -;; (let ((result (copy-sequence (defined-colors))) -;; to-be-rejected) -;; (save-match-data -;; (dolist (this result) -;; (if (string-match " " this) -;; (push (replace-regexp-in-string " " "" -;; this) -;; to-be-rejected))) -;; (dolist (elt to-be-rejected) -;; (let ((as-found (car (member-ignore-case elt result)))) -;; (setq result (delete as-found result))))) -;; result)) + (colors (or facemenu-color-alist + (append '("foreground at point" "background at point") + (if allow-empty-name '("")) + (defined-colors)))) + (color (completing-read + (or prompt "Color (name or #RGB triplet): ") + ;; Completing function for reading colors, accepting + ;; both color names and RGB triplets. + (lambda (string pred flag) + (cond + ((null flag) ; Try completion. + (or (try-completion string colors pred) + (if (color-defined-p string) + string))) + ((eq flag t) ; List all completions. + (or (all-completions string colors pred) + (if (color-defined-p string) + (list string)))) + ((eq flag 'lambda) ; Test completion. + (or (memq string colors) + (color-defined-p string))))) + nil t)) + hex-string) + + ;; Process named colors. + (when (member color colors) + (cond ((string-equal color "foreground at point") + (setq color (foreground-color-at-point))) + ((string-equal color "background at point") + (setq color (background-color-at-point)))) + (when (and convert-to-RGB + (not (string-equal color ""))) + (let ((components (x-color-values color))) + (unless (string-match "^#\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)+$" color) + (setq color (format "#%04X%04X%04X" + (logand 65535 (nth 0 components)) + (logand 65535 (nth 1 components)) + (logand 65535 (nth 2 components)))))))) + (when msg (message "Color: `%s'" color)) + color)) + (defun face-at-point () "Return the face of the character after point. @@ -1970,7 +1957,7 @@ Value is the new parameter list." (list (cons 'cursor-color fg))))))) (declare-function x-create-frame "xfns.c" (parms)) -(declare-function x-setup-function-keys "term/x-win" (frame)) +(declare-function x-setup-function-keys "term/common-win" (frame)) (defun x-create-frame-with-faces (&optional parameters) "Create and return a frame with frame parameters PARAMETERS. @@ -2495,6 +2482,15 @@ Note: Other faces cannot inherit from the cursor face." (defface help-argument-name '((((supports :slant italic)) :inherit italic)) "Face to highlight argument names in *Help* buffers." :group 'help) + +(defface glyphless-char + '((((type tty)) :inherit underline) + (((type pc)) :inherit escape-glyph) + (t :height 0.6)) + "Face for displaying non-graphic characters (e.g. U+202A (LRE)). +It is used for characters of no fonts too." + :version "24.1" + :group 'basic-faces) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Manipulating font names. @@ -2583,5 +2579,4 @@ also the same size as FACE on FRAME, or fail." (provide 'faces) -;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 ;;; faces.el ends here diff --git a/lisp/filecache.el b/lisp/filecache.el index b4b1e8bd954..51b7ce59b1e 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -207,7 +207,7 @@ should be t." :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 @@ Defaults to the value of `completion-ignore-case'." :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 @@ Defaults to the value of `case-fold-search'." :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 @@ match REGEXP." (provide 'filecache) -;; arch-tag: 433d3ca4-4af2-47ce-b2cf-1f727460f538 ;;; filecache.el ends here diff --git a/lisp/files.el b/lisp/files.el index bb49f44fda5..09e2a4e0725 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -115,15 +115,17 @@ This variable is relevant only if `backup-by-copying' is nil." :type 'boolean :group 'backup) -(defcustom backup-by-copying-when-mismatch nil +(defcustom backup-by-copying-when-mismatch t "Non-nil means create backups by copying if this preserves owner or group. Renaming may still be used (subject to control of other variables) when it would not result in changing the owner or group of the file; that is, for files which are owned by you and whose group matches the default for a new file created there by you. This variable is relevant only if `backup-by-copying' is nil." + :version "24.1" :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. @@ -188,32 +190,6 @@ If the buffer is visiting a new file, the value is nil.") "Non-nil if visited file was read-only when visited.") (make-variable-buffer-local 'buffer-file-read-only) -(defcustom temporary-file-directory - (file-name-as-directory - ;; FIXME ? Should there be Ftemporary_file_directory to do the - ;; following more robustly (cf set_local_socket in emacsclient.c). - ;; It could be used elsewhere, eg Fcall_process_region, server-socket-dir. - ;; See bug#7135. - (cond ((memq system-type '(ms-dos windows-nt)) - (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) - ((eq system-type 'darwin) - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") - (let ((tmp (ignore-errors (shell-command-to-string ; bug#7135 - "getconf DARWIN_USER_TEMP_DIR")))) - (and (stringp tmp) - (setq tmp (replace-regexp-in-string "\n\\'" "" tmp)) - ;; This handles "getconf: Unrecognized variable..." - (file-directory-p tmp) - tmp)) - "/tmp")) - (t - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) - "The directory for writing temporary files." - :group 'files - ;; Darwin section added 24.1, does not seem worth :version bump. - :initialize 'custom-initialize-delay - :type 'directory) - (defcustom small-temporary-file-directory (if (eq system-type 'ms-dos) (getenv "TMPDIR")) "The directory for writing small temporary files. @@ -801,9 +777,10 @@ one or more of those symbols." ;; Switching from names to names+fullnames creates a non-monotonicity ;; which can cause problems with things like partial-completion. ;; To minimize the problem, filter out completion-regexp-list, so that - ;; M-x load-library RET t/x.e TAB finds some files. - (if completion-regexp-list - (setq names (all-completions "" names))) + ;; M-x load-library RET t/x.e TAB finds some files. Also remove elements + ;; from `names' which only matched `string' when they still had + ;; their suffix. + (setq names (all-completions string names)) ;; Remove duplicates of the first element, so that we can easily check ;; if `names' really only contains a single element. (when (cdr names) (setcdr names (delete (car names) (cdr names)))) @@ -3248,7 +3225,10 @@ It is safe if any of these conditions are met: evaluates to a non-nil value with VAL as an argument." (or (member (cons sym val) safe-local-variable-values) (let ((safep (get sym 'safe-local-variable))) - (and (functionp safep) (funcall safep val))))) + (and (functionp safep) + ;; If the function signals an error, that means it + ;; can't assure us that the value is safe. + (with-demoted-errors (funcall safep val)))))) (defun risky-local-variable-p (sym &optional ignored) "Non-nil if SYM could be dangerous as a file-local variable. @@ -3390,22 +3370,29 @@ ROOT is the root directory of the project. Return the new variables list." (let* ((file-name (buffer-file-name)) (sub-file-name (if file-name + ;; FIXME: Why not use file-relative-name? (substring file-name (length root))))) - (dolist (entry class-variables variables) - (let ((key (car entry))) - (cond - ((stringp key) - ;; Don't include this in the previous condition, because we - ;; want to filter all strings before the next condition. - (when (and sub-file-name - (>= (length sub-file-name) (length key)) - (string= key (substring sub-file-name 0 (length key)))) - (setq variables (dir-locals-collect-variables - (cdr entry) root variables)))) - ((or (not key) - (derived-mode-p key)) - (setq variables (dir-locals-collect-mode-variables - (cdr entry) variables)))))))) + (condition-case err + (dolist (entry class-variables variables) + (let ((key (car entry))) + (cond + ((stringp key) + ;; Don't include this in the previous condition, because we + ;; want to filter all strings before the next condition. + (when (and sub-file-name + (>= (length sub-file-name) (length key)) + (string-prefix-p key sub-file-name)) + (setq variables (dir-locals-collect-variables + (cdr entry) root variables)))) + ((or (not key) + (derived-mode-p key)) + (setq variables (dir-locals-collect-mode-variables + (cdr entry) variables)))))) + (error + ;; The file's content might be invalid (e.g. have a merge conflict), but + ;; that shouldn't prevent the user from opening the file. + (message ".dir-locals error: %s" (error-message-string err)) + nil)))) (defun dir-locals-set-directory-class (directory class &optional mtime) "Declare that the DIRECTORY root is an instance of CLASS. @@ -3536,7 +3523,9 @@ and `file-local-variables-alist', without applying them." (dir-name nil)) (cond ((stringp variables-file) - (setq dir-name (if (buffer-file-name) (file-name-directory (buffer-file-name)) default-directory)) + (setq dir-name (if (buffer-file-name) + (file-name-directory (buffer-file-name)) + default-directory)) (setq class (dir-locals-read-from-file variables-file))) ((consp variables-file) (setq dir-name (nth 0 variables-file)) @@ -3846,21 +3835,25 @@ BACKUPNAME is the backup file name, which is the old file renamed." (and context (set-file-selinux-context to-name context))) +(defvar file-name-version-regexp + "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+~\\)" + "Regular expression matching the backup/version part of a file name. +Used by `file-name-sans-versions'.") + (defun file-name-sans-versions (name &optional keep-backup-version) "Return file NAME sans backup versions or strings. This is a separate procedure so your site-init or startup file can redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, -we do not remove backup version numbers, only true file version numbers." +we do not remove backup version numbers, only true file version numbers. +See also `file-name-version-regexp'." (let ((handler (find-file-name-handler name 'file-name-sans-versions))) (if handler (funcall handler 'file-name-sans-versions name keep-backup-version) (substring name 0 - (if keep-backup-version - (length name) - (or (string-match "\\.~[-[:alnum:]:#@^._]+~\\'" name) - (string-match "~\\'" name) - (length name))))))) + (unless keep-backup-version + (string-match (concat file-name-version-regexp "\\'") + name)))))) (defun file-ownership-preserved-p (file) "Return t if deleting FILE and rewriting it would preserve the owner." @@ -4507,28 +4500,8 @@ Before and after saving the buffer, this function runs (setq buffer-backed-up nil)))))) setmodes)) -(defun diff-buffer-with-file (&optional buffer) - "View the differences between BUFFER and its associated file. -This requires the external program `diff' to be in your `exec-path'." - (interactive "bBuffer: ") - (with-current-buffer (get-buffer (or buffer (current-buffer))) - (if (and buffer-file-name - (file-exists-p buffer-file-name)) - (let ((tempfile (make-temp-file "buffer-content-"))) - (unwind-protect - (progn - (write-region nil nil tempfile nil 'nomessage) - (diff buffer-file-name tempfile nil t) - (sit-for 0)) - (when (file-exists-p tempfile) - (delete-file tempfile)))) - (message "Buffer %s has no associated file on disc" (buffer-name)) - ;; Display that message for 1 second so that user can read it - ;; in the minibuffer. - (sit-for 1))) - ;; return always nil, so that save-buffers-kill-emacs will not move - ;; over to the next unsaved buffer when calling `d'. - nil) +(declare-function diff-no-select "diff" + (old new &optional switches no-async buf)) (defvar save-some-buffers-action-alist `((?\C-r @@ -4544,13 +4517,14 @@ This requires the external program `diff' to be in your `exec-path'." (?d ,(lambda (buf) (if (null (buffer-file-name buf)) (message "Not applicable: no file") - (save-window-excursion (diff-buffer-with-file buf)) - (if (not enable-recursive-minibuffers) - (progn (display-buffer (get-buffer-create "*Diff*")) - (setq other-window-scroll-buffer "*Diff*")) - (view-buffer (get-buffer-create "*Diff*") - (lambda (_) (exit-recursive-edit))) - (recursive-edit))) + (require 'diff) ;for diff-no-select. + (let ((diffbuf (diff-no-select (buffer-file-name buf) buf + nil 'noasync))) + (if (not enable-recursive-minibuffers) + (progn (display-buffer diffbuf) + (setq other-window-scroll-buffer diffbuf)) + (view-buffer diffbuf (lambda (_) (exit-recursive-edit))) + (recursive-edit)))) ;; Return nil to ask about BUF again. nil) ,(purecopy "view changes in this buffer"))) @@ -6469,5 +6443,4 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (define-key ctl-x-5-map "r" 'find-file-read-only-other-frame) (define-key ctl-x-5-map "\C-o" 'display-buffer-other-frame) -;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f ;;; files.el ends here diff --git a/lisp/finder.el b/lisp/finder.el index 8471edd57ff..655ad5383b0 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -198,7 +198,8 @@ from; the default is `load-path'." (setq summary (lm-synopsis) keywords (mapcar 'intern (lm-keywords-list)) package (or package-override - (intern-soft (lm-header "package")) + (let ((str (lm-header "package"))) + (if str (intern str))) base-name) version (lm-header "version"))) (when summary diff --git a/lisp/frame.el b/lisp/frame.el index 44ac5c0e81d..b133851b440 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1,7 +1,8 @@ ;;; frame.el --- multi-frame management independent of window systems ;; Copyright (C) 1993, 1994, 1996, 1997, 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. ;; Maintainer: FSF ;; Keywords: internal @@ -295,22 +296,19 @@ there (in decreasing order of priority)." (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))) @@ -511,25 +509,28 @@ there (in decreasing order of priority)." ;; 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) @@ -1066,7 +1067,7 @@ See `modify-frame-parameters'." "Set the background color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current background color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Background color: "))) + (interactive (list (read-color "Background color: "))) (modify-frame-parameters (selected-frame) (list (cons 'background-color color-name))) (or window-system @@ -1076,7 +1077,7 @@ To get the frame's current background color, use `frame-parameters'." "Set the foreground color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current foreground color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Foreground color: "))) + (interactive (list (read-color "Foreground color: "))) (modify-frame-parameters (selected-frame) (list (cons 'foreground-color color-name))) (or window-system @@ -1086,7 +1087,7 @@ To get the frame's current foreground color, use `frame-parameters'." "Set the text cursor color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current cursor color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Cursor color: "))) + (interactive (list (read-color "Cursor color: "))) (modify-frame-parameters (selected-frame) (list (cons 'cursor-color color-name)))) @@ -1094,7 +1095,7 @@ To get the frame's current cursor color, use `frame-parameters'." "Set the color of the mouse pointer of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current mouse color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Mouse color: "))) + (interactive (list (read-color "Mouse color: "))) (modify-frame-parameters (selected-frame) (list (cons 'mouse-color (or color-name @@ -1105,7 +1106,7 @@ To get the frame's current mouse color, use `frame-parameters'." "Set the color of the border of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current border color, use `frame-parameters'." - (interactive (list (facemenu-read-color "Border color: "))) + (interactive (list (read-color "Border color: "))) (modify-frame-parameters (selected-frame) (list (cons 'border-color color-name)))) @@ -1466,14 +1467,6 @@ left untouched. FRAME nil or omitted means use the selected frame." (make-variable-buffer-local 'show-trailing-whitespace) -(defcustom show-trailing-whitespace nil - "Non-nil means highlight trailing whitespace. -This is done in the face `trailing-whitespace'." - :type 'boolean - :safe 'booleanp - :group 'whitespace-faces) - - ;; Scrolling @@ -1482,13 +1475,6 @@ This is done in the face `trailing-whitespace'." :version "21.1" :group 'frames) -(defcustom auto-hscroll-mode t - "Allow or disallow automatic scrolling windows horizontally. -If non-nil, windows are automatically scrolled horizontally to make -point visible." - :version "21.1" - :type 'boolean - :group 'scrolling) (defvaralias 'automatic-hscrolling 'auto-hscroll-mode) @@ -1575,35 +1561,6 @@ cursor display. On a text-only terminal, this is not implemented." 'blink-cursor-start)))) (define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") - -;; Hourglass pointer - -(defcustom display-hourglass t - "Non-nil means show an hourglass pointer, when Emacs is busy. -This feature only works when on a window system that can change -cursor shapes." - :type 'boolean - :group 'cursor) - -(defcustom hourglass-delay 1 - "Seconds to wait before displaying an hourglass pointer when Emacs is busy." - :type 'number - :group 'cursor) - - -(defcustom cursor-in-non-selected-windows t - "Non-nil means show a hollow box cursor in non-selected windows. -If nil, don't show a cursor except in the selected window. -If t, display a cursor related to the usual cursor type - \(a solid box becomes hollow, a bar becomes a narrower bar). -You can also specify the cursor type as in the `cursor-type' variable. -Use Custom to set this variable to get the display updated." - :tag "Cursor In Non-selected Windows" - :type 'boolean - :group 'cursor - :set #'(lambda (symbol value) - (set-default symbol value) - (force-mode-line-update t))) ;;;; Key bindings @@ -1615,5 +1572,4 @@ Use Custom to set this variable to get the display updated." (provide 'frame) -;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56 ;;; frame.el ends here diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 337e3cba3b8..38fdadf6066 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,12 +1,1588 @@ +2010-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-script): Ignore <script>. + (shr-tag-label): Add <label> support. + +2010-12-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-ucs-to-char): Use eval-and-compile. + + * shr.el (shr-image-displayer): Work for images lined side by side. + +2010-12-08 Robert Pluim <rpluim@gmail.com> + + * gnus-demon.el (gnus-demon-init): Call run-with-timer with an integer + parameter, since XEmacs doesn't accept t as a parameter. + +2010-12-08 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-retrieve-headers): Use rassq when comparing article + ids. + (nnir-run-gmane): Simplify groupspec formatting. + (nnir-request-expire-articles): New function. + +2010-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-parse-flags): Tweak VANISHED regexp to avoid regexp + overflow, possibly. + + * shr.el (shr-tag-table-1): Use bg/gfcolor specs on tables. + (shr-render-td): Handle td style="" better. + (shr-tag-table): Use the color from the style sheet. + (shr-render-td): Make sure we copy over all the overlays, too. + +2010-12-07 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-run-gmane): Restore sub-optimal test for gmane server. + (nnir-request-article): Improve article retrieval. + +2010-12-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-extra-numeric-entities): New variable. + + * mm-url.el (mm-url-decode-entities): + * mm-decode.el (mm-shr): Use it to decode extra numeric entities. + +2010-12-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * message.el: Use completion-at-point. + (message-completion-function): New fun, extracted from message-tab. + (message-mode): Use it for completion-at-point-functions. + (message-tab): Use it and completion-at-point. + +2010-12-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-find-fill-point): Don't break a line after a kinsoku-bol + character if a non-breakable character follows. + +2010-12-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * proto-stream.el (proto-stream-open-tls): Return nil if we don't get + any stream. + + * shr.el (shr-tag-font): Colorize the region. + (shr-tag-body): Ditto. + (shr-tag-font): Actually let the styles be inherited instead of + overwriting them. + (shr-tag-font): Get the background color right. + (shr-tag-style): Ignore all <style> tags for the moment. + + * gnus-int.el (gnus-request-thread): Rework to take a header instead of + a Message-ID to avoid having nnimap depend on gnus-sum. + + * shr.el (shr-descend): Only colorize something if we have a node that + sets colors. + +2010-12-06 Julien Danjou <julien@danjou.info> + + * shr.el (shr-render-td): Render td content with shr-descend, so style + will be applied to <td> too. + (shr-colorize-region): Colorize region even if we only have a background. + (shr-tag-body): Fix color and background color inheritance. + Do not recolorize after shr-generic. + (shr-tag-font): Let shr-generic colorize via inheritance. + +2010-12-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-find-fill-point): Don't regard apostrophe as kinsoku-bol. + +2010-12-06 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-request-move-article): Remove obsolete code. + +2010-12-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (gnus-macroexpand-all): Use eval-and-compile. + +2010-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-respool-article): The completion function + expects a list instead of an alist. + + * nntp.el (nntp-snarf-error-message): nnheader-report takes a format + string as the parameter. + + * gnus.el (gnus-valid-select-methods): Allow nnimap to respool. + + * shr.el (shr-stylesheet): New dynamic variable for cascading the + styles. + (shr-colorize-region): New function. + (shr-insert-background-overlay): Remove. + (shr-render-td): Background setting should be taken care of on a higher + level. + (shr-tag-body): Use post-hoc colorizations. + (shr-tag-body): Set up a style sheet based on bgcolor/fgcolor. + (shr-put-color-1): Don't overwrite old colors. + (shr-colorize-region): When the background color isn't explicit, use + a fixed background. + + * gnus-util.el (gnus-output-to-mail): Require nnmail before using + nnmail variables. + +2010-12-05 Bjørn Mork <bjorn@mork.no> + + * nnimap.el (nnimap-process-expiry-targets): Avoid downloading articles + unless necessary. + +2010-12-05 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-run-gmane): Use more careful test for gmane nntp + server. + +2010-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-put-image): Use widget instead of local maps + so that TAB works. + + * gnus-sum.el (gnus-summary-show-article): Reverse the meanings of `C-u + C-u g' and `C-u g' so that `C-u g' does what it traditionally did. + + * shr.el (shr-urlify): Show the URL before the title to avoid + misleading URLs. + +2010-12-04 Adam Sjøgren <asjo@koldfront.dk> + + * shr.el (shr-urlify): Display the title in <a> tags. + +2010-12-04 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-categorize): Replace mapcar with mapc. + +2010-12-03 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el: Rearrange code to allow macros to be autoloaded by + gnus-sum.el. + (nnir-retrieve-headers-override-function): Make this variable + customizable. + (nnir-retrieve-headers): Remove obsolete subject-mangling code. + + * gnus-sum.el (nnir-article-group,nnir-article-rsv): Autoload macros + from nnir.el. + +2010-12-03 Julien Danjou <julien@danjou.info> + + * gnus-demon.el (gnus-demon-init): Fix time computing when time is nil. + +2010-12-03 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (gnus-macroexpand-all): Don't modify argument; + allow optional argument `environment'. + +2010-12-03 Glenn Morris <rgm@gnu.org> + + * mm-extern.el (message-goto-body): Update declaration. + +2010-12-03 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (gnus-macroexpand-all): New function. + + * gnus-sum.el (gnus-summary-line-format-alist): Use gnus-macroexpand-all + instead of macroexpand-all that is unavailable in XEmacs. + +2010-12-02 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-summary-line-format): New variable. + (nnir-mode): Use it. + (nnir-artlist-*,nnir-aritem-*): Reimplement as macros. + (nnir-article-ids): Reimplement as defsubst. + (nnir-retrieve-headers): Don't mangle the subject header. + (nnir-run-imap): Use 100 as RSV score. + (nnir-run-find-grep): Fix for full server searching. + (nnir-run-gmane): Better restriction to gmane groups. + + * gnus-sum.el (gnus-summary-line-format-alist): Add specs for nnir + summary buffers. + +2010-12-02 Julien Danjou <julien@danjou.info> + + * gnus-win.el (gnus-configure-frame): Remove old compatibility code. + + * gnus-msg.el: Mark gnus-outgoing-message-group as obsolete. + + * gnus-win.el (gnus-configure-windows): Remove Gnus 3.x setting + support. + +2010-12-01 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el: Update to handle the registry better. + (autoload): Silence byte-compiler. + (nnir-open-server): Add a hook for nnir groups. + (nnir-request-move-article): Don't mangle the header. Better to use + formating variables (which will be added in the future). + (nnir-registry-action): Update the registry using the original article + group name. + (nnir-mode): Install nnir-specific hooks for updating the registry. + + * gnus-sum.el + (gnus-article-original-subject,gnus-newsgroup-original-name): Remove + obsolete variables. + (gnus-summary-move-article): Remove use of obsolete variables. + (gnus-summary-local-variables): Make move and delete hooks local to + summary buffers. + +2010-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * rtree.el: New file. + +2010-12-01 Julien Danjou <julien@danjou.info> + + * message.el (message-user-organization): Do not use + gnus-local-organization. + + * gnus.el: Remove gnus-local-organization. + + * gnus-msg.el: Remove nastygram thing. + +2010-12-01 Teodor Zlatanov <tzz@lifelogs.com> + + * nnmaildir.el (nnmaildir-request-set-mark): Add article to add-mark + funcall. + +2010-12-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-gravatar.el (gnus-gravatar-insert): Allow LWSP in the middle of + names. + + * shr.el (shr-find-fill-point): Don't break line between kinsoku-bol + characters. + + * gnus-gravatar.el (gnus-gravatar-insert): Delete unnecessary binding + to t of inhibit-read-only since it is inside gnus-with-article-headers. + Suggested by Å tÄ›pán NÄ›mec <stepnem@gmail.com>. + (gnus-gravatar-transform-address): Use mail-extract-address-components + that supports non-ASCII names rather than mail-header-parse-addresses. + +2010-11-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * proto-stream.el (open-protocol-stream): All starttls connections are + handled by the network handler. + +2010-11-30 Julien Danjou <julien@danjou.info> + + * nnimap.el (nnimap-open-connection-1): Use gnus-string-match-p. + (nnimap-open-connection-1): Fix PREAUTH. + + * gnus-gravatar.el (gnus-gravatar-size): Set gnus-gravatar-size to nil. + +2010-11-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-char-breakable-p, shr-char-nospace-p) + (shr-char-kinsoku-bol-p, shr-char-kinsoku-eol-p): New macros. + (shr-insert): Use them. + (shr-find-fill-point): Work better for kinsoku chars and apostrophes. + +2010-11-29 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-request-move-article): Bail out if original group + doesn't support article moves. + (nnir-get-active): Improve active list retrieval. + +2010-11-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-find-fill-point): Don't break before apostrophes. + +2010-11-29 Binjo <binjo.cn@gmail.com> (tiny change) + + * nnimap.el (nnimap-open-connection-1): w32 open-network-stream doesn't + seem to accept strings-with-numbers as port numbers, + +2010-11-29 Andrew Cohen <cohen@andy.bu.edu> + + * gnus-sum.el (gnus-summary-delete-article): If delete fails don't + change the registry. + +2010-11-29 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnir.el (nnir-run-gmane): Use mm-delete-duplicates instead of + delete-dups that is not available in XEmacs 21.4. + + * mm-util.el (mm-delete-duplicates): Add comment. + +2010-11-28 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-ignored-newsgroups): New variable. + (nnir-get-active): Use it. + +2010-11-28 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * proto-stream.el (proto-stream-open-network): Add some comments. + + * nntp.el (nntp-open-connection): Provide a :success condition. + + * nnimap.el (nnimap-open-connection-1): Ditto. + + * proto-stream.el (proto-stream-open-network): See what the response to + the STARTTLS command is. + + * nnimap.el (nnimap-open-connection-1): Always upgrade to STARTTLS (for + backwards compatibility). + (nnimap-open-connection-1): Really respect nnimap-server-port. + + * proto-stream.el (proto-stream-open-network): When doing opportunistic + TLS upgrades we don't really care about the identity of the peer. + (proto-stream-open-network): Force starttls.el to use gnutls-cli, since + that what we've checked for. + (proto-stream-always-use-starttls): Only default to t if + open-gnutls-stream exists. + (proto-stream-open-network): If STARTTLS failed, then just open a + normal connection. + (proto-stream-open-network): Wait until the greeting before doing + STARTTLS. + + * nntp.el (nntp-open-connection): Report what the connection error is. + + * proto-stream.el (open-protocol-stream): Renamed from + open-proto-stream. + +2010-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-stream): Change default to `undecided'. + (nnimap-open-connection): If `nnimap-stream' is `undecided', try ssl + first, and then network. + (nnimap-open-connection-1): Respect nnimap-server-port. + (nnimap-open-connection): Be more backwards-compatible. + + * proto-stream.el (proto-stream-always-use-starttls): New variable. + (proto-stream-open-starttls): De-duplicate the starttls code. + (proto-stream-open-starttls): Folded back into the main function. + (proto-stream-open-network): Fix typo in the gnutls path. + (proto-stream-command): Refactor out. + + * nntp.el (nntp-open-connection): Fix the STARTTLS command syntax. + + * proto-stream.el (proto-stream-open-starttls): Actually implement the + starttls.el STARTTLS. + + * color.el (color-lab->srgb): Fix function call name. + + * proto-stream.el (proto-stream-open-tls): Delete output from openssl + if we're using tls.el. + (proto-stream-open-network): If we don't have gnutls-cli or gnutls + built in, then don't try to establish a STARTTLS connection. + + * nntp.el (nntp-open-connection): Switch on STARTTLS on supported + servers. + + * proto-stream.el (open-proto-stream): Use network, not stream. + (open-proto-stream): Add a way to specify what the end of a command is. + + * nntp.el (nntp-open-connection): Use proto-streams for the relevant + connections types. + (nntp-open-network-stream): Remove. + (nntp-open-ssl-stream): Remove. + (nntp-open-tls-stream): Remove. + (nntp-ssl-program): Remove. + + * nnimap.el (nnimap-open-connection): Check for "OK" from the greeting. + +2010-11-27 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el: Fix typos. + (nnir-retrieve-headers-override-function): Rename variable to reflect + new semantics. + (nnir-article-group, nnir-article-number, nnir-article-rsv): New helper + macros. + (nnir-request-article, nnir-request-move-article): Use them. + (nnir-categorize): New function. + (nnir-run-query): Use it. + (nnir-retrieve-headers): Rewrite to batch header retrieval. + (nnir-run-gmane): nnir-retrieve-headers now returns the headers already + sorted. + (nnir-group-full-name): Use gnus-group-full-name instead. + (nnir-artlist-artitem-group, nnir-artlist-artitem-number) + (nnir-artlist-artitem-rsv, nnir-sort-groups-by-server): Obsolete. + +2010-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-open-connection): Fix typo in STARTTLS command. + + * proto-stream.el: New library to provide protocol-specific + TLS/STARTTLS connections for IMAP, NNTP, SMTP, POP3 and similar + protocols. + (open-proto-stream): Complete the documentation. + (proto-stream-open-network): Fix some typos. + + * nnimap.el (nnimap-open-connection): Use it. + +2010-11-27 Yuri Karaban <tech@askold.net> (tiny change) + + * pop3.el (pop3-open-server): Read server greeting before starting TLS + negotiation. + +2010-11-26 Julien Danjou <julien@danjou.info> + + * color.el: Rename various rgb functions to srgb. + +2010-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-get-groups): Allow non-quoted strings as mailbox + names. + +2010-11-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-insert): Revert last change. + (shr-find-fill-point): Never leave point being at bol; + relax the kinsoku limitation when rendering tables. + +2010-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnmail.el (nnmail-expiry-target-group): Protect against degenerate + results from -accept-article. + + * shr-color.el: Require cl when compiling. + + * nnheader.el (nnheader-update-marks-actions): Fix typo in last + checkin. + + * gnus-art.el (gnus-url-mailto): Unfold URLs before using them. + + * nnimap.el (nnimap-request-set-mark): Add is "+", not "-". + + * gnus-sum.el (gnus-summary-push-marks-to-backend): Use 'set instead of + 'add and 'delete to set backend marks. + + * nnmaildir.el (nnmaildir-request-set-mark): Be explicit about 'set. + + * nnheader.el (nnheader-update-marks-actions): Refactor out. + + * nntp.el (nntp-request-set-mark): Use it. + + * nnfolder.el (nnfolder-request-set-mark): Ditto. + + * nnml.el (nnml-request-set-mark): Ditto. + + * nnimap.el (nnimap-last-response-string): Remove the unfolding -- it + introduces regressions in article selection. + (nnimap-find-uid-response): New function. + (nnimap-request-accept-article): Use the UID returned, if any. + (nnimap-request-move-article): Use the UID returned, if any. + (nnimap-get-groups): Reimplement to work with folded lines. + (nnimap-find-uid-response): The UID is the last element in the list. + (nnimap-request-set-mark): Extend syntax with 'set. + + * nnml.el (nnml-request-set-mark): Ditto. + + * nnfolder.el (nnfolder-request-set-mark): Ditto. + + * nntp.el (nntp-request-set-mark): Ditto. + +2010-11-25 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-called-interactively-p): A temporary macro. + (message-goto-body): Use it temporarily. + +2010-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-unfold-quoted-lines): Refactor out. + (nnimap-last-response-string): Unfold quoted lines, if they exist. + (nnimap-last-response-string): Fix last unfolding fix. + +2010-11-25 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-insert): Fix the way to fold lines. + +2010-11-25 Julien Danjou <julien@danjou.info> + + * shr-color.el (shr-color->hexadecimal): Use color-rgb->hex + + * color.el: Rename from color-lab.el + (color-rgb->hex): Add. + (color-complement): Add. + (color-complement-hex): Add. + + * gnus-sum.el (gnus-summary-widget-forward): Add, and bind to [tab]. + +2010-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr-color.el (shr-color-visible): Don't bug out if the colour names + don't exist. + +2010-11-25 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el (mml-preview): Make sure to bind gnus-displaying-mime to nil, + assuming that article displaying or another mml-preview may be + interrupted for an error or for the like. + + * shr.el (shr-get-background): Fix argument name. + +2010-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-cache.el (gnus-summary-insert-cached-articles): Use it. + + * gnus-sum.el (gnus-summary-include-articles): New function. + + * message.el (message-goto-body): called-interactively-p needs a + parameter, so use `any'. + + * nnimap.el (nnimap-request-move-article): It's no longer necessary to + clear marks before moving, since they're synced from the Gnus side + first. + + * gnus-sum.el (gnus-summary-push-marks-to-backend): New function. + (gnus-summary-move-article): Copy over all marks before moving, so that + IMAP doesn't think a new article has arrived. + +2010-11-24 Julien Danjou <julien@danjou.info> + + * shr.el (shr-insert-background-overlay): Fix typo. + (shr-render-td): Copy the background before rendering. + + * shr-color.el (shr-color-visible): Fix docstring. + + * shr.el (shr-tag-table): Add bgcolor support. + (shr-render-td): Add bgcolor support. + (shr-get-background): Add. + (shr-insert-foreground-overlay): Use shr-get-background. + + * message.el (message-goto-body): Use called-interactively-p. + (message-in-body-p): message-goto-body returns point. + +2010-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mm-util.el (mm-enable-multibyte): Use `to' instead of t. This fixes + Fixes something or other in Emacs 23, and is backwards compatible. + + * message.el (message-goto-body): Remove the <#secure special-casing, + which is too special. + + * shr.el (shr-parse-style): Drop !important from styles. + +2010-11-24 Daniel Schoepe <daniel.schoepe@googlemail.com> (tiny change) + + * gnus-sum.el (gnus-summary-articles-in-thread): Fix a bug that causes + this function to return incorrect results when calling it with an + explicit article argument different from + (gnus-summary-article-number). + +2010-11-24 Julien Danjou <julien@danjou.info> + + * shr.el (shr-insert-color-overlay): Replace deprecated syntax. + (shr-tag-body): Add background support. + (shr-descend): Add background support. + (shr-tag-title): Add. + + * shr-color.el (shr-color-visible): Really return original background + if fixed. + +2010-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-color-check): Protect against non-existant colour names. + +2010-11-24 Julien Danjou <julien@danjou.info> + + * color-lab.el: Require 'cl when compiling. + + * shr.el (shr-insert-color-overlay): Remove specific rgb() check. + + * shr-color.el (shr-color->hexadecimal): Only return the hexadecimal + matched part. + + * color-lab.el: Fix all expt calls to use float type. + +2010-11-24 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-insert-color-overlay): Pass rgb(rrr, ggg, bbb) type color + expression to shr-color-check as is. + + * shr-color.el (shr-color->hexadecimal): Ignore case of color names. + + * color-lab.el: Add coding cookie. + (float-pi): Use eval-and-compile. + +2010-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-insert-color-overlay): Split stuff like + "#444444 !important" to find the real colour. + (shr-tag-font): Resurrect shr-tag-font again, since it's needed to + parse <font color="red"> entries. + +2010-11-23 Andrew Cohen <cohen@andy.bu.edu> + + * nnheader.el (nnheader-parse-head): Bug fix. Properly position + point when parsing headers. + + * nnspool.el (nnspool-insert-nov-head): Bug fix. Make sure point + is positioned properly when parsing headers. + +2010-11-23 Julien Danjou <julien@danjou.info> + + * color-lab.el (boundp): Bind float-pi for Emacs < 23.3. + + * shr-color.el (shr-color->hexadecimal): Add support for color names. + + * shr.el (shr-parse-style): Replace \n with space in style parsing. + + * shr-color.el (shr-color-hsl-to-rgb-fractions): Use + shr-color-hue-to-rgb. + (shr-color->hexadecimal): Call shr-color-hsl-to-rgb-fractions. + +2010-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-color->hexadecimal): Autoload. + (shr-descend): Add color to all tags. + +2010-11-22 Julien Danjou <julien@danjou.info> + + * shr.el (shr-tag-color-check): Convert colors to hexadecimal with + shr-color->hexadecimal. + + * shr-color.el (shr-color->hexadecimal): Add converting functions for + RGB() or HSL() color representation. + + * shr.el (shr-tag-font): Add. + (shr-tag-color-check): New function to get better colors. + (shr-tag-insert-color-overlay): Factorize code between tag-font and + tag-span. + + * shr-color.el: New file. + + * color-lab.el: New file. + + * gnus-art.el (gnus-url-mailto): Do not downcase args. + +2010-11-21 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el: Fix typo in comments. + (nnir-run-imap): Simplify code. No need to reverse artlist. + (nnir-run-gmane): Use nnir-tmp-buffer for web results. + +2010-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-srvr.el (gnus-server-show-server): New command and keystroke. + + * nnimap.el (nnimap-get-capabilities): Refactor out. + (nnimap-open-connection): Re-request capabilities after STARTTLS. + +2010-11-21 Ralf Angeli <angeli@caeruleus.net> + + * mm-uu.el (mm-uu-type-alist): Prevent spurious empty line from + appearing when `mm-uu-hide-markers' is nil. + +2010-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-unselect-group): Make into its own function. + (nnimap-request-rename-group): Unselect group before renaming. + This had gotten lost somewhere. + (nnimap-request-accept-article): Keep track of examined groups, and + unselect the group before APPENDing to read-only groups. + (nnimap-request-move-article): Clear flags before moving so that they + can be re-set later. + +2010-11-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-gravatar.el (gnus-gravatar-transform-address): Decode name again. + (gnus-gravatar-insert): Put avatar always in the beginning of the field. + +2010-11-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-display-single) + * gnus-html.el (gnus-html-wash-images, gnus-html-prefetch-images) + * mm-decode.el (mm-shr): Assume that gnus-inhibit-images may be a group + parameter. + +2010-11-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-table-horizontal-line): Rename from shr-table-line. + (shr-table-vertical-line): New variable. + (shr-insert-table): Use it. + +2010-11-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-html-wash-images): Don't display images if + gnus-inhibit-images is non-nil; register displayer for cid images. + (gnus-html-display-image): Work for cid image. + (gnus-html-insert-image): Allow arguments. + (gnus-html-put-image): Inhibit read-only. + (gnus-html-prefetch-images): Don't prefetch images if + gnus-inhibit-images is non-nil. + +2010-11-17 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-put-image): Break lines when inserting big pictures. + +2010-11-17 Daniel Dehennin <daniel.dehennin@baby-gnu.org> + + * mml2015.el (mml2015-epg-encrypt): Fix two cons with missing + sender, thanks Katsumi Yamaoka. + +2010-11-17 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-run-imap): Reverse the article list for each group + rather than the whole list. + +2010-11-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-image-displayer): Protect function against non-existent + image source. + + * gnus-art.el (gnus-inhibit-images): New user option. + (gnus-mime-display-single): Don't display image if it is non-nil. + + * mm-decode.el (mm-shr): Bind shr-inhibit-images to the value of + gnus-inhibit-images. + + * shr.el (shr-image-displayer): New function. + (shr-tag-img): Use it. + +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 + methods. + (gnus-read-active-file): Ditto. + + * gnus-group.el (gnus-group-read-ephemeral-group): Remove superfluous + ": " from the prompt. + (gnus-group-make-group): Ditto. + +2010-11-07 Glenn Morris <rgm@gnu.org> + + * gnus-bookmark.el (gnus-bookmark-bmenu-show-infos) + (gnus-bookmark-kill-line): Use point-at-eol. + +2010-11-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-gravatar.el (gnus-gravatar-transform-address): No need to skip + asterisks in From header. + +2010-11-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-ems.el (gnus-put-image): Use a blank text as the insertion + string to avoid making the From headers syntactically invalid. + + * message.el (message-send-mail): Don't insert courtesy messages if the + message already has List-Post and List-ID messages. + +2010-11-06 Glenn Morris <rgm@gnu.org> + + * gnus-art.el (gnus-treat-article): Give dynamic local variables + `condition', `type', `length' a prefix. + (gnus-treat-predicate): Update for above name changes. + +2010-11-06 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (gnus-summary-nnir-goto-thread): Remove function and + binding. Handled by `gnus-summary-refer-thread' instead. + (nnir-warp-to-article): New backend function. + + * nnimap.el (nnimap-request-thread): Force dependency updating. + + * gnus-sum.el (gnus-fetch-headers): Allow more arguments. + (gnus-summary-refer-thread): Rework to improve thread-referral. + + * gnus-int.el (gnus-warp-to-article): New function. + + * gnus-sum.el (gnus-summary-article-map): Bind it. + +2010-11-04 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (gnus-summary-nnir-goto-thread): Limit work done by + gnus-summary-refer-thread. + + * gnus-sum.el (gnus-build-all-threads): Force updating of dependency + headers. + (gnus-summary-limit-include-thread): Prevent articles in thread from + being cut in gnus-cut-threads. + (gnus-summary-refer-thread): Limit retrieved headers to those in + thread. + +2010-11-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-send-mail): Use the value of + message-courtesy-message from the message buffer. + + * gnus-html.el (gnus-html-browse-url): Implement mailto: URLs. + + * shr.el (shr-browse-url): Implement mailto: URLs. + + * gnus-sum.el (gnus-summary-show-article): Take `t' as the arg to mean + "raw". + + * nnimap.el (nnimap-find-article-by-message-id): Don't EXAMINE a group + if it's already selected. + + * mm-decode.el (mm-save-part): Put the entire path in the `M-n' slot. + +2010-11-04 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-tag-img): Use string-width and truncate-string-to-width + to measure the length and truncate alt text. + +2010-11-03 Glenn Morris <rgm@gnu.org> + + * nndiary.el (nndiary-generate-nov-databases-1) + (nndiary-generate-active-info): Rename dynamic variable `files' to + something less generic. + +2010-11-03 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-request-move-article): Call the underlying backend to + move articles from nnir. + +2010-11-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-cite.el (gnus-article-natural-long-line-p): Remove. + +2010-11-02 Julien Danjou <julien@danjou.info> + + * nnir.el: Remove wais support. + +2010-11-02 Glenn Morris <rgm@gnu.org> + + * gnus-html.el: Reorder requirements to quieten compiler. + +2010-11-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-cite.el (gnus-article-fill-cited-article): Make fill work + properly for XEmacs as well. + (gnus-article-fill-cited-article, gnus-article-foldable-buffer) + (gnus-article-natural-long-line-p): Use window-width rather than + frame-width. + +2010-11-01 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-run-gmane): Inhibit demon. Return nil if no messages. + (nnir-read-parms): Don't modify query. + (nnir-run-query): Add ability to search topic on current line. + (nnir-get-active): Clean up. + +2010-11-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-cite.el (gnus-article-foldable-buffer): Protect against + degenerate articles. + + * gnus-sum.el (gnus-print-buffer): Rewrite to use with-temp-buffer. + (gnus-print-buffer): Just print the buffer as is, without any copying + to a buffer and then re-highlighting. + + * nnimap.el (nnimap-request-group): Store the new updated info. + (nnimap-request-group): Select the group when we don't know whether it + exists or not. + + * gnus-start.el (gnus-ask-server-for-new-groups): Return the new + groups. + + * gnus-group.el (gnus-group-find-new-groups): Display all the new + groups. + + * gnus-start.el (gnus-find-new-newsgroups): Return the list of new + groups. + + * gnus-cite.el (gnus-article-fill-cited-article): Minimize the + long-lines case by only filling the long lines. + + * nnimap.el (nnimap-parse-line): Don't bug out oddly formed replies + (bug #7311). + +2010-11-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el: No need to declare `declare-function' since shr.el is for + only Emacsen that provide `libxml-parse-html-region'. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * mm-util.el (gnus-completing-read): Autoload. + (mm-read-coding-system): Simplify Emacs definition. + + * nnmail.el (gnus-activate-group): + * nnimap.el (gnutls-negotiate): + * nntp.el (netrc-parse): Fix declarations. + +2010-11-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-util.el (gnus-string-match-p): New function, that is an alias to + string-match-p in Emacs >=23. + + * gnus-msg.el (gnus-configure-posting-styles) + * nnir.el (nnir-run-gmane): Use gnus-string-match-p. + +2010-11-01 Glenn Morris <rgm@gnu.org> + + * nnir.el (declare-function): Add compat stub. + (mm-url-insert, mm-url-encode-www-form-urlencoded): Declare. + (nnir-run-gmane): Require 'mm-url. + + * mm-util.el (mm-string-to-multibyte): Simplify. + + * shr.el (declare-function): Add compat stub. + (url-cache-create-filename): Declare. + (mm-disable-multibyte, widget-convert-button): Autoload. + + * smime.el (ldap-search): Declare. + (smime-cert-by-ldap-1): Require ldap on Emacs. + + * nnimap.el: Require nnmail, and gnus-sum when compiling. + (nnimap-keepalive): Use gnus-float-time. + + * mail-source.el (nnheader-message, gnus-float-time): Autoload. + (mail-source-delete-crash-box): Use gnus-float-time. + + * gnus-dired.el (gnus-completing-read): Autoload. + + * mm-view.el (gnus-rescale-image): Autoload. + + * mm-decode.el (gnus-completing-read, gnus-blocked-images): Autoload. + + * gnus.el (gnus-sloppily-equal-method-parameters): Move defn before use. + + * sieve-manage.el: Require 'cl when compiling. + + * gnus-util.el (iswitchb-read-buffer): Declare rather than autoload. + (gnus-iswitchb-completing-read): Require iswitchb. + (gnus-select-frame-set-input-focus): Silence compiler. + +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-subject-trailing-was-query): Change default to t, + since I think that's what most people want. + + * nnimap.el (nnimap-request-accept-article): Erase buffer before + appending for easier debugging. + (nnimap-wait-for-connection): Take a regexp. + (nnimap-request-accept-article): Wait for the continuation line before + sending anything unless we're streaming. + + * gnus-art.el (gnus-treat-article): Only inhibit body washing, and + leave the header washing to take place. + +2010-10-31 Daniel Dehennin <daniel.dehennin@baby-gnu.org> + + * gnus-msg.el (gnus-configure-posting-styles): Permit the use of + regular expression match and replace in posting styles. + +2010-10-31 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (gnus-group-make-nnir-group,nnir-run-query): Allow searching + an entire server. + (nnir-get-active): New function. + (nnir-run-imap): Use it. + (nnir-run-gmane): Who knew, gmane search returns an article score! + + * gnus-srvr.el (gnus-server-mode-map): Add binding "G" to search the + server on the current line with nnir. + +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-cite.el (gnus-article-foldable-buffer): Refactor out. + (gnus-article-foldable-buffer): Don't fold regions that have a ragged + left edge. + (gnus-article-foldable-buffer): Skip past the prefix when determining + raggedness. + + * gnus-sum.el (gnus-summary-show-article): Add `C-u C-u g' for showing + the raw article, and change `C-u g' to show the article without doing + treatments. + + * gnus-art.el (gnus-mime-display-alternative): Actually pass the type + on to `gnus-treat-article'. + (gnus-inhibit-article-treatments): New variable. + + * gnus.el: Autoload gnus-article-fill-cited-long-lines. + + * gnus-art.el (gnus-treatment-function-alist): Have + gnus-treat-fill-long-lines point to gnus-article-fill-cited-long-lines. + (gnus-treat-fill-long-lines): Change default to fill all text/plain + sections. + + * gnus-cite.el (gnus-article-fill-cited-article): Remove unused `force' + parameter. + (gnus-article-fill-cited-long-lines): New function. + (gnus-article-fill-cited-article): Allow filling only long sections. + + * shr.el (shr-find-fill-point): Don't break lines between punctuation + and non-punctuation (like after the apostrophe in "'We"). + + * gnus-sum.el (gnus-summary-select-article): Make sure + gnus-original-article-buffer is alive. + + * nndoc.el (nndoc-dissect-buffer): Reverse the order of the articles to + reflect the order they're in in the digest. + + * gnus.el (gnus-group-startup-message): Move point to the start of the + buffer. + + * nnimap.el (nnimap-capability): New function. + (nnimap-open-connection): Only send AUTHENTICATE PLAIN if LOGINDISABLED + is set. + +2010-10-31 David Engster <dengste@eml.cc> + + * nnmairix.el (nnmairix-get-valid-servers): Return list of strings to + conform with changes to gnus-completing-read. + +2010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-img): Output "*" instead of "[img]". + +2010-10-30 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el: Move defvar, defcustom around to keep file organized + and keep byte-compiler quiet. + (nnir-read-parms): Accept search-engine as arg. + (nnir-run-query): Pass search-engine as arg. + (nnir-search-engine): Remove. + +2010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-generic): The text nodes should be text, not :text. + + * nnir.el (nnir-search-engine): Ressurect variable, since it's used + later in the file. + +2010-10-30 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el: General clean up. Allow searching with multiple engines. + Allow separate extra-parameters for each engine. + Batch queries when possible. + (nnir-imap-default-search-key,nnir-method-default-engines): + Add customize interface. + (nnir-run-gmane): New engine. + (nnir-engines): Use it. Qualify all prompts with engine name. + (nnir-search-engine): Remove global variable. + (nnir-run-hyrex): Restore for now. + (nnir-extra-parms,nnir-search-history): New variables. + (gnus-group-make-nnir-group): Use them. + (nnir-group-server): Remove in favor of gnus-group-server. + (nnir-request-group): Avoid searching twice. + (nnir-sort-groups-by-server): New function. + +2010-10-30 Julien Danjou <julien@danjou.info> + + * gnus-group.el: Remove gnus-group-fetch-control. + + * gnus-start.el (gnus-find-new-newsgroups): + Remove gnus-check-first-time-used. + + * gnus.el: Remove gnus-backup-default-subscribed-newsgroups. + +2010-10-30 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change) + + * nnimap.el (nnimap-update-info): Allow 'ticked and other flags to be + set on groups that don't have \* permanentflags. + +2010-10-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-span): Drop colorisation of regions since we don't + control the background color. + (shr-tag-img): Ignore very small web bug type images. + (shr-put-image): Add help-echo alt texts to the images. + (shr-tag-video): Show the video poster image. + +2010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-table-depth): New variable. + (shr-tag-table-1): Only insert the images after the top-level table. + + * nnimap.el (nnimap-split-incoming-mail): Fix typo. + + * gnus-util.el (gnus-list-memq-of-list): New function. + + * nnimap.el (nnimap-split-incoming-mail): Note that the INBOX has been + selected. + (nnimap-unsplittable-articles): New slot. + (nnimap-new-articles): Use it. + +2010-10-29 Stephen Berman <stephen.berman@gmx.net> (tiny change) + + * gnus-group.el (gnus-group-get-new-news-this-group): Don't have point + move to the previous line on `M-g'. + +2010-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-msg.el (gnus-inews-do-gcc): Don't have the backends do the slow + *-request-group, which seems unnecessary. + + * nnimap.el (nnimap-quote-specials): Function copied over from + imap.el. + (nnimap-open-connection): Use AUTHENTICATE PLAIN on servers that say + they support that. Suggested by Tom Regner. + +2010-10-29 Julien Danjou <julien@danjou.info> + + * gnus-sum.el (gnus-summary-delete-marked-as-read): Remove obsolete + defalias. + (gnus-summary-delete-marked-with): Remove obsolete defalias. + + * gnus.el: Remove `gnus-nntp-service' variable. + (gnus-secondary-servers): Make obsolete. + (gnus-nntp-server): Make obsolete. + + * gnus-start.el (gnus-1): Remove x-splash calls. + + * gnus-ems.el (gnus-x-splash): Remove. + + * gnus.el (gnus-group-startup-message): Simplify/update code. + + * gnus-group.el (gnus-group-make-tool-bar): Check for display graphic + capability before doing anything. + (gnus-group-insert-group-line): Remove useless + gnus-group-remove-excess-properties. + +2010-10-29 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-goto-part): Work for article narrowed by ^L. + +2010-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-rescan-group): Try to restore the window + config after reselecting. + +2010-10-28 Julien Danjou <julien@danjou.info> + + * shr.el (shr-put-image): Use point even if only inserting text. + (shr-put-image): Save excursion when inserting alt text on non-graphic + display, so the behaviour is the same when we are on a graphic display. + + * nnir.el (nnir-run-swish-e): Remove hyrex support. + +2010-10-28 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-jump-to-part): Error on no part; fix prompt. + (gnus-mime-copy-part): Check coding system, not charset. + (gnus-mime-view-part-externally): Never remove part. + (gnus-mime-view-part-internally): Don't remove part here. + (gnus-article-part-wrapper): Make sure MIME tag is visible. + (gnus-article-goto-part): Go to displayed or preferred subpart if it is + multipart/alternative. + + * mm-decode.el (mm-display-part): Take optional arg `force'. + +2010-10-26 Julien Danjou <julien@danjou.info> + + * gnus-group.el (gnus-group-default-list-level): Add this function to + compute the default list level. + (gnus-group-default-list-level): Add possibility to use a function. + +2010-10-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-decode.el (mm-shr): Add undisplayer to MIME handle. + + * gnus-group.el (gnus-group-completing-read) + (gnus-read-ephemeral-bug-group): Replace replace-regexp-in-string with + gnus-replace-in-string. + +2010-10-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-tag-div): Add. + +2010-10-25 Julien Danjou <julien@danjou.info> + + * gnus-util.el: Remove `gnus-with-local-quit'. + + * gnus-demon.el (gnus-demon-init): Use run-with-idle-timer function. + +2010-10-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-select-article): Fix type error in checking + the original article buffer. + +2010-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-request-head): New function. + (nnimap-request-move-article): Try to be slighly faster by not + requesting the entire message when moving. + (nnimap-transform-headers): Don't bug out on bodiless articles. + (nnimap-send-command): Have no outstanding messages if the IMAP server + doesn't support streaming. + (nnimap-transform-headers): Fold {quoted} strings more sloppily. + +2010-10-24 Julien Danjou <julien@danjou.info> + + * message.el (message-default-headers): Fix type. + +2010-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-prefetch-images): Decode entities before + prefetching images. + + * gnus-sum.el (gnus-group-make-articles-read): Propagate marks to the + backend for unknown groups. This is mainly useful for nnimap groups. + + * gnus-agent.el (gnus-agent-fetch-group): Don't download stuff if the + group isn't covered by the agent. + +2010-10-22 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-method-default-engines): New variable. + (nnir-run-query): Use it. + (nnir-group-mode-hook): Remove key binding and move to gnus-group.el. + (gnus-summary-nnir-goto-thread): Change group if needed. + + * gnus-group.el (gnus-group-group-map): Add key binding for + gnus-group-make-nnir-group. + +2010-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-object): Add. + + * gnus-sum.el (gnus-summary-select-article): Make sure we have the + original article buffer live. + (gnus-summary-select-article-buffer): + Mention gnus-widen-article-buffer. + +2010-10-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-strong): Add. + +2010-10-22 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-group-completing-read): Remove all newlines from + group names. They mess up the group buffer badly. + + * shr.el (shr-tag-img): Don't bug out on images that don't have a SRC. + + * gnus-group.el (gnus-group-mark-group): Use gnus-group-position-point + instead of the summary one. + +2010-10-22 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el (mml-preview): Work properly when editing article. + + * gnus-start.el (gnus-read-active-file-1): Don't add method to + gnus-have-read-active-file if it's already been in. + +2010-10-22 Tom Tromey <tromey@redhat.com> + + * gnus-group.el (gnus-group-unsubscribe-group): Fix args passed to + gnus-group-completing-read. + +2010-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-mode-map): Don't bind M-; to comment region, to + allow the global comment-dwim to work. + +2010-10-21 Julien Danjou <julien@danjou.info> + + * message.el (message-setup-1): Allow message-default-headers to be a + function. + +2010-10-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-tag-table): Simplify. + +2010-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-prefetch-images): Only prefetch http images + to avoid trying to snarf invalid stuff. + + * gnus-sum.el (gnus-summary-edit-article-done): Bind free variable. + + * gnus.el (gnus-message-archive-group): Quote value. + (gnus-message-archive-group): Mark as changed. + + * shr.el (shr-add-font): Don't put the font properties on the newline + or the indentation. + + * message.el (message-fix-before-sending): Change options when sending + non-printable characters. + + * gnus.el (gnus-message-archive-method): Change the default to + monthly outgoing groups. + + * gnus-sum.el (gnus-summary-edit-article-done): Try to replace articles + that have gotten new numbers. + + * nnimap.el (nnimap-request-replace-article): New function. + +2010-10-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnrss.el (nnrss-wash-html-in-text-plain-parts): Remove. + (nnrss-request-article): Don't use special html washing code. + +2010-10-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-tag-table): Remove useless nconc. + +2010-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (article-wash-html): Simplify and remove the charset + stuff. Use the normal html rendering code instead of the special html + washing code. + + * mm-view.el (mm-text-html-renderer-alist): Add the `shr' and + `gnus-w3m' symbols. + (mm-text-html-washer-alist): Remove. + + * mm-decode.el (mm-inline-text-html-renderer): Remove. + (mm-inline-media-tests): Remove use. + (mm-text-html-renderer): Change default to the `shr' symbol. + + * mm-view.el (mm-inline-text-html): Remove use. + + * gnus-art.el (gnus-blocked-images): New function. Allow the + `gnus-blocked-images' to be a function. + (gnus-article-wash-function): Remove. + +2010-10-20 Julien Danjou <julien@danjou.info> + + * spam.el (spam-list-of-processors): Mark as obsolete. + + * nnimap.el (nnimap-request-article): Fix BODYSTRUCTURE retrieval. + (nnimap-insert-partial-structure): Fix boundary detection. + +2010-10-20 Andreas Seltenreich <seltenreich@gmx.de> + + * gnus-draft.el (gnus-draft-check-draft-articles): Don't unnecessarily + run file-truename on remote files. This can be expensive and even + prevent one from editing drafts if some unrelated buffer has a stale + connection. + +2010-10-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-find-fill-point): Shorten line if the preceding char is + kinsoku-eol regardless of shr-kinsoku-shorten. + (shr-tag-table-1): Rename from shr-tag-table; make it a subroutine. + (shr-tag-table): Support caption, thead, and tfoot. + +2010-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-find-fill-point): Don't leave blanks at the start of some + lines. + (shr-save-contents): New command and keystroke. + + * nndoc.el (nndoc-type-alist): Add git support. + (nndoc-git-type-p): New function. + (nndoc-transform-git-article): Ditto. + (nndoc-transform-git-headers): Ditto. + (nndoc-transform-git-headers): Generate Subject headers. + + * shr.el (shr-parse-style): New function. + (shr-tag-span): Ditto. + + * nnmairix.el (nnmairix-summary-mode-hook): Move nnmairix's `$' command + to `G G' to avoid collisions. + +2010-10-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el: Load kinsoku if necessary. + (shr-kinsoku-shorten): New internal variable. + (shr-find-fill-point): Make kinsoku shorten text line if + shr-kinsoku-shorten is bound to non-nil. + (shr-tag-table): Bild shr-kinsoku-shorten to t; refer to + shr-indentation too when testing if table is wider than frame width. + (shr-insert-table): Use `string-width' instead of `length' to measure + text width. + (shr-insert-table-ruler): Make sure indentation is done at bol. + +2010-10-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * nnimap.el (nnimap-request-move-article, nnimap-parse-line) + (nnimap-process-expiry-targets): Use unibyte for buffers that hold + undecoded network data. + +2010-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-agent.el (gnus-agent-toggle-plugged): Use the right minor mode + name in the mode line spec so that the mode line menu works + (bug #2431). + + * message.el (message-get-reply-headers): If we're fed `to-address', + then always use that. + + * gnus-art.el (gnus-article-make-menu-bar): The article/group menus + aren't so wide as to need to switch off the edit menu. + + * gnus-delay.el (gnus-delay-article): Remove superfluous `group' + binding. Suggested by Leo <sdl.web@gmail.com> (bug #6613). + + * nnimap.el (nnimap-request-group): Don't SELECT the group twice on + `M-g'. + (nnimap-update-info): Update flags/read marks even if \* isn't part of + the permanent marks. + +2010-10-18 Andrew Cohen <cohen@andy.bu.edu> + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Splitting according to references/in-reply-to obeys the ignore-groups + variable, while splitting by sender and subject do not. + +2010-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-article-dumbquotes-map): Make into a char/string + alist, so that we can look for non-Unicode chars. + (article-translate-strings): Allow both character and string maps. + +2010-10-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * shr.el (shr-insert): Don't insert space behind a wide character + categorized as kinsoku-bol, or between characters both categorized as + nospace. + +2010-10-16 Andrew Cohen <cohen@andy.bu.edu> + + * gnus-sum.el (gnus-summary-refer-thread): Bug fix. Add the thread + headers to gnus-newsgroup-headers. + +2010-10-16 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-img): Don't align images -- since we're not + rescaling, this often leads to ugly displays. + +2010-10-15 Andrew Cohen <cohen@andy.bu.edu> + + * gnus-sum.el (gnus-summary-refer-thread): Unconditionally ignore + duplicates. + +2010-10-15 Kan-Ru Chen <kanru@kanru.info> (tiny change) + + * gnus-diary.el (gnus-diary-check-message): Fix gnus-completing-read + call. + 2010-10-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + * gnus.el: Autoload gnus-html-show-images. + + * nnimap.el: Use nnheader-message throughout. + * shr.el (shr-tag-img): Ignore images with no data. +2010-10-15 Julien Danjou <julien@danjou.info> + + * mml.el (mml-generate-mime-1): Add `mml-enable-flowed' variable to add + a possibility to disable format=flow encoding when using hard newlines. + 2010-10-15 Katsumi Yamaoka <yamaoka@jpl.org> - * shr.el (shr-generic): Remove trailing space. - (shr-insert): Remove space inserted before or after a breakable - character or at the beginning or the end of a line. + * shr.el (shr-insert): Remove space inserted before or after a + breakable character or at the beginning or the end of a line. (shr-find-fill-point): Do kinsoku; find the second best point or give it up if there's no breakable point. @@ -61,7 +1637,7 @@ * shr.el (shr-find-fill-point): Use a filling algorithm that should probably work for CJVK text, too. - * nnimap.el (nnimap-extend-tls-programs): Removed. + * nnimap.el (nnimap-extend-tls-programs): Remove. (nnimap-open-connection): Bind STARTTLS to openssl explicitly. 2010-10-13 Julien Danjou <julien@danjou.info> @@ -118,7 +1694,7 @@ 2010-10-12 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-gravatar.el (gnus-art): Required. + * gnus-gravatar.el (gnus-art): Require. * gnus-sum.el (gnus-summary-mark-as-unread-forward) (gnus-summary-mark-as-unread-backward, gnus-summary-mark-as-unread): @@ -128,12 +1704,12 @@ * nnimap.el (gnutls-negotiate): Silence the byte compiler. - * gnus-art.el, gnus-cache.el, gnus-fun.el, gnus-group.el, - gnus-picon.el, gnus-spec.el, gnus-sum.el, gnus-util.el, gnus.el, - mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el, - mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el, - nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el, - rfc1843.el, sieve-manage.el, smime.el, spam.el: + * gnus-art.el, gnus-cache.el, gnus-fun.el, gnus-group.el: + * gnus-picon.el, gnus-spec.el, gnus-sum.el, gnus-util.el, gnus.el: + * mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el: + * mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el: + * nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el: + * rfc1843.el, sieve-manage.el, smime.el, spam.el: Fix comment for declare-function. 2010-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -197,8 +1773,8 @@ 2010-10-10 Andrew Cohen <cohen@andy.bu.edu> * nnir.el (autoload): Clean up autoloads. - (nnir-imap-default-search-key): Renamed from - nnir-imap-search-field. Use key rather than value. + (nnir-imap-default-search-key): Rename from nnir-imap-search-field. + Use key rather than value. (nnir-imap-search-other): New variable. (nnir-read-parm): Use it. (nnir-imap-expr-to-imap): Use %S rather than imap-quote-specials. @@ -211,8 +1787,8 @@ 2010-10-09 Lars Magne Ingebrigtsen <larsi@gnus.org> - * spam.el (gnus-summary-mode-map): Bind to "$". Suggested by Russ - Allbery. + * spam.el (gnus-summary-mode-map): Bind to "$". + Suggested by Russ Allbery. * shr.el: Rework the way things are indented by <li> slightly. @@ -300,8 +1876,8 @@ (shr-tag-hr): New function. * nnimap.el (nnimap-update-info): Remove double setting of high. - (nnimap-update-info): Don't ignore groups that have no UIDNEXT. This - makes nnimap work properly on Courier again. + (nnimap-update-info): Don't ignore groups that have no UIDNEXT. + This makes nnimap work properly on Courier again. * gnus.el (gnus-carpal): The carpal mode has been removed, but define the variable for backwards compatability. @@ -522,7 +2098,7 @@ 2010-10-04 Lars Magne Ingebrigtsen <larsi@gnus.org> - * shr.el (browse-url): Required. + * shr.el (browse-url): Require. (shr-ensure-paragraph): Don't insert a new newline after empty-ish lines. (shr-show-alt-text, shr-browse-image): New commands. @@ -608,8 +2184,7 @@ * gnus-sum.el (gnus-summary-select-article-buffer): Really select the article buffer again. - * shr.el (shr-tag-p): Don't insert newlines at the start of the - buffer. + * shr.el (shr-tag-p): Don't insert newlines at the start of the buffer. * mm-decode.el (mm-shr): Narrow before inserting, so that shr can know when it's at the start of the buffer. @@ -689,8 +2264,8 @@ * gnus-start.el (gnus-check-bogus-newsgroups): Say how many groups we're being queried about. Suggested by Dan Jacobson. - * nndoc.el (nndoc-type-alist): Do babyl before mime-parts. Suggested - by Jason Eisner. + * nndoc.el (nndoc-type-alist): Do babyl before mime-parts. + Suggested by Jason Eisner. * gnus-async.el (gnus-async-delete-prefetched-entry): Remove from hash table, too. Suggested by Stefan Wiens. @@ -726,8 +2301,8 @@ * gnus-sum.el (gnus-summary-scroll-up): Add more documentation. Suggested by Dan Jacobson. - * gnus.el (gnus-large-newsgroup): Mention - gnus-large-ephemeral-newsgroup. Suggested by Dan Jacobson. + * gnus.el (gnus-large-newsgroup): + Mention gnus-large-ephemeral-newsgroup. Suggested by Dan Jacobson. * gnus-msg.el (gnus-summary-resend-message): When resending, don't externalize attachments. Bug reported by Steve Wen. @@ -821,12 +2396,12 @@ * nnimap.el (nnimap-find-article-by-message-id): Use EXAMINE instead of SELECT to get the message-id. - * mail-source.el (mail-sources): Removed webmail support. + * mail-source.el (mail-sources): Remove webmail support. (defvar): Ditto. (mail-source-fetcher-alist): Ditto. - (mail-source-fetch-webmail): Removed. + (mail-source-fetch-webmail): Remove. - * webmail.el: Removed -- doesn't seem relevant any more. + * webmail.el: Remove -- doesn't seem relevant any more. * gnus.el: Fix up make-obsolete-variable declarations throughout. @@ -855,8 +2430,8 @@ (nnimap-request-set-mark): Erase the buffer before issuing commands. (nnimap-split-rule): Mark as obsolete. - * pop3.el (pop3-send-streaming-command, pop3-stream-length): New - variable. + * pop3.el (pop3-send-streaming-command, pop3-stream-length): + New variable. * nnimap.el (nnimap-insert-partial-structure): Get the type from the correct slot, too. @@ -865,8 +2440,8 @@ * gnus.el (gnus-local-domain): Declare variable obsolete. - * gnus-util.el (gnus-icompleting-read): Require iswitchb. Fix history - computing. + * gnus-util.el (gnus-icompleting-read): Require iswitchb. + Fix history computing. (gnus-ido-completing-read): Require ido. 2010-09-29 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -884,7 +2459,7 @@ 2010-09-29 Ludovic Courtes <ludo@gnu.org> - * nnregistry.el: Added. + * nnregistry.el: Add. 2010-09-29 Stefan Monnier <monnier@iro.umontreal.ca> @@ -929,79 +2504,43 @@ 2010-09-27 Julien Danjou <julien@danjou.info> - * gnus-srvr.el (gnus-server-add-server): Use gnus-completing-read. - (gnus-server-goto-server): Use gnus-completing-read. - - * mm-view.el (mm-view-pkcs7-decrypt): Use gnus-completing-read. - - * mm-util.el (defalias): Use gnus-completing-read. - (mm-codepage-setup): Use gnus-completing-read. - - * smime.el (smime-sign-buffer): Use gnus-completing-read. - (smime-decrypt-buffer): Use gnus-completing-read. - - * mml-smime.el (mml-smime-openssl-sign-query): Use gnus-completing-read. - - * mml.el (mml-minibuffer-read-type): Use gnus-completing-read. - (mml-minibuffer-read-disposition): Use gnus-completing-read. - (mml-insert-multipart): Use gnus-completing-read. - - * gnus-msg.el (gnus-summary-yank-message): Use gnus-completing-read. - - * gnus-int.el (gnus-start-news-server): Use gnus-completing-read. - - * mm-decode.el (mm-interactively-view-part): Use gnus-completing-read. - - * gnus-dired.el (gnus-dired-attach): Use gnus-completing-read. - - * gnus.el (gnus-read-method): Use gnus-completing-read. - - * gnus-bookmark.el (gnus-bookmark-jump): Use gnus-completing-read. - - * gnus-art.el (gnus-mime-view-part-as-type): Use gnus-completing-read. - (gnus-mime-action-on-part): Use gnus-completing-read. - (gnus-article-encrypt-body): Use gnus-completing-read. - - * gnus-topic.el (gnus-topic-jump-to-topic): Use gnus-completing-read. - (gnus-topic-move-matching): Use gnus-completing-read. - (gnus-topic-copy-matching): Use gnus-completing-read. - (gnus-topic-sort-topics): Use gnus-completing-read. - (gnus-topic-move): Use gnus-completing-read. - - * gnus-agent.el (gnus-agent-read-group): Remove prompt computing. - (gnus-agent-add-group): Use gnus-completing-read. - - * nnmairix.el (nnmairix-create-server-and-default-group): Use - gnus-completing-read. - (nnmairix-update-groups): Use gnus-completing-read. - (nnmairix-get-server): Use gnus-completing-read. - (nnmairix-backend-to-server): Use gnus-completing-read. - (nnmairix-goto-original-article): Use gnus-completing-read. - (nnmairix-get-group-from-file-path): Use gnus-completing-read. - - * nnrss.el (nnrss-find-rss-via-syndic8): Use gnus-completing-read. - - * gnus-group.el (gnus-group-completing-read): Use gnus-completing-read. - (gnus-group-make-useful-group): Use gnus-completing-read. - (gnus-group-make-web-group): Use gnus-completing-read. - (gnus-group-add-to-virtual): Use gnus-completing-read. - (gnus-group-browse-foreign-server): Use gnus-completing-read. - - * gnus-sum.el (gnus-summary-goto-article): Use gnus-completing-read. - (gnus-summary-limit-to-extra): Use gnus-completing-read. - (gnus-summary-execute-command): Use gnus-completing-read. - (gnus-summary-respool-article): Use gnus-completing-read. - (gnus-read-move-group-name): Use gnus-completing-read. - - * gnus-score.el (gnus-summary-increase-score): Use gnus-completing-read. - (gnus-summary-score-effect): Use gnus-completing-read. - - * gnus-registry.el (gnus-registry-read-mark): Use gnus-completing-read. - * gnus-util.el (gnus-completing-read): Use gnus-use-ido to apply the right completing-read function. (gnus-use-ido): New variable (gnus-completing-read-with-default): Remove. + * gnus-agent.el (gnus-agent-read-group): Remove prompt computing. + (gnus-agent-add-group): + * gnus-srvr.el (gnus-server-add-server, gnus-server-goto-server): + * mm-view.el (mm-view-pkcs7-decrypt): + * mm-util.el (mm-codepage-setup): + * smime.el (smime-sign-buffer, smime-decrypt-buffer): + * mml-smime.el (mml-smime-openssl-sign-query): + * mml.el (mml-minibuffer-read-type, mml-minibuffer-read-disposition) + (mml-insert-multipart): + * gnus-msg.el (gnus-summary-yank-message): + * gnus-int.el (gnus-start-news-server): + * mm-decode.el (mm-interactively-view-part): + * gnus-dired.el (gnus-dired-attach): + * gnus.el (gnus-read-method): + * gnus-bookmark.el (gnus-bookmark-jump): + * gnus-art.el (gnus-mime-view-part-as-type) + (gnus-mime-action-on-part, gnus-article-encrypt-body): + * gnus-topic.el (gnus-topic-jump-to-topic, gnus-topic-move-matching) + (gnus-topic-copy-matching, gnus-topic-sort-topics, gnus-topic-move): + * nnmairix.el (nnmairix-create-server-and-default-group) + (nnmairix-update-groups, nnmairix-get-server) + (nnmairix-backend-to-server, nnmairix-goto-original-article) + (nnmairix-get-group-from-file-path): + * nnrss.el (nnrss-find-rss-via-syndic8): + * gnus-group.el (gnus-group-completing-read, gnus-group-make-web-group) + (gnus-group-make-useful-group, gnus-group-add-to-virtual) + (gnus-group-browse-foreign-server): + * gnus-sum.el (gnus-summary-goto-article, gnus-summary-limit-to-extra) + (gnus-summary-execute-command, gnus-summary-respool-article) + (gnus-read-move-group-name): + * gnus-score.el (gnus-summary-increase-score) + (gnus-summary-score-effect): + * gnus-registry.el (gnus-registry-read-mark): Use gnus-completing-read. 2010-09-28 Katsumi Yamaoka <yamaoka@jpl.org> @@ -1014,7 +2553,8 @@ always. (message-sendmail-envelope-from): Comment fix. (message-yank-prefix): Default to mail-yank-prefix always. - (message-indentation-spaces): Default to mail-indentation-spaces always. + (message-indentation-spaces): + Default to mail-indentation-spaces always. (message-signature-file): Default to mail-signature-file always. 2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1033,7 +2573,7 @@ 2010-09-27 David Engster <dengste@eml.cc> - * nnmairix.el: (nnmairix-replace-group-and-numbers): Deal with NOV as + * nnmairix.el (nnmairix-replace-group-and-numbers): Deal with NOV as well as HEADERS. (nnmairix-retrieve-headers): Provide new argument for the above. @@ -1052,8 +2592,7 @@ * nnimap.el (nnimap-find-wanted-parts-1): Use it. - * gnus-art.el (gnus-fetch-partial-articles): Moved back to nnimap - again. + * gnus-art.el (gnus-fetch-partial-articles): Move back to nnimap again. * nnimap.el (nnimap-request-accept-article): Remove the "." at the end, since some servers don't like it. @@ -1073,7 +2612,7 @@ 2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnimap.el (utf7): Required. + * nnimap.el (utf7): Require. * message.el (message-cite-prefix-regexp): Remove "}" from citation prefix. @@ -1096,8 +2635,8 @@ * nndoc.el (nndoc-request-list): Return success always. * gnus-agent.el (gnus-agent-retrieve-headers): Don't propagate - `fetch-old' -- we only want to fetch the articles we've requested. The - rest are in the agent, probably. + `fetch-old' -- we only want to fetch the articles we've requested. + The rest are in the agent, probably. (gnus-agent-read-servers-validate): Change the level for the "Ignoring disappeared server" to something low. It's not important. @@ -1150,8 +2689,8 @@ 2009-02-08 Dave Love <fx@gnu.org> - * gnus-win.el (gnus-window-to-buffer-helper, - gnus-all-windows-visible-p): Function needn't be a symbol. + * gnus-win.el (gnus-window-to-buffer-helper) + (gnus-all-windows-visible-p): Function needn't be a symbol. * mail-source.el (mail-source-value): Function needn't be a symbol. @@ -1170,7 +2709,7 @@ doing the header highlightling, so that the background colour of the picon is correct. - * gnus-picon.el (gnus-picon-xbm): Removed obsolete face. + * gnus-picon.el (gnus-picon-xbm): Remove obsolete face. (gnus-picon): Ditto. (gnus-picon): Reinstate. The background colour for picons is white. (gnus-picon-insert-glyph): Make the background white. @@ -1195,7 +2734,7 @@ * mml2015.el (mml2015-use): Remove gpg support. * mml1991.el (mml1991-function-alist): Remove gpg function. - (mml1991-gpg-sign): Removed. + (mml1991-gpg-sign): Remove. 2010-09-26 Andreas Seltenreich <seltenreich@gmx.de> @@ -1208,32 +2747,32 @@ * gnus-group.el (gnus-read-ephemeral-bug-group): Add the bug email address to the To list for easier response. - * gnus.el (gnus-play-startup-jingle): Removed. + * gnus.el (gnus-play-startup-jingle): Remove. (gnus-splash): Don't play jingle. (gnus): Silence gnus-load message. - * gnus-art.el (gnus-treat-play-sounds): Removed. + * gnus-art.el (gnus-treat-play-sounds): Remove. * gnus.el (gnus-play-jingle): Remove audio support. * gnus-cus.el (gnus-score-customize): Remove audio reference. - * earcon.el: Removed -- no users. + * earcon.el: Remove -- no users. - * gnus-audio.el: Removed -- no users of this package. + * gnus-audio.el: Remove -- no users of this package. * gnus-sum.el (gnus-summary-limit-children): Remove nocem support. * gnus-start.el (gnus-setup-news): Remove nocem support. - * gnus-group.el (gnus-group-get-new-news): Removed nocem call. + * gnus-group.el (gnus-group-get-new-news): Remove nocem call. - * gnus.el (gnus-use-nocem): Removed. + * gnus.el (gnus-use-nocem): Remove. * gnus-demon.el (gnus-demon-add-nocem, gnus-demon-scan-nocem): - Removed. + Remove. - * gnus-nocem.el (gnus-nocem-issuers): Removed file. Apparently nobody + * gnus-nocem.el (gnus-nocem-issuers): Remove file. Apparently nobody uses NoCeM any more. * gnus-art.el (gnus-ctan-url): Seems not very useful -- removed. @@ -1242,11 +2781,11 @@ (gnus-button-ctan-directory-regexp): Ditto. (gnus-button-handle-ctan): Ditto. (gnus-button-tex-level): Ditto. - (gnus-button-alist): Removed CTAN stuff. + (gnus-button-alist): Remove CTAN stuff. 2010-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnimap.el (nnimap-wait-for-response): Reversed logic in the + * nnimap.el (nnimap-wait-for-response): Reverse logic in the nnimap-streaming test. * gnus-start.el (gnus-get-unread-articles): Don't try to open failed @@ -1276,8 +2815,8 @@ * mm-decode.el (mm-save-part): Allow saving to other directories the normal Emacs way. - * nndoc.el (nndoc-type-alist): Move mime-parts after mbox. Suggested - by Jay Berkenbilt. + * nndoc.el (nndoc-type-alist): Move mime-parts after mbox. + Suggested by Jay Berkenbilt. * gnus-art.el (gnus-mime-delete-part): Fix plural for "byte" when there isn't a single byte. @@ -1289,14 +2828,14 @@ * nnimap.el (nnimap-retrieve-group-data-early): Fix typo in the non-streaming case. - * gnus-art.el (gnus-flush-original-article-buffer): Separated out. + * gnus-art.el (gnus-flush-original-article-buffer): Separate out. (gnus-article-encrypt-body): Use it. * gnus-sum.el (gnus-summary-show-complete-article): New command and keystroke. - * nnimap.el (nnimap-find-wanted-parts-1): Use - gnus-fetch-partial-articles. + * nnimap.el (nnimap-find-wanted-parts-1): + Use gnus-fetch-partial-articles. * gnus-art.el (gnus-fetch-partial-articles): New variable. @@ -1308,7 +2847,7 @@ retrieval wasn't successful. (nnimap-retrieve-group-data-early): Allow throttling servers. (nnimap-streaming): New variable. - (nnimap-fetch-partial-articles): Removed. + (nnimap-fetch-partial-articles): Remove. * mm-decode.el (mm-with-part): Protect against killed buffers. @@ -1317,8 +2856,7 @@ 2010-09-25 Andrew Cohen <cohen@andy.bu.edu> (tiny change) - * nnir.el (nnir-run-imap): Allow sending IMAP search patterns - directly. + * nnir.el (nnir-run-imap): Allow sending IMAP search patterns directly. 2010-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1369,8 +2907,8 @@ * gnus.el: Remove useless gnus-local-domain. - * gnus-gravatar.el (gnus-gravatar-transform-address): Use - gnus-gravatar-size. + * gnus-gravatar.el (gnus-gravatar-transform-address): + Use gnus-gravatar-size. * gnus-art.el: Remove useless gnus-treat-translate. @@ -1386,19 +2924,19 @@ 2010-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-sum.el (gnus-summary-fetch-faq): Removed. + * gnus-sum.el (gnus-summary-fetch-faq): Remove. - * gnus-group.el (gnus-group-fetch-faq): Removed. + * gnus-group.el (gnus-group-fetch-faq): Remove. - * gnus.el (gnus-group-faq-directory): Removed. + * gnus.el (gnus-group-faq-directory): Remove. - * gnus-group.el (gnus-group-fetch-charter): Removed. + * gnus-group.el (gnus-group-fetch-charter): Remove. - * gnus.el (gnus-group-charter-alist): Removed. + * gnus.el (gnus-group-charter-alist): Remove. - * gnus-group.el (gnus-group-archive-directory): Removed. + * gnus-group.el (gnus-group-archive-directory): Remove. (gnus-group-recent-archive-directory): Ditto. - (gnus-group-make-archive-group): Removed. + (gnus-group-make-archive-group): Remove. * nnimap.el (nnimap-update-info): Protect against nil uidnexts. @@ -1411,7 +2949,7 @@ (nnimap-make-process-buffer): Store all the process buffers. (nnimap-keepalive): New function. - * starttls.el: (starttls-open-stream): Add autoload cookie. + * starttls.el (starttls-open-stream): Add autoload cookie. 2010-09-24 Michael Welsh Duggan <md5i@md5i.com> (tiny change) @@ -1439,8 +2977,8 @@ * gnus-art.el (toplevel): Don't bind recursive-load-depth-limit while loading gnus-sum.elc; fix comment for canlock-verify. (gnus-article-jump-to-part): Use read-number. - (gnus-insert-mime-button, gnus-insert-mime-security-button): Remove - Emacs pre-21 compatible code for help-echo. + (gnus-insert-mime-button, gnus-insert-mime-security-button): + Remove Emacs pre-21 compatible code for help-echo. (gnus-article-next-page-1): No need to adjust the number of lines. (gnus-article-describe-bindings): Always use help-buffer. @@ -1481,9 +3019,9 @@ 2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): - Removed. - (gnus-setup-news-hook): Removed - gnus-fixup-nnimap-unread-after-getting-new-news. + Remove. + (gnus-setup-news-hook): + Remove gnus-fixup-nnimap-unread-after-getting-new-news. * gnus-int.el (gnus-request-update-info): Protect against backends not having the function. @@ -1508,12 +3046,12 @@ * nnweb.el (nnweb-request-update-info): NOOP. - * nnmaildir.el (nnmaildir-request-marks): Renamed from -update-info. + * nnmaildir.el (nnmaildir-request-marks): Rename from -update-info. - * nnfolder.el (nnfolder-request-marks): Renamed from -update-info, + * nnfolder.el (nnfolder-request-marks): Rename from -update-info, since it only deals with marks. - * gnus-int.el (gnus-request-marks): Renamed gnus-request-update-info to + * gnus-int.el (gnus-request-marks): Rename gnus-request-update-info to gnus-request-marks, and make a new gnus-request-update-info. * nnimap.el (nnimap-update-info): When UIDNEXT is present, use that for @@ -1521,15 +3059,14 @@ 2010-09-23 Teodor Zlatanov <tzz@lifelogs.com> - * encrypt.el: Removed. + * encrypt.el: Remove. 2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> * nnimap.el (nnimap-update-info): Sync non-standard flags from the server in symbolic form. - * gnus-html.el (gnus-max-image-proportion): Increase proportion to - 0.9. + * gnus-html.el (gnus-max-image-proportion): Increase proportion to 0.9. 2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1549,8 +3086,8 @@ 2010-09-22 Julien Danjou <julien@danjou.info> - * gnus-group.el (gnus-group-insert-group-line): Call - gnus-group-highlight-line. + * gnus-group.el (gnus-group-insert-group-line): + Call gnus-group-highlight-line. (gnus-group-update-hook): Remove gnus-group-highlight-line from the default hook list. (gnus-group-update-eval-form): Add new function. @@ -1567,12 +3104,11 @@ 2010-09-22 Julien Danjou <julien@danjou.info> - * gnus-group.el (gnus-group-get-icon): Renamed gnus-group-add-icon that + * gnus-group.el (gnus-group-get-icon): Rename gnus-group-add-icon that Only return an icon. (gnus-group-insert-group-line): Compute icon to return. - * gnus-html.el (gnus-html-image-automatic-caching): Add custom - variable. + * gnus-html.el (gnus-html-image-automatic-caching): Add custom var. (gnus-html-image-fetched): Only cache if gnus-html-image-automatic-caching is set. (gnus-html-image-fetched): Check for errors. @@ -1604,7 +3140,7 @@ 2010-09-22 Julien Danjou <julien@danjou.info> - * gnus-html.el (gnus-html-put-image): Stop using markers. They are + * gnus-html.el (gnus-html-put-image): Stop using markers. They are harmful if you have 2 images side-by-side, they can't be properly update on text deletion. Using text-property is safer here. (gnus-html-image-fetched): Search also for \r\n\r\n to get the start of @@ -1612,7 +3148,7 @@ 2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnimap.el (nnimap-expunge-inbox): Removed. + * nnimap.el (nnimap-expunge-inbox): Remove. (nnimap-mark-and-expunge-incoming): Use nnimap-expunge instead. (nnimap-expunge): Flip default to t. @@ -1706,7 +3242,7 @@ * gnus-sum.el (gnus-summary-move-article): When respooling to the same method, this would bug out. - * gnus-group.el (gnus-group-expunge-group): Renamed from + * gnus-group.el (gnus-group-expunge-group): Rename from gnus-group-nnimap-expunge, and implemented as a normal interface function. @@ -1730,7 +3266,7 @@ cache. (gnus-html-put-image): Change buffer argument to use image data rather than file, and place image above region rather than inserting a new - one. Do not take alt-text as argument, since it's useless now: we place + one. Do not take alt-text as argument, since it's useless now: we place the image above alt-text. (gnus-html-prune-cache): Remove. (gnus-html-show-images): Start to fetch image when we find one, do not @@ -1795,8 +3331,7 @@ nnimap-server-port. (nnimap-request-article): Return the group/article number, so that Gnus `^' works as expected. - (nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants - them. + (nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants them. * gnus.el (gnus-similar-server-opened): Refactor a bit and add comments. @@ -1805,15 +3340,13 @@ file. * gnus-start.el (gnus-get-unread-articles): Make sure that we call - `gnus-open-server' on each method before trying to scan them etc. This - ensures that all the backend parameters are set correctly. + `gnus-open-server' on each method before trying to scan them etc. + This ensures that all the backend parameters are set correctly. * nnimap.el (nnimap-authenticator): New variable. (nnimap-open-connection): Allow anonymous login. - (nnimap-transform-headers): The chars header is called Chars not - Bytes. - (nnimap-wait-for-response): Don't infloop if the IMAP connection - drops. + (nnimap-transform-headers): The chars header is called Chars not Bytes. + (nnimap-wait-for-response): Don't infloop if the IMAP connection drops. * gnus-art.el (gnus-article-describe-briefly): Fix up typo in last patch, found by Knut Anders Hatlen. @@ -1906,7 +3439,7 @@ the range update right. (nnimap-request-group): Don't make `M-g' bug out on group with no marks. - (nnoo): Required, so that other packages can require nnimap. + (nnoo): Require, so that other packages can require nnimap. (nnimap-wait-for-response): Be a bit more lax in finding the end of the command we're looking for. This helps when the server sends more responses after we've gotten everything we expected. @@ -1985,7 +3518,7 @@ we're querying for. Also prompt for user name if that hasn't been given. - * nnimap.el (nnimap-with-process-buffer): Removed. + * nnimap.el (nnimap-with-process-buffer): Remove. 2010-09-17 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2102,10 +3635,10 @@ 2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-start.el (gnus-read-active-for-groups): Reverted the previous + * gnus-start.el (gnus-read-active-for-groups): Revert the previous change. - * nnrss.el (nnrss-request-list): Removed this function and related + * nnrss.el (nnrss-request-list): Remove this function and related functions, including the moreover stuff. 2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2144,8 +3677,8 @@ * mail-source.el (mail-source-fetch-pop): Use pop3-movemail again. - * pop3.el (pop3-movemail): Removed. - (pop3-streaming-movemail): Renamed to pop3-movemail. + * pop3.el (pop3-movemail): Remove. + (pop3-streaming-movemail): Rename to pop3-movemail. * gnus-html.el (gnus-html-wash-tags): Refactor out the image bit, and don't restrict end-tag searches to the end of the line. @@ -2165,8 +3698,8 @@ (gnus-html-wash-tags): Search for images first, so that <a><img> works better. - * gnus-async.el (gnus-async-article-callback): Call - `gnus-html-prefetch-images' unconditionally. + * gnus-async.el (gnus-async-article-callback): + Call `gnus-html-prefetch-images' unconditionally. * gnus-html.el (gnus-html-schedule-image-fetching): Decode entities before feeding URLs to curl. @@ -2229,7 +3762,7 @@ * nnimap.el (nnimap-request-list): Servers may return \NoSelect case-insensitively. - (nnimap-debug): Removed. + (nnimap-debug): Remove. * mail-source.el (mail-source-fetch): Don't message if we're fetching mail from a file, and the file doesn't exist. @@ -2282,13 +3815,13 @@ * mail-source.el (pop3-streaming-movemail): Autoload. - * pop3.el (pop3-streaming-movemail): Respect - pop3-leave-mail-on-server. + * pop3.el (pop3-streaming-movemail): + Respect pop3-leave-mail-on-server. * mail-source.el (mail-source-fetch-pop): Use streaming pop3 retrieval. - * pop3.el (pop3-process-filter): Removed unused function. + * pop3.el (pop3-process-filter): Remove unused function. (pop3-streaming-movemail, pop3-send-streaming-command) (pop3-wait-for-messages, pop3-write-to-file) (pop3-number-of-responses): New functions for streaming pop3 @@ -2299,7 +3832,7 @@ (gnus-make-hashtable-from-newsrc-alist): Remove duplicates from .newsrc list. - * pop3.el (pop3-display-message-size-flag): Removed -- everybody wants + * pop3.el (pop3-display-message-size-flag): Remove -- everybody wants message sizes. (pop3-movemail): Use erase-buffer instead of looping and deleting regions, which seems rather odd. @@ -2346,7 +3879,7 @@ (gnus-html-wash-tags): Add a new `i' command to insert images. (gnus-html-insert-image): New command and keystroke. (gnus-html-redisplay-with-images): New command and keystroke. - (gnus-html-show-images): Renamed command. + (gnus-html-show-images): Rename command. (gnus-html-wash-tags): Remove more white space before <pre_int> image spacers. (gnus-html-wash-tags): Decode entities at the end, so that entities @@ -2444,7 +3977,7 @@ 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nndoc.el (nndoc-type-alist): Added a new type for Google digests. + * nndoc.el (nndoc-type-alist): Add a new type for Google digests. * gnus-html.el (gnus-html-wash-tags): Check the value of gnus-blocked-images in the summary buffer. @@ -2460,9 +3993,9 @@ (gnus-html-image-url-blocked-p): Take a parameter for blocked-images since it needs to be picked from the correct buffer. - * nnwfm.el: Removed. + * nnwfm.el: Remove. - * nnlistserv.el: Removed. + * nnlistserv.el: Remove. 2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> @@ -2471,9 +4004,9 @@ 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnkiboze.el: Removed. + * nnkiboze.el: Remove. - * nndb.el: Removed. + * nndb.el: Remove. * gnus-html.el (gnus-html-put-image): Use the deleted text as the image alt text. @@ -2486,8 +4019,8 @@ 2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> * gnus-html.el (gnus-html-wash-tags) - (gnus-html-schedule-image-fetching, gnus-html-prefetch-images): Add - extra logging. + (gnus-html-schedule-image-fetching, gnus-html-prefetch-images): + Add extra logging. 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -2531,13 +4064,13 @@ 2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnwarchive.el: Removed. + * nnwarchive.el: Remove. - * gnus-soup.el: Removed. + * gnus-soup.el: Remove. - * nnsoup.el: Removed. + * nnsoup.el: Remove. - * nnultimate.el: Removed. + * nnultimate.el: Remove. * gnus-html.el (gnus-blocked-images): New variable. @@ -2547,8 +4080,8 @@ * gnus-cite.el (gnus-article-natural-long-line-p): New function to guess whether a long line is natural text or not. - * gnus-html.el (gnus-html-schedule-image-fetching): Use - gnus-process-plist and friends for compatibility. + * gnus-html.el (gnus-html-schedule-image-fetching): + Use gnus-process-plist and friends for compatibility. 2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> @@ -2584,7 +4117,7 @@ minutes, 56 seconds ago on the ding list, remove the `w' and `i' bindings, as they aren't useful at all. `w' is moved to `W w'. - * gnus-move.el: Removed file, since it doesn't really work. + * gnus-move.el: Remove file, since it doesn't really work. * gnus-html.el (gnus-article-html): Tell w3m that the input is UTF-8. This seems to fix problems with some German web feeds. @@ -2598,7 +4131,7 @@ XEmacs-compatible. (gnus-html-put-image): Don't do images on non-graphic displays. - * nnslashdot.el: Removed this unused backend. + * nnslashdot.el: Remove this unused backend. * gnus-undo.el (gnus-undo-register-1): Limit the undo actions to 100 actions. @@ -2741,13 +4274,14 @@ Minor bug fixes for gnus-sync.el. - * gnus-sync.el (gnus-sync-unload-hook, gnus-sync-install-hooks): Don't - read the sync on get-new-news. + * gnus-sync.el (gnus-sync-unload-hook, gnus-sync-install-hooks): + Don't read the sync on get-new-news. * gnus-sync.el (gnus-sync-save): Define `variable' so the compiler is quiet. - * gnus-sync.el (gnus-sync-read): Use `gnus-sync-newsrc-offsets' (fix typo). + * gnus-sync.el (gnus-sync-read): Use `gnus-sync-newsrc-offsets' + (fix typo). 2010-07-30 Lawrence Mitchell <wence@gmx.li> @@ -2764,10 +4298,11 @@ * gnus-sync.el: New library for synchronization of marks. - * gnus-util.el (gnus-grep-in-list): Moved from gnus-registry.el and + * gnus-util.el (gnus-grep-in-list): Move from gnus-registry.el and renamed from `gnus-registry-grep-in-list'. - * gnus-registry.el (gnus-registry-follow-group-p): Use `gnus-grep-in-list'. + * gnus-registry.el (gnus-registry-follow-group-p): + Use `gnus-grep-in-list'. * gnus-start.el (gnus-start-draft-setup): Make it interactive. @@ -2813,8 +4348,8 @@ Allow C-w when setting a bookmark in a Gnus Article buffer (Bug#5975). Patch applied by Karl Fogel. - * gnus-sum.el (gnus-summary-bookmark-make-record): Set - `bookmark-yank-point' and `bookmark-current-buffer' to allow C-w. + * gnus-sum.el (gnus-summary-bookmark-make-record): + Set `bookmark-yank-point' and `bookmark-current-buffer' to allow C-w. 2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com> @@ -2863,7 +4398,7 @@ * gnus-sum.el (gnus-thread-latest-date): Use gnus-date-get-time and simplify logic. (gnus-summary-limit-to-age): Use gnus-date-get-time. - (gnus-sort-threads): emit message if gnus-sort-threads-loop used. + (gnus-sort-threads): Emit message if gnus-sort-threads-loop used. 2010-06-08 Michael Albinus <michael.albinus@gmx.de> @@ -2995,8 +4530,8 @@ (gnus-binary-mode): Bind gnus-binary-mode-on-hook and gnus-binary-mode-off-hook for XEmacs when compiling. - * gnus-sum.el (gnus-summary-limit-strange-charsets-predicate): Return - nil if char-charset is not available. + * gnus-sum.el (gnus-summary-limit-strange-charsets-predicate): + Return nil if char-charset is not available. * sieve-manage.el (sieve-manage-disable-multibyte): Redefine it as a macro. @@ -3182,7 +4717,7 @@ 2010-03-22 Martin Stjernholm <mast@lysator.liu.se> - * nnimap.el (nnimap-verify-uidvalidity): Fixed bug where uidvalidity + * nnimap.el (nnimap-verify-uidvalidity): Fix bug where uidvalidity wasn't updated after mismatch. Clear cached mailbox info correctly when uidvalidity changes. (nnimap-group-prefixed-name): New function to avoid some code @@ -3205,8 +4740,8 @@ 2010-03-20 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-sum.el (gnus-summary-make-menu-bar): Let - `gnus-registry-install-shortcuts' fill in the functions. + * gnus-sum.el (gnus-summary-make-menu-bar): + Let `gnus-registry-install-shortcuts' fill in the functions. * gnus-registry.el (gnus-summary-misc-menu): Declare to avoid warnings. @@ -3275,8 +4810,8 @@ (smtpmail-default-smtp-server): Remove declaration. (message-send-mail-function): Check smtpmail-default-smtp-server is bound rather than requiring smtpmail. - (message-auto-save-directory, message-insert-signature): Use - expand-file-name rather than nnheader-concat. + (message-auto-save-directory, message-insert-signature): + Use expand-file-name rather than nnheader-concat. (nnheader-insert-file-contents): Autoload. (hashcash-wait-async): Declare. (message-send-mail): Only call gnus-setup-posting-charset if @@ -3415,8 +4950,8 @@ 2010-01-01 Chong Yidong <cyd@stupidchicken.com> - * message.el (message-exchange-point-and-mark): Call - exchange-point-and-mark with an argument rather than setting + * message.el (message-exchange-point-and-mark): + Call exchange-point-and-mark with an argument rather than setting mark-active by hand (Bug#5175). 2009-12-18 Katsumi Yamaoka <yamaoka@jpl.org> @@ -4010,9 +5545,9 @@ * legacy-gnus-agent.el (gnus-agent-unlist-expire-days): Don't use cadar. - * sieve-manage.el (sieve-manage-starttls-p): Renamed from + * sieve-manage.el (sieve-manage-starttls-p): Rename from imap-starttls-p. - (sieve-manage-starttls-open): Renamed from imap-starttls-open. + (sieve-manage-starttls-open): Rename from imap-starttls-open. 2008-12-22 Reiner Steib <Reiner.Steib@gmx.de> @@ -4039,8 +5574,8 @@ 2008-12-21 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-start.el (gnus-before-startup-hook): Fix doc string. Reported - by Stephen Berman <stephen.berman@gmx.net>. + * gnus-start.el (gnus-before-startup-hook): Fix doc string. + Reported by Stephen Berman <stephen.berman@gmx.net>. 2008-12-18 Katsumi Yamaoka <yamaoka@jpl.org> @@ -4222,7 +5757,7 @@ 2008-09-25 Teodor Zlatanov <tzz@lifelogs.com> - * message.el (message-confirm-send): Fixed variable documentation to + * message.el (message-confirm-send): Fix variable documentation to avoid the "y/n" wording. 2008-09-25 Francis Litterio <flitterio@gmail.com> (tiny change) @@ -4356,8 +5891,8 @@ 2008-07-22 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (gnus-summary-save-in-pipe): Consider - gnus-save-all-headers. + * gnus-art.el (gnus-summary-save-in-pipe): + Consider gnus-save-all-headers. 2008-07-21 Dan Nicolaescu <dann@ics.uci.edu> @@ -4577,16 +6112,16 @@ * nnheader.el (nnheader-read-timeout): Change the default timeout from 0.1 seconds to 0.01 seconds. This will make nntp and pop3 article - retrieval faster in some cases, but might make CPU usage larger. If - this has any bad side effects, we might revert this change. + retrieval faster in some cases, but might make CPU usage larger. + If this has any bad side effects, we might revert this change. * pop3.el (pop3-movemail): Change the sit-for from 0.1 to 0.01, which seems to make mail retrieval much, much faster. (pop3-movemail): Use nnheader-accept-process-output instead of sleeping unconditionally. - * gnus-draft.el (gnus-group-send-queue): Bind - message-send-mail-partially-limit to nil to avoid being prompted. + * gnus-draft.el (gnus-group-send-queue): + Bind message-send-mail-partially-limit to nil to avoid being prompted. 2008-05-16 Reiner Steib <Reiner.Steib@gmx.de> @@ -4619,7 +6154,7 @@ * nnimap.el: Autoload `auth-source-user-or-password'. (nnimap-open-connection): Use it. - * auth-source.el: Added docs on using with url-auth. Import gnus-util + * auth-source.el: Add docs on using with url-auth. Import gnus-util for the gnus-message function. (auth-source-user-or-password): Use it. @@ -4762,7 +6297,7 @@ 2008-04-09 Teodor Zlatanov <tzz@lifelogs.com> - * auth-source.el: Added docs. + * auth-source.el: Add docs. (auth-sources): Modify format to support server. (auth-source-pick, auth-source-user-or-password) (auth-source-user-or-password-imap) @@ -4941,8 +6476,8 @@ 2008-03-17 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-registry.el (gnus-registry-split-fancy-with-parent): Eliminate - unnecessary duplicates from the match list. + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Eliminate unnecessary duplicates from the match list. 2008-03-17 Katsumi Yamaoka <yamaoka@jpl.org> @@ -4968,13 +6503,13 @@ 2008-03-13 Teodor Zlatanov <tzz@lifelogs.com> - * auth-source.el (auth-sources): Renamed from auth-source-choices. + * auth-source.el (auth-sources): Rename from auth-source-choices. (auth-source-pick): Use it. 2008-03-12 Teodor Zlatanov <tzz@lifelogs.com> * auth-source.el (auth-source-protocols) - (auth-source-protocols-customize, auth-source-choices): Added and + (auth-source-protocols-customize, auth-source-choices): Add and modified variable customizations and defaults. (auth-source-pick, auth-source-user-or-password) (auth-source-protocol-defaults, auth-source-user-or-password-imap) @@ -4998,8 +6533,8 @@ nntp-with-open-group macro. (nntp-with-open-group): Use the function, so it's easier to debug. Add indentation and debugging info. - (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet): Recommend - the use of the netcat alternatives. + (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet): + Recommend the use of the netcat alternatives. * rfc2047.el (rfc2047-decode-string): Don't use `m'. Avoid mm-string-as-multibyte as well. @@ -5105,12 +6640,12 @@ 2008-03-04 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-registry.el (gnus-registry-user-format-function-M): Add - formatting function. + * gnus-registry.el (gnus-registry-user-format-function-M): + Add formatting function. 2008-03-03 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-registry.el (gnus-registry-marks): Changed format to be nicer + * gnus-registry.el (gnus-registry-marks): Change format to be nicer with plists. (gnus-registry-do-marks, gnus-registry-install-shortcuts-and-menus): Use new format. @@ -5142,8 +6677,8 @@ * mml.el (mml-menu): Improve help entries. Move Sign/Encrypt Part. (mml-dnd-attach-options): Fix typo in custom choice. - * gnus-group.el (gnus-group-read-ephemeral-gmane-group): Change - nndoc-article-type to mbox. + * gnus-group.el (gnus-group-read-ephemeral-gmane-group): + Change nndoc-article-type to mbox. (gnus-group-read-ephemeral-gmane-group-url): Support permalink. * mm-decode.el (mm-text-html-renderer): Prefer w3m over w3. Fall back @@ -5207,14 +6742,14 @@ (nnmairix-last-server, nnmairix-current-server): Defvar them. (nnmairix-goto-original-article): Defvar gnus-registry-install and autoload gnus-registry-fetch-group when compiling. - (nnmairix-request-group-with-article-number-correction): Remove - unreferenced argument passed to nnmairix-call-backend. + (nnmairix-request-group-with-article-number-correction): + Remove unreferenced argument passed to nnmairix-call-backend. 2008-02-27 Reiner Steib <Reiner.Steib@gmx.de> * mm-uu.el (mm-uu-type-alist): Fix message-marks non-hide arguments. - (mm-uu-extract): Improve face for low color ttys. Reported by Sascha - Wilde. + (mm-uu-extract): Improve face for low color ttys. + Reported by Sascha Wilde. 2008-02-27 Glenn Morris <rgm@gnu.org> @@ -5405,8 +6940,8 @@ 2008-01-12 Reiner Steib <Reiner.Steib@gmx.de> * gnus-sum.el (gnus-article-sort-by-random) - (gnus-thread-sort-by-random): Fix doc strings. Reported by - jidanni@jidanni.org. + (gnus-thread-sort-by-random): Fix doc strings. + Reported by jidanni@jidanni.org. 2008-01-11 Katsumi Yamaoka <yamaoka@jpl.org> @@ -5418,13 +6953,13 @@ * gnus-art.el (gnus-article-read-summary-keys): Work for `C-h' on XEmacs. - (gnus-article-describe-key, gnus-article-describe-key-briefly): Protect - against non-character events. + (gnus-article-describe-key, gnus-article-describe-key-briefly): + Protect against non-character events. 2008-01-09 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): New - command. + * gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): + New command. (gnus-group-read-ephemeral-gmane-group): Use optional argument RANGE instead of END. Change name of the temp file. (gnus-group-gmane-group-download-format): Add doc string. Make it @@ -5439,8 +6974,8 @@ continuation keys correctly in the echo area; describe bindings correctly when keys end with `C-h'. (gnus-article-read-summary-send-keys): New function. - (gnus-article-describe-key, gnus-article-describe-key-briefly): Work - for gnus-article-read-summary-send-keys; display continuation keys + (gnus-article-describe-key, gnus-article-describe-key-briefly): + Work for gnus-article-read-summary-send-keys; display continuation keys correctly in the echo area. (gnus-article-reply-with-original): Ignore prefix argument. (gnus-article-wide-reply-with-original): New function. @@ -5534,8 +7069,8 @@ 2007-12-14 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-sum.el (gnus-summary-prev-article): Fix doc string. Reported by - Christoph Conrad <christoph.conrad@gmx.de>. + * gnus-sum.el (gnus-summary-prev-article): Fix doc string. + Reported by Christoph Conrad <christoph.conrad@gmx.de>. 2007-12-14 Reiner Steib <Reiner.Steib@gmx.de> @@ -5547,8 +7082,8 @@ * mm-decode.el (mm-add-meta-html-tag): New function. (mm-save-part-to-file, mm-pipe-part): Use it. - * gnus-art.el (gnus-article-browse-delete-temp-files): Use - gnus-y-or-n-p instead of y-or-n-p. + * gnus-art.el (gnus-article-browse-delete-temp-files): + Use gnus-y-or-n-p instead of y-or-n-p. (gnus-article-browse-html-parts): Work with message/external-body; use mm-add-meta-html-tag. @@ -5558,8 +7093,8 @@ * gnus-fun.el (gnus-display-x-face-in-from): Require gnus-art. - * gnus-int.el (gnus-server-opened, gnus-status-message): Move - definitions before use. + * gnus-int.el (gnus-server-opened, gnus-status-message): + Move definitions before use. * mm-decode.el: Require gnus-util. (mm-remove-part): Only call delete-annotation on XEmacs. @@ -5667,15 +7202,15 @@ 2007-12-06 Christian Plate <cplate@web.de> (tiny change) - * nnmaildir.el (nnmaildir-request-update-info): Improved performance. + * nnmaildir.el (nnmaildir-request-update-info): Improve performance. Call gnus-add-to-range ranges only once with a prepared article-list. 2007-12-06 Paul Jarc <prj@po.cwru.edu> * nnmaildir.el (nnmaildir-request-list, nnmaildir-retrieve-groups) (nnmaildir-request-group, nnmaildir-retrieve-headers): Escape spaces in - group names with backslashes. Reported by Tassilo Horn - <tassilo@member.fsf.org>. + group names with backslashes. + Reported by Tassilo Horn <tassilo@member.fsf.org>. 2007-12-06 Deepak Goel <deego3@gmail.com> @@ -5694,8 +7229,8 @@ 2007-12-05 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-browse-html-parts): Add meta html tag to - specify charset to html source. Reported by Christoph Conrad - <christoph.conrad@gmx.de>. + specify charset to html source. + Reported by Christoph Conrad <christoph.conrad@gmx.de>. 2007-12-05 Katsumi Yamaoka <yamaoka@jpl.org> @@ -5719,8 +7254,8 @@ * gnus-group.el (gnus-group-highlight-line): Add FIXME. * gnus-dired.el: Reduce Gnus dependencies. - (gnus-ems, gnus-msg, gnus-util, message, mm-decode, mml): Don't - require. Use autoloads instead. + (gnus-ems, gnus-msg, gnus-util, message, mm-decode, mml): + Don't require. Use autoloads instead. (mml-attach-file, mm-default-file-encoding, mailcap-extension-to-mime) (mailcap-mime-info, mm-mailcap-command, ps-print-preprint) (message-buffers, gnus-setup-message, gnus-print-buffer): Autoload. @@ -5779,8 +7314,7 @@ * yenc.el (yenc-first-part-p, yenc-last-part-p): New functions. - * mm-uu.el (mm-uu-yenc-extract): Get the data from the original - buffer. + * mm-uu.el (mm-uu-yenc-extract): Get the data from the original buffer. 2007-12-02 Glenn Morris <rgm@gnu.org> @@ -5796,8 +7330,8 @@ * message.el (message-cite-prefix-regexp): Remove `-' and `+' to avoid matches on patches. - * gnus-art.el (gnus-article-browse-html-article): Mention - `mm-text-html-renderer' in the doc string. + * gnus-art.el (gnus-article-browse-html-article): + Mention `mm-text-html-renderer' in the doc string. * rfc2047.el (rfc2047-encode-max-chars): Refer to RFC 2047 in doc string. Add comments. @@ -5826,8 +7360,8 @@ (gnus-agent-method-p): Canonicalize server names by pushing their method through `gnus-method-to-server' using the no-cache argument. - * gnus-srvr.el (gnus-server-insert-server-line): Call - `gnus-method-to-server' with `no-cache' argument. + * gnus-srvr.el (gnus-server-insert-server-line): + Call `gnus-method-to-server' with `no-cache' argument. * gnus-agent.el (gnus-agent-toggle-plugged): Don't call gnus-agent-possibly-synchronize-flags as this should be called when the @@ -6069,8 +7603,8 @@ 2007-11-15 Katsumi Yamaoka <yamaoka@jpl.org> - * nntp.el (nntp-insert-buffer-substring, nntp-copy-to-buffer): New - macros. + * nntp.el (nntp-insert-buffer-substring, nntp-copy-to-buffer): + New macros. (nntp-wait-for, nntp-retrieve-articles, nntp-async-trigger) (nntp-retrieve-headers-with-xover): Use nntp-insert-buffer-substring to copy data from unibyte buffer to multibyte current buffer. @@ -6155,8 +7689,8 @@ 2007-10-29 Stefan Monnier <monnier@iro.umontreal.ca> - * message.el (message-check-news-body-syntax): Avoid - mm-string-as-multibyte. + * message.el (message-check-news-body-syntax): + Avoid mm-string-as-multibyte. (message-hide-headers): Don't assume (point-min)==1. 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> @@ -6187,8 +7721,8 @@ 2007-10-27 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-msg.el (gnus-message-setup-hook): Add - `message-remove-blank-cited-lines' to options. + * gnus-msg.el (gnus-message-setup-hook): + Add `message-remove-blank-cited-lines' to options. 2007-10-26 Reiner Steib <Reiner.Steib@gmx.de> @@ -6260,8 +7794,8 @@ * gnus-group.el (gnus-group-suspend): Replace mapcar called for effect with dolist. - * gnus-registry.el (gnus-registry-split-fancy-with-parent): Replace - mapcar called for effect with dolist. + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Replace mapcar called for effect with dolist. * gnus-spec.el (gnus-correct-length): Make it simple and fast. @@ -6294,7 +7828,7 @@ * gnus-agent.el (gnus-agent-expire-group-1): The check for an unsorted overview buffer needed a catch to receive its throw. - (gnus-agent-flush-cache): Declared as interactive to make this function + (gnus-agent-flush-cache): Declare as interactive to make this function easier to use. 2007-10-20 Reiner Steib <Reiner.Steib@gmx.de> @@ -6358,8 +7892,8 @@ * mm-decode.el (mm-possibly-verify-or-decrypt): Replace PARTS with the ones returned from the verify-function. - * mm-uu.el (mm-uu-pgp-signed-extract-1): Call - mml2015-extract-cleartext-signature if extraction failed. + * mm-uu.el (mm-uu-pgp-signed-extract-1): + Call mml2015-extract-cleartext-signature if extraction failed. 2007-10-07 Daiki Ueno <ueno@unixuser.org> @@ -6535,7 +8069,7 @@ 2007-08-14 Tassilo Horn <tassilo@member.fsf.org> - * gnus-art.el (gnus-sticky-article): Fixed problems described in + * gnus-art.el (gnus-sticky-article): Fix problems described in <b4mps1qitio.fsf@jpl.org> on ding. Thanks to Katsumi. Don't perform gnus-configure-windows here; reuse existing sticky article buffer. @@ -6657,8 +8191,8 @@ 2007-07-23 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-sum.el (gnus-summary-move-article): Make - gnus-summary-respool-article work. + * gnus-sum.el (gnus-summary-move-article): + Make gnus-summary-respool-article work. 2007-07-21 Reiner Steib <Reiner.Steib@gmx.de> @@ -6717,8 +8251,8 @@ nnmail-pathname-coding-system. (nnml-request-article): Pass server argument to nnml-find-group-number. - (nnml-request-create-group, nnml-active-number, nnml-save-marks): Pass - server argument to nnml-possibly-create-directory. + (nnml-request-create-group, nnml-active-number, nnml-save-marks): + Pass server argument to nnml-possibly-create-directory. (nnml-request-accept-article): Pass server argument to nnml-active-number and nnml-save-mail. (nnml-find-group-number): Pass server argument to nnml-find-id. @@ -6747,8 +8281,8 @@ 2007-07-18 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-agent.el (gnus-agent-save-active): Bind - nnheader-file-coding-system to gnus-agent-file-coding-system. + * gnus-agent.el (gnus-agent-save-active): + Bind nnheader-file-coding-system to gnus-agent-file-coding-system. * gnus-cache.el (gnus-cache-save-buffers) (gnus-cache-possibly-enter-article, gnus-cache-request-article) @@ -6757,10 +8291,10 @@ (gnus-cache-braid-nov, gnus-cache-braid-heads) (gnus-cache-generate-active, gnus-cache-rename-group) (gnus-cache-delete-group, gnus-cache-update-file-total-fetched-for) - (gnus-cache-update-overview-total-fetched-for): Bind - file-name-coding-system to nnmail-pathname-coding-system. - (gnus-cache-decoded-group-names, gnus-cache-unified-group-names): New - variables. + (gnus-cache-update-overview-total-fetched-for): + Bind file-name-coding-system to nnmail-pathname-coding-system. + (gnus-cache-decoded-group-names, gnus-cache-unified-group-names): + New variables. (gnus-cache-decoded-group-name): New function. (gnus-cache-file-name): Use it. (gnus-cache-generate-active): Use non-decoded group name for active. @@ -6794,8 +8328,8 @@ (gnus-agent-retrieve-headers, gnus-agent-request-article) (gnus-agent-regenerate-group) (gnus-agent-update-files-total-fetched-for) - (gnus-agent-update-view-total-fetched-for): Bind - file-name-coding-system to nnmail-pathname-coding-system. + (gnus-agent-update-view-total-fetched-for): + Bind file-name-coding-system to nnmail-pathname-coding-system. (gnus-agent-group-pathname): Don't encode file names by nnmail-pathname-coding-system. (gnus-agent-save-local): Bind file-name-coding-system correctly; bind @@ -6816,8 +8350,8 @@ * nnrss.el (nnrss-file-coding-system): Doc fix; make it begin with *. (nnrss-request-delete-group): Bind file-name-coding-system to nnmail-pathname-coding-system. - (nnrss-read-server-data, nnrss-read-group-data): Bind - file-name-coding-system correctly. + (nnrss-read-server-data, nnrss-read-group-data): + Bind file-name-coding-system correctly. (nnrss-check-group): Pass nnrss-file-coding-system to md5. * nntp.el: Require gnus-group for the function gnus-group-name-charset. @@ -6892,8 +8426,8 @@ * message.el (message-fix-before-sending): Skip raw message part to be forwarded while checking illegible text. - (message-forward-make-body-mime, message-forward-make-body): Mark - signed or encrypted raw message as having no illegible text. + (message-forward-make-body-mime, message-forward-make-body): + Mark signed or encrypted raw message as having no illegible text. 2007-06-19 Katsumi Yamaoka <yamaoka@jpl.org> @@ -6912,8 +8446,8 @@ 2007-06-14 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-agent.el (gnus-agent-fetch-headers) - (gnus-agent-retrieve-headers): Bind - gnus-decode-encoded-address-function to identity. + (gnus-agent-retrieve-headers): + Bind gnus-decode-encoded-address-function to identity. * nntp.el (nntp-send-xover-command): Recognize an xover command is available also when the server returns simply a dot. @@ -6974,8 +8508,8 @@ 2007-05-29 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-sum.el (gnus-summary-limit-to-address): New function. Suggested - by Loic Dachary <loic@dachary.org>. + * gnus-sum.el (gnus-summary-limit-to-address): New function. + Suggested by Loic Dachary <loic@dachary.org>. (gnus-summary-limit-map, gnus-summary-make-menu-bar): Add it. 2007-05-28 Katsumi Yamaoka <yamaoka@jpl.org> @@ -7032,13 +8566,13 @@ * gnus-util.el (gnus-limit-string): Delete this function. - * gnus-sum.el (gnus-simplify-subject-fully): Use - `truncate-string-to-width' instead. + * gnus-sum.el (gnus-simplify-subject-fully): + Use `truncate-string-to-width' instead. 2007-05-11 Michaël Cadilhac <michael@cadilhac.name> - * gnus-sum.el (gnus-summary-next-group-on-exit): New variable. Tell - if, on summary exit, the next group has to be selected. + * gnus-sum.el (gnus-summary-next-group-on-exit): New variable. + Tell if, on summary exit, the next group has to be selected. (gnus-summary-exit): Use it. 2007-05-10 Reiner Steib <Reiner.Steib@gmx.de> @@ -7092,8 +8626,8 @@ 2007-04-27 Didier Verna <didier@xemacs.org> - * gnus-util.el (gnus-orify-regexp): Moved and renamed to ... - * gmm-utils.el (gmm-regexp-concat): here. + * gnus-util.el (gnus-orify-regexp): Move and rename to ... + * gmm-utils.el (gmm-regexp-concat): ... here. * message.el: Don't require 'gnus-util. (message-dont-reply-to-names): Handle name change above. * gnus-sum.el (gnus-ignored-from-addresses): Ditto. @@ -7160,9 +8694,9 @@ 2007-04-16 Didier Verna <didier@xemacs.org> - * gnus-msg.el (gnus-configure-posting-styles): Handle - message-signature-directory properly with :file syntax. Reported by - "Leo". + * gnus-msg.el (gnus-configure-posting-styles): + Handle message-signature-directory properly with :file syntax. + Reported by "Leo". 2007-04-11 Didier Verna <didier@xemacs.org> @@ -7174,8 +8708,8 @@ 2007-04-10 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-msg.el (gnus-inews-yank-articles): Use - message-exchange-point-and-mark instead of exchange-point-and-mark. + * gnus-msg.el (gnus-inews-yank-articles): + Use message-exchange-point-and-mark instead of exchange-point-and-mark. 2007-04-09 Katsumi Yamaoka <yamaoka@jpl.org> @@ -7335,7 +8869,7 @@ 2007-02-20 Daiki Ueno <ueno@unixuser.org> - * mml2015.el (mml2015-epg-verify): Simplified. + * mml2015.el (mml2015-epg-verify): Simplify. 2007-02-19 Katsumi Yamaoka <yamaoka@jpl.org> @@ -7401,8 +8935,8 @@ (gnus-message-citation-keywords): Set LAXMATCH flag in every HIGHLIGHT. (gnus-message-add-citation-keywords): Append keywords rather than prepending; emulate font-lock-add-keywords if it is not available. - (gnus-message-remove-citation-keywords): Emulate - font-lock-remove-keywords if it is not available. + (gnus-message-remove-citation-keywords): + Emulate font-lock-remove-keywords if it is not available. * gnus-msg.el (gnus-message-highlight-citation): Default to t. @@ -7430,8 +8964,8 @@ 2007-01-23 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-score.el (gnus-home-score-file, gnus-home-adapt-file): Fix - custom choice. + * gnus-score.el (gnus-home-score-file, gnus-home-adapt-file): + Fix custom choice. * gnus-art.el (gnus-signature-limit): Fix custom choice. @@ -7473,8 +9007,8 @@ * gnus-sum.el (gnus-auto-select-first): Improve doc string. - * message.el (message-cite-original-1): Call - gnus-article-highlight-citation if requested. + * message.el (message-cite-original-1): + Call gnus-article-highlight-citation if requested. (message-make-from): Allow name and address as optional arguments. * gnus-cite.el (gnus-article-highlight-citation): Add SAME-BUFFER arg. @@ -7592,8 +9126,8 @@ 2006-12-29 Jouni K. Seppänen <jks@iki.fi> - * nnimap.el (nnimap-expunge-search-string): Mention - nnimap-search-uids-not-since-is-evil in docstring. + * nnimap.el (nnimap-expunge-search-string): + Mention nnimap-search-uids-not-since-is-evil in docstring. 2006-12-28 Reiner Steib <Reiner.Steib@gmx.de> @@ -7605,8 +9139,8 @@ make-obsolete-variable. (spam-bsfilter-path, spam-bsfilter-program) (spam-spamassassin-path, spam-spamassassin-program) - (spam-sa-learn-path, spam-sa-learn-program): Rename variables. Don't - use "path" inappropriately. + (spam-sa-learn-path, spam-sa-learn-program): Rename variables. + Don't use "path" inappropriately. (spam-check-spamassassin, spam-spamassassin-register-with-sa-learn) (spam-check-bsfilter, spam-bsfilter-register-with-bsfilter): Use new variable names. @@ -7658,8 +9192,8 @@ (spam-spamoracle-database, spam-get-ifile-database-parameter): Fix doc strings. (spam-check-ifile, spam-ifile-register-with-ifile) - (spam-check-bogofilter, spam-bogofilter-register-with-bogofilter): Use - new variable names. + (spam-check-bogofilter, spam-bogofilter-register-with-bogofilter): + Use new variable names. * gnus-art.el (gnus-treat-display-x-face, gnus-treat-display-face) (gnus-treat-display-smileys): Simplify using @@ -7734,7 +9268,7 @@ specifying array size. (gnus-summary-insert-line, gnus-summary-prepare-threads): Regrow indent array if it is too small. - (gnus-sort-threads-recursive): Renamed from gnus-sort-thread-1. + (gnus-sort-threads-recursive): Rename from gnus-sort-thread-1. (gnus-sort-threads-loop): New function. 2006-12-06 Chris Moore <dooglus@gmail.com> @@ -7771,8 +9305,8 @@ 2006-11-29 Katsumi Yamaoka <yamaoka@jpl.org> - * nneething.el (nneething-decode-file-name): Replace - decode-coding-string with mm-decode-coding-string. + * nneething.el (nneething-decode-file-name): + Replace decode-coding-string with mm-decode-coding-string. * gnus-int.el (gnus-open-server): Say failed server's name. @@ -7869,7 +9403,7 @@ 2006-11-13 Daiki Ueno <ueno@unixuser.org> - * mml2015.el (mml2015-epg-encrypt): Removed backward compatibility for + * mml2015.el (mml2015-epg-encrypt): Remove backward compatibility for EasyPG (< 0.0.6). (mml2015-always-trust): New user option. (mml2015-epg-passphrase-callback): Display key ID on the passphrase @@ -7895,8 +9429,8 @@ 2006-11-07 Reiner Steib <Reiner.Steib@gmx.de> * message.el (message-strip-subject-encoded-words): Reformat prompt. - (message-simplify-subject-functions): Enable - message-strip-subject-encoded-words by default. + (message-simplify-subject-functions): + Enable message-strip-subject-encoded-words by default. 2006-11-06 Reiner Steib <Reiner.Steib@gmx.de> @@ -7928,8 +9462,8 @@ (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions. (mm-charset-synonym-alist): Move some entries to mm-codepage-iso-8859-list. - (mm-charset-synonym-alist, mm-charset-override-alist): Add - iso-8859-8/windows-1255 and iso-8859-9/windows-1254. + (mm-charset-synonym-alist, mm-charset-override-alist): + Add iso-8859-8/windows-1255 and iso-8859-9/windows-1254. 2006-10-29 Katsumi Yamaoka <yamaoka@jpl.org> @@ -7956,8 +9490,8 @@ 2006-10-24 Reiner Steib <Reiner.Steib@gmx.de> - * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): New - variables. + * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): + New variables. (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions. (mm-charset-synonym-alist): Move some entries to mm-codepage-iso-8859-list. @@ -7972,8 +9506,8 @@ 2006-10-20 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use - car-safe to avoid bad parses. + * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): + Use car-safe to avoid bad parses. 2006-10-20 Katsumi Yamaoka <yamaoka@jpl.org> @@ -8003,8 +9537,8 @@ 2006-10-16 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use - ietf-drums-parse-address instead of gnus-extract-address-components. + * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): + Use ietf-drums-parse-address instead of gnus-extract-address-components. Reported by Damien Elmes <damien@repose.cx>. 2006-10-19 Reiner Steib <Reiner.Steib@gmx.de> @@ -8033,8 +9567,8 @@ 2006-10-04 Reiner Steib <Reiner.Steib@gmx.de> - * mm-util.el (mm-charset-synonym-alist, mm-charset-override-alist): Add - iso-8859-8/windows-1255 and iso-8859-9/windows-1254. + * mm-util.el (mm-charset-synonym-alist, mm-charset-override-alist): + Add iso-8859-8/windows-1255 and iso-8859-9/windows-1254. * nnheader.el (nnheader-find-file-noselect): Inhibit version-control. @@ -8043,8 +9577,8 @@ (message-simplify-subject): New function to remove duplicate code. (message-reply, message-followup): Use it. - * gnus-sum.el (gnus-summary-make-menu-bar): Clarify - gnus-summary-limit-to-articles. + * gnus-sum.el (gnus-summary-make-menu-bar): + Clarify gnus-summary-limit-to-articles. 2006-10-03 Katsumi Yamaoka <yamaoka@jpl.org> @@ -8082,8 +9616,8 @@ * gmm-utils.el (gmm): Adjust custom version. - * mm-util.el (mm-charset-override-alist, mm-charset-eval-alist): Adjust - custom version. + * mm-util.el (mm-charset-override-alist, mm-charset-eval-alist): + Adjust custom version. * gnus-draft.el (gnus-draft-mode): Don't call `mml-mode'. @@ -8269,8 +9803,8 @@ 2006-08-09 Katsumi Yamaoka <yamaoka@jpl.org> * compface.el (uncompface): Make sure the eol conversion doesn't take - place when communicating with the external programs. Reported by - ARISAWA Akihiro <ari@mbf.ocn.ne.jp>. + place when communicating with the external programs. + Reported by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>. 2006-07-31 Katsumi Yamaoka <yamaoka@jpl.org> @@ -8390,8 +9924,8 @@ (mml2015-function-alist): Add epg. (mml2015-epg-passphrase-callback, mml2015-epg-decrypt) (mml2015-epg-clear-decrypt, mml2015-epg-verify) - (mml2015-epg-clear-verify, mml2015-epg-sign, mml2015-epg-encrypt): New - functions. + (mml2015-epg-clear-verify, mml2015-epg-sign, mml2015-epg-encrypt): + New functions. 2006-07-08 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> @@ -8401,8 +9935,8 @@ 2006-06-27 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> - * gnus-group.el (gnus-group-sort-by-unread): Fix typo. Reported by - Kenneth Jacker <khj@be.cs.appstate.edu>. + * gnus-group.el (gnus-group-sort-by-unread): Fix typo. + Reported by Kenneth Jacker <khj@be.cs.appstate.edu>. 2006-06-26 Reiner Steib <Reiner.Steib@gmx.de> @@ -8446,8 +9980,8 @@ nnmail-fix-eudora-headers. (nnmail-fix-eudora-headers): Now obsolete. - * gnus-art.el (gnus-button-handle-custom): Support - `customize-apropos*'. + * gnus-art.el (gnus-button-handle-custom): + Support `customize-apropos*'. 2006-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -8481,8 +10015,8 @@ (gnus-bookmark-write-file): Simplify. (gnus-bookmark-maybe-sort-alist): Use `when'. (gnus-bookmark-get-bookmark): Fix typo in doc string. - (gnus-bookmark-set-bookmark-name, gnus-bookmark-get-bookmark): Add - FIXME about Emacs 21 and XEmacs compatibility. + (gnus-bookmark-set-bookmark-name, gnus-bookmark-get-bookmark): + Add FIXME about Emacs 21 and XEmacs compatibility. (gnus-bookmark-set-bookmark-name): Use `gnus-replace-in-string' for compatibility. (gnus-bookmark-bmenu-mode): Use `gnus-run-mode-hooks' for @@ -8569,8 +10103,8 @@ 2006-05-29 Kevin Greiner <kevin.greiner@compsol.cc> - * gnus-agent.el: Added gnus-agent-flush* to purge agent info. - (gnus-agent-read-agentview): Fixed handling of end-of-file error. + * gnus-agent.el: Add gnus-agent-flush* to purge agent info. + (gnus-agent-read-agentview): Fix handling of end-of-file error. (gnus-agent-read-local): All symbols allocated in my-obarray. (gnus-agent-set-local): Skip invalid entries (min and/or max is nil). (gnus-agent-regenerate-group): Check numeric names to see if they are @@ -8578,8 +10112,8 @@ (gnus-agent-total-fetched-for): Ignore 'dummy.group' (there should be a better way of do this...) - * gnus-cache.el (gnus-agent-total-fetched-for): Ignore - 'dummy.group' (there should be a better way of do this...) + * gnus-cache.el (gnus-agent-total-fetched-for): + Ignore 'dummy.group' (there should be a better way of do this...) 2006-05-29 Katsumi Yamaoka <yamaoka@jpl.org> @@ -8609,8 +10143,8 @@ (gnus-article-mode): Use it. (gnus-article-toggle-truncate-lines): New function. - * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar): Add - gnus-article-toggle-truncate-lines. + * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar): + Add gnus-article-toggle-truncate-lines. * uudecode.el (uudecode-decode-region-external): nil isn't a valid coding system in XEmacs, use binary. @@ -8637,8 +10171,8 @@ 2006-05-25 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (gnus-default-article-saver): Add - gnus-summary-write-body-to-file. + * gnus-art.el (gnus-default-article-saver): + Add gnus-summary-write-body-to-file. (gnus-article-save-coding-system): Don't use coding system object in XEmacs. (gnus-read-save-file-name): Add optional `dir-var' argument which @@ -8703,13 +10237,14 @@ * gnus-art.el (gnus-button-alist): Improve gnus-button-handle-symbol entry. - * gnus-sum.el (gnus-summary-make-menu-bar): Add - gnus-article-browse-html-article. + * gnus-sum.el (gnus-summary-make-menu-bar): + Add gnus-article-browse-html-article. 2006-05-23 Hynek Schlawack <hynek@ularx.de> - * gnus-sum.el (gnus-summary-mime-map): Add - gnus-article-browse-html-article. + * gnus-sum.el (gnus-summary-mime-map): + Add gnus-article-browse-html-article. + 2006-05-23 Reiner Steib <Reiner.Steib@gmx.de> * gnus-sum.el (gnus-summary-save-article-coding-system): Offer some @@ -8725,16 +10260,16 @@ (gnus-summary-expire-articles-now): Shorten prompt. * gmm-utils.el (wid-edit): Require. - (defun-gmm): Renamed from `gmm-defun-compat'. + (defun-gmm): Rename from `gmm-defun-compat'. (gmm-image-search-load-path): Use it. (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'. 2006-05-17 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-sum.el (gnus-summary-save-article-coding-system): New - variable. - (gnus-summary-save-article): Add optional `decode' argument. If - it is set and gnus-summary-save-article-coding-system is non-nil, + * gnus-sum.el (gnus-summary-save-article-coding-system): + New variable. + (gnus-summary-save-article): Add optional `decode' argument. + If it is set and gnus-summary-save-article-coding-system is non-nil, save decoded article. (gnus-summary-write-article-file): Save decoded article if gnus-summary-save-article-coding-system is non-nil. @@ -8751,8 +10286,8 @@ * gnus-art.el (gnus-article-setup-buffer): Go to summary buffer first to test gnus-single-article-buffer which may be buffer-local. - * gnus-sum.el (gnus-summary-setup-buffer): Make - gnus-single-article-buffer buffer-local and nil in ephemeral + * gnus-sum.el (gnus-summary-setup-buffer): + Make gnus-single-article-buffer buffer-local and nil in ephemeral group; make gnus-article-buffer, gnus-article-current, and gnus-original-article-buffer always buffer-local. (gnus-summary-exit): Kill article buffer belonging to ephemeral @@ -8787,8 +10322,8 @@ (message-signature-file, message-signature-insert-empty-line): Remove autoloads. - * gnus-art.el (gnus-buttonized-mime-types): Remove - "multipart/signed". Revert 2006-04-26 change. + * gnus-art.el (gnus-buttonized-mime-types): + Remove "multipart/signed". Revert 2006-04-26 change. 2006-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -8807,8 +10342,8 @@ * message.el (hashcash): Require hashcash as normal. - * ecomplete.el (ecomplete-highlight-match-line): Use - point-at-eol. + * ecomplete.el (ecomplete-highlight-match-line): + Use point-at-eol. (ecomplete-highlight-match-line): Use `highlight', because that face exists in both Emacs and XEmacs. @@ -8865,8 +10400,8 @@ * message.el (message-citation-line-format): New variable. (message-insert-formated-citation-line): New function. - (message-citation-line-function): Add - `message-insert-formated-citation-line' to custom type. + (message-citation-line-function): + Add `message-insert-formated-citation-line' to custom type. * mm-decode.el (mm-verify-option): Add gnus-buttonized-mime-types to doc string. @@ -8925,8 +10460,8 @@ (message-mode): Ditto. (message-strip-forbidden-properties): Ditto. - * ecomplete.el (ecomplete-database-file-coding-system): New - variable. + * ecomplete.el (ecomplete-database-file-coding-system): + New variable. (ecomplete-save): Use it. (ecomplete-setup): Use it. @@ -9002,8 +10537,8 @@ * rfc2231.el (rfc2231-parse-string): Sort the parameters first. - * message.el (message-forward-make-body-plain): Allow - message-forward-ignored-headers to be a list. + * message.el (message-forward-make-body-plain): + Allow message-forward-ignored-headers to be a list. (message-remove-ignored-headers): Factor out into function. (message-forward-make-body-mml): Use it. * rfc2231.el (rfc2231-parse-string): Remove dead code. @@ -9041,8 +10576,8 @@ 2006-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org> - * message.el (message-put-addresses-in-ecomplete): Use - gnus-replace-in-string. + * message.el (message-put-addresses-in-ecomplete): + Use gnus-replace-in-string. (message-is-yours-p): Use the more correct mail-header-parse-address instead of mail-extract-address-components. @@ -9056,8 +10591,8 @@ * message.el (message-hidden-headers): Add X-Draft-From. - * gnus-sum.el (gnus-summary-repeat-search-article-forward): New - command. + * gnus-sum.el (gnus-summary-repeat-search-article-forward): + New command. (gnus-summary-repeat-search-article-backward): New command. * gnus-topic.el (gnus-topic-display-missing-topic): Skip past @@ -9071,7 +10606,7 @@ 2006-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-art.el (gnus-face-properties-alist): Moved here from + * gnus-art.el (gnus-face-properties-alist): Move here from gnus-fun. * gnus-fun.el (gnus-face-properties-alist): Move to gnus-art. @@ -9103,8 +10638,8 @@ 2006-04-15 Lars Magne Ingebrigtsen <larsi@gnus.org> - * hashcash.el (hashcash-insert-payment-async-2): Use - message-goto-eoh instead of doing it manually. + * hashcash.el (hashcash-insert-payment-async-2): + Use message-goto-eoh instead of doing it manually. (mail-add-payment): Use message-narrow-to-header instead of trying to do the same itself. @@ -9144,8 +10679,8 @@ * ecomplete.el (ecomplete-display-matches): Allow automatic display. - * message.el (message-strip-forbidden-properties): Display - abbrevs. + * message.el (message-strip-forbidden-properties): + Display abbrevs. (message-display-abbrev): Get automatic display right. * ecomplete.el (ecomplete-display-matches): Use M-n/M-p @@ -9156,15 +10691,15 @@ TODO: Backport to v5-10! * gnus-util.el (gnus-alist-to-hashtable, gnus-hashtable-to-alist): - Moved here (and renamed) from gnus-registry.el. + Move here (and rename) from gnus-registry.el. * gnus-registry.el: Require gnus-util. Use `gnus-alist-to-hashtable' and `gnus-hashtable-to-alist'. 2006-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-group.el (gnus-group-catchup-current): Change - if-then-else-if-then-else into cond. + * gnus-group.el (gnus-group-catchup-current): + Change if-then-else-if-then-else into cond. (gnus-group-catchup): Indent. (group-name-at-point): New function. (gnus-fetch-group): Provide default from thing at point. @@ -9173,8 +10708,8 @@ * message.el (message-display-abbrev): Fix regexp. - * ecomplete.el (ecomplete-highlight-match-line): Reimplement - choosing. + * ecomplete.el (ecomplete-highlight-match-line): + Reimplement choosing. (ecomplete-highlight-match-line): Fix up code rewrite, remove dead variables. @@ -9183,8 +10718,8 @@ 2006-04-12 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-article-mode): Set - cursor-in-non-selected-windows to nil. + * gnus-art.el (gnus-article-mode): + Set cursor-in-non-selected-windows to nil. * smiley.el: Revert previous change. (smiley-data-directory): defvar it before using it in the @@ -9201,8 +10736,8 @@ * ecomplete.el (ecomplete-add-item): Chop off decimals. - * gnus-sum.el (gnus-summary-save-parts): Bind - gnus-summary-save-parts-counter and use it to make unique file + * gnus-sum.el (gnus-summary-save-parts): + Bind gnus-summary-save-parts-counter and use it to make unique file names. * gnus-art.el (gnus-ignored-headers): Add some more headers. @@ -9309,8 +10844,8 @@ 2006-04-05 Daiki Ueno <ueno@unixuser.org> - * pgg-gpg.el (pgg-gpg-encrypt-region, pgg-gpg-sign-region): Wait - for BEGIN_SIGNING too, new in GnuPG 1.4.3. + * pgg-gpg.el (pgg-gpg-encrypt-region, pgg-gpg-sign-region): + Wait for BEGIN_SIGNING too, new in GnuPG 1.4.3. 2006-04-04 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> @@ -9320,8 +10855,8 @@ 2006-04-04 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Check - gnus-extra-headers for 'Newsgroups. + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): + Check gnus-extra-headers for 'Newsgroups. * message.el (message-tool-bar-gnome): Check if `flyspell-mode' is bound. @@ -9369,8 +10904,8 @@ 2006-03-27 Karl Kleinpaste <karl@charcoal.com> - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Improve - newsgroups handling for NNTP overviews which don't include + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): + Improve newsgroups handling for NNTP overviews which don't include Newsgroups. 2006-03-26 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> @@ -9496,8 +11031,8 @@ 2006-03-14 Reiner Steib <Reiner.Steib@gmx.de> - * gmm-utils.el (gmm-image-load-path-for-library): Fix typo. Use - `defun' instead of `gmm-defun-compat'. + * gmm-utils.el (gmm-image-load-path-for-library): Fix typo. + Use `defun' instead of `gmm-defun-compat'. 2006-03-14 Simon Josefsson <jas@extundo.com> @@ -9582,8 +11117,8 @@ * gnus-group.el (gnus-group-make-tool-bar): Use add-hook. Suggested by Stefan Monnier <monnier@iro.umontreal.ca>. - * gnus-art.el (gnus-article-browse-delete-temp-files): Simplify - resetting gnus-article-browse-html-temp-list. + * gnus-art.el (gnus-article-browse-delete-temp-files): + Simplify resetting gnus-article-browse-html-temp-list. * gmm-utils.el (gmm-image-load-path-for-library): Sync with mh-compat.el revision 1.9 in Emacs. Rename `gmm-image-load-path'. @@ -9628,12 +11163,12 @@ * gnus-art.el (gnus-article-browse-html-temp-list): Rename from gnus-article-browse-html-temp. - (gnus-article-browse-delete-temp): Make it customizable. Add - `file'. Adjust doc string. - (gnus-article-browse-delete-temp-files): Add argument. Allow - query for each file. Adjust doc string. - (gnus-article-browse-html-parts): Add - `gnus-article-browse-delete-temp-files' to + (gnus-article-browse-delete-temp): Make it customizable. + Add `file'. Adjust doc string. + (gnus-article-browse-delete-temp-files): Add argument. + Allow query for each file. Adjust doc string. + (gnus-article-browse-html-parts): + Add `gnus-article-browse-delete-temp-files' to `gnus-summary-prepare-exit-hook' and `gnus-exit-gnus-hook'. 2006-03-02 Hynek Schlawack <hynek@ularx.de> @@ -9651,8 +11186,8 @@ string. * gnus-sum.el (gnus-summary-tool-bar-gnome): Don't use - gnus-summary-insert-new-articles when unplugged. Remove - gnus-summary-search-article-forward. + gnus-summary-insert-new-articles when unplugged. + Remove gnus-summary-search-article-forward. * gmm-utils.el (gmm-tool-bar-style): Test tool-bar-mode and display-visual-class instead of display-color-cells. @@ -9702,8 +11237,8 @@ * gnus-art.el (gnus-button): New face. (gnus-article-button-face): Use it. - * gnus-sum.el (gnus-summary-tool-bar-gnome): Add - gnus-summary-next-page. Re-order. + * gnus-sum.el (gnus-summary-tool-bar-gnome): + Add gnus-summary-next-page. Re-order. * gnus-group.el (gnus-group-tool-bar-gnome): prev-node and next-node are now included. @@ -9716,8 +11251,8 @@ * spam.el (spam-spamassassin-score-regexp): New internal variable. (spam-extra-header-to-number, spam-check-spamassassin-headers): - Use it to match format of Spamassassin 3.0 and later. Reported by - IRIE Tetsuya <irie@t.email.ne.jp>. + Use it to match format of Spamassassin 3.0 and later. + Reported by IRIE Tetsuya <irie@t.email.ne.jp>. (spam-check-bogofilter) (spam-bogofilter-register-with-bogofilter): Fix args of `gnus-error' calls. @@ -9725,8 +11260,8 @@ 2006-02-28 Reiner Steib <Reiner.Steib@gmx.de> * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid - unnecessary interaction when sending queued mails. Reported by - TAKAHASHI Yoshio <tkh@jp.fujitsu.com>. + unnecessary interaction when sending queued mails. + Reported by TAKAHASHI Yoshio <tkh@jp.fujitsu.com>. 2006-02-27 Reiner Steib <Reiner.Steib@gmx.de> @@ -9761,17 +11296,17 @@ 2006-02-23 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-group.el (gnus-group-tool-bar-gnome): Fix - gnus-agent-toggle-plugged. Re-order icons. - (gnus-group-tool-bar-gnome): Add - gnus-group-{prev,next}-unread-group. + * gnus-group.el (gnus-group-tool-bar-gnome): + Fix gnus-agent-toggle-plugged. Re-order icons. + (gnus-group-tool-bar-gnome): + Add gnus-group-{prev,next}-unread-group. (gnus-group-tool-bar-gnome): Re-order icons. - * gnus-sum.el (gnus-summary-tool-bar-gnome): Move - gnus-summary-insert-new-articles. + * gnus-sum.el (gnus-summary-tool-bar-gnome): + Move gnus-summary-insert-new-articles. - * message.el (message-tool-bar-gnome, message-tool-bar-retro): Fix - comments. + * message.el (message-tool-bar-gnome, message-tool-bar-retro): + Fix comments. * utf7.el (utf7-utf-16-coding-system): Fix comment. utf-16-be is also available in Emacs 21.3. @@ -9824,7 +11359,7 @@ * message.el (message-make-tool-bar): Ditto. - * mml.el (mml-preview): Added comment concerning tool bar icons. + * mml.el (mml-preview): Add comment concerning tool bar icons. * gnus-group.el (gnus-group-tool-bar-gnome): Use new icon names. (gnus-group-make-tool-bar): Use `gmm-image-load-path'. @@ -9835,10 +11370,10 @@ * message.el (message-tool-bar-gnome): Use new icon names. (message-make-tool-bar): Use `gmm-image-load-path'. - * gmm-utils.el (gmm-defun-compat, gmm-image-search-load-path): New - functions from MH-E. + * gmm-utils.el (gmm-defun-compat, gmm-image-search-load-path): + New functions from MH-E. (gmm-image-load-path): New variable from MH-E. - (gmm-image-load-path): New function from MH-E. Added arguments + (gmm-image-load-path): New function from MH-E. Add arguments LIBRARY, IMAGE and PATH. Don't modify paths. Don't use *-image-load-path-called-flag. @@ -9855,8 +11390,8 @@ * mm-util.el (mm-charset-override-alist): Fix type in doc string. - * gnus-art.el (mm-url-insert-file-contents-external): Autoload - mm-url. + * gnus-art.el (mm-url-insert-file-contents-external): + Autoload mm-url. * mm-uu.el (mm-uu-type-alist): Improve `LaTeX'. @@ -9877,13 +11412,13 @@ 2006-02-17 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (article-strip-banner): Call - article-really-strip-banner only when the regexp match is made. + * gnus-art.el (article-strip-banner): + Call article-really-strip-banner only when the regexp match is made. 2006-02-16 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (article-strip-banner): Use - gnus-extract-address-components instead of + * gnus-art.el (article-strip-banner): + Use gnus-extract-address-components instead of mail-header-parse-addresses to make it work with non-ASCII text; remove mail-encode-encoded-word-string. @@ -9975,8 +11510,8 @@ 2006-02-08 Katsumi Yamaoka <yamaoka@jpl.org> - * nnfolder.el (nnfolder-insert-newsgroup-line): Use - message-make-date instead of current-time-string. + * nnfolder.el (nnfolder-insert-newsgroup-line): + Use message-make-date instead of current-time-string. * mm-view.el (mm-inline-message): Don't set gnus-newsgroup-charset to gnus-decoded which mm-uu might set. @@ -10123,8 +11658,8 @@ 2006-01-26 Steve Youngs <steve@sxemacs.org> - * gmm-utils.el (gmm-tool-bar-item, gmm-tool-bar-zap-list): Don't - autoload. + * gmm-utils.el (gmm-tool-bar-item, gmm-tool-bar-zap-list): + Don't autoload. 2006-01-26 Katsumi Yamaoka <yamaoka@jpl.org> @@ -10141,8 +11676,8 @@ `gmm-tool-bar-from-list'. * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) - (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New - variables. + (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): + New variables. (gnus-group-make-tool-bar): Complete rewrite using `gmm-tool-bar-from-list'. (gnus-group-tool-bar-update): New function. @@ -10192,13 +11727,13 @@ (mm-inline-text-html-render-with-w3m-standalone): Use it to alter w3m usage. - * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): Use - mm-w3m-standalone-supports-m17n-p to alter w3m usage. + * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): + Use mm-w3m-standalone-supports-m17n-p to alter w3m usage. 2006-01-23 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-tool-bar-zap-list): Use - gmm-tool-bar-zap-list as custom type. + * message.el (message-tool-bar-zap-list): + Use gmm-tool-bar-zap-list as custom type. (message-tool-bar-update): New function. (message-tool-bar, message-tool-bar-gnome) (message-tool-bar-retro): Add message-tool-bar-update. @@ -10318,8 +11853,8 @@ 2006-01-13 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (article-wash-html): Use - gnus-summary-show-article-charset-alist if a numeric arg is given. + * gnus-art.el (article-wash-html): + Use gnus-summary-show-article-charset-alist if a numeric arg is given. (gnus-article-wash-html-with-w3m-standalone): New function. * mm-view.el (mm-text-html-renderer-alist): Map w3m-standalone to @@ -10346,8 +11881,8 @@ * gnus-cus.el (gnus-group-parameters): Sync posting-style with custom definition of `gnus-posting-styles'. - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind - print-circle. Suggested by Kalle Olavi Niemitalo <kon@iki.fi>. + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): + Bind print-circle. Suggested by Kalle Olavi Niemitalo <kon@iki.fi>. 2006-01-05 Reiner Steib <Reiner.Steib@gmx.de> @@ -10434,8 +11969,8 @@ `customize-apropos' for any "M-x customize-*" button but the function called for. Accept both the function name and its argument in order to achieve this. - (gnus-button-alist): Remove support for "custom:" URL's. Pass - function name to `gnus-button-handle-custom' in case of "M-x + (gnus-button-alist): Remove support for "custom:" URL's. + Pass function name to `gnus-button-handle-custom' in case of "M-x customize-*" buttons. 2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> @@ -10464,11 +11999,11 @@ 2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> - * rfc2047.el (rfc2047-charset-to-coding-system): Recognize - us-ascii as a MIME charset. + * rfc2047.el (rfc2047-charset-to-coding-system): + Recognize us-ascii as a MIME charset. - * mm-bodies.el (mm-decode-content-transfer-encoding): Protect - against the case where the 2nd arg TYPE is nil. + * mm-bodies.el (mm-decode-content-transfer-encoding): + Protect against the case where the 2nd arg TYPE is nil. 2005-12-09 Reiner Steib <Reiner.Steib@gmx.de> @@ -10496,8 +12031,8 @@ * gnus-fun.el (gnus-face-from-file): Decrease quant in smaller steps when < 10. - * gnus-start.el (gnus-no-server-1): Mention - `gnus-level-default-subscribed' in doc string. + * gnus-start.el (gnus-no-server-1): + Mention `gnus-level-default-subscribed' in doc string. 2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) @@ -10605,8 +12140,8 @@ 2005-11-12 Kevin Greiner <kevin.greiner@compsol.cc> - * gnus-agent.el (gnus-agent-article-alist-save-format): Changed - internal variable to a custom variable. Changed default value + * gnus-agent.el (gnus-agent-article-alist-save-format): + Change internal variable to a custom variable. Change default value from compressed(2) to uncompressed(1). (gnus-agent-read-agentview): Reversed revision 7.8 to restore support for uncompressed agentview files. Taken together, reading @@ -10620,12 +12155,12 @@ 2005-12-09 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-start.el (gnus-start-draft-setup): Enforce - `gnus-draft-mode' for nndraft:drafts at startup. + * gnus-start.el (gnus-start-draft-setup): + Enforce `gnus-draft-mode' for nndraft:drafts at startup. * gnus.el (gnus-splash): Change custom group. - (gnus-group-get-parameter, gnus-group-parameter-value): Describe - allow-list argument. + (gnus-group-get-parameter, gnus-group-parameter-value): + Describe allow-list argument. * gnus-agent.el (gnus-agent-article-alist-save-format): Format doc string. @@ -10830,8 +12365,8 @@ * mm-uu.el (mm-uu-verbatim-marks-extract): Add four start and end arguments. - (mm-uu-type-alist): Add message-marks and insert-marks. Pass - arguments to mm-uu-verbatim-marks-extract. + (mm-uu-type-alist): Add message-marks and insert-marks. + Pass arguments to mm-uu-verbatim-marks-extract. (mm-uu-hide-markers): New variable. (mm-uu-extract): Use face similar to `gnus-cite-3'. @@ -10870,8 +12405,8 @@ * message.el (message-tool-bar-local-item-from-menu): Fix comment. - * mm-bodies.el (mm-decode-string): Call - `mm-charset-to-coding-system' with allow-override argument. + * mm-bodies.el (mm-decode-string): + Call `mm-charset-to-coding-system' with allow-override argument. 2005-10-19 Katsumi Yamaoka <yamaoka@jpl.org> @@ -10898,7 +12433,7 @@ 2005-10-15 Bill Wohler <wohler@newt.com> - * message.el (message-tool-bar-map): Renamed image file from + * message.el (message-tool-bar-map): Rename image file from mail_send to mail/send. 2005-10-16 Masatake YAMATO <jet@gyve.org> @@ -10910,14 +12445,14 @@ * mml-sec.el (mml-secure-method): New internal variable. (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) - (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): New - functions using mml-secure-method. + (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): + New functions using mml-secure-method. * mml.el (mml-mode-map): Add key bindings for those functions. (mml-menu): Simplify security menu entries. Suggested by Jesper Harder <harder@myrealbox.com>. - (mml-attach-file, mml-attach-buffer, mml-attach-external): Goto - end of message if point is the headers of the message. + (mml-attach-file, mml-attach-buffer, mml-attach-external): + Goto end of message if point is the headers of the message. * message.el (message-in-body-p): New function. @@ -10926,8 +12461,8 @@ * mm-util.el (mm-charset-to-coding-system): Add allow-override. Use `mm-charset-override-alist' only when decoding. - * mm-bodies.el (mm-decode-body): Call - `mm-charset-to-coding-system' with allow-override argument. + * mm-bodies.el (mm-decode-body): + Call `mm-charset-to-coding-system' with allow-override argument. * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch `filename' from Content-Disposition if Content-Type doesn't @@ -10950,8 +12485,8 @@ (mm-charset-to-coding-system): Use it. (mm-codepage-setup): New helper function. (mm-charset-eval-alist): New variable. - (mm-charset-to-coding-system): Use mm-charset-eval-alist. Warn - about unknown charsets. + (mm-charset-to-coding-system): Use mm-charset-eval-alist. + Warn about unknown charsets. 2005-10-04 David Hansen <david.hansen@gmx.net> @@ -11005,15 +12540,15 @@ 2005-09-29 Simon Josefsson <jas@extundo.com> - * spam.el: Load hashcash when compiling, to avoid warnings. Don't - autoload mail-check-payment. + * spam.el: Load hashcash when compiling, to avoid warnings. + Don't autoload mail-check-payment. (spam-check-hashcash): Define unconditionally, since hashcash.el is part of Gnus now. Ignore errors from payment checking. 2005-09-28 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-bold-region, message-unbold-region): Rename - from `bold-region' and `unbold-region'. + * message.el (message-bold-region, message-unbold-region): + Rename from `bold-region' and `unbold-region'. * message.el: Remove useless autoloads. @@ -11110,20 +12645,20 @@ * gnus-agent.el (gnus-agent-synchronize-flags): Explain why the default value is nil. - * mm-uu.el (mm-uu-type-alist): Added slrn style verbatim-marks. + * mm-uu.el (mm-uu-type-alist): Add slrn style verbatim-marks. (mm-uu-verbatim-marks-extract): New function. (mm-uu-extract): New face. (mm-uu-copy-to-buffer): Use it. - * spam-report.el (spam-report-gmane-ham): Renamed from + * spam-report.el (spam-report-gmane-ham): Rename from `spam-report-gmane-unspam'. - (spam-report-gmane-internal): Renamed from `spam-report-gmane'. + (spam-report-gmane-internal): Rename from `spam-report-gmane'. Simplify use of UNSPAM argument. Fetch "X-Report-Unspam" header. * spam.el (spam-report-gmane-spam, spam-report-gmane-ham): Autoload. - (spam-report-gmane-unregister-routine): Renamed - `spam-report-gmane-unspam' to `spam-report-gmane-ham'. + (spam-report-gmane-unregister-routine): + Rename `spam-report-gmane-unspam' to `spam-report-gmane-ham'. 2005-09-21 Teodor Zlatanov <tzz@lifelogs.com> @@ -11161,11 +12696,11 @@ * gnus-art.el (gnus-article-replace-part) (gnus-mime-replace-part): New functions. (gnus-mime-action-alist, gnus-mime-button-commands) - (gnus-mime-save-part-and-strip): Added file argument. - (gnus-article-part-wrapper): Added interactive argument. + (gnus-mime-save-part-and-strip): Add file argument. + (gnus-article-part-wrapper): Add interactive argument. - * gnus-sum.el (gnus-summary-mime-map): Add - `gnus-article-replace-part'. + * gnus-sum.el (gnus-summary-mime-map): + Add `gnus-article-replace-part'. 2005-09-19 Didier Verna <didier@xemacs.org> @@ -11214,8 +12749,8 @@ (message-setup-1): Call `message-use-alternative-email-as-from' after `message-setup-hook' to give it precedence over posting styles, etc. - (message-use-alternative-email-as-from): Add docstring. Remove - the original From header if present. + (message-use-alternative-email-as-from): Add docstring. + Remove the original From header if present. * nnml.el (nnml-compressed-files-size-threshold): New variable. (nnml-save-mail): Use it. @@ -11289,13 +12824,13 @@ 2005-09-04 Reiner Steib <Reiner.Steib@gmx.de> - * mml.el (mml-dnd-protocol-alist, mml-dnd-attach-options): New - variables. + * mml.el (mml-dnd-protocol-alist, mml-dnd-attach-options): + New variables. (mml-dnd-attach-file, mml-mode): Use them. * nnweb.el (nnweb-type-definition, nnweb-google-wash-article): - Make fetching article by MID work again for Google Groups. Added - FIXME concerning gnus-group-make-web-group. + Make fetching article by MID work again for Google Groups. + Add FIXME concerning gnus-group-make-web-group. * mml-smime.el (mml-smime-sign-query, mml-smime-get-dns-cert): Don't depend on Gnus by using mail-extract-address-components if @@ -11315,8 +12850,8 @@ 2005-09-02 Hrvoje Niksic <hniksic@xemacs.org> - * mm-encode.el (mm-encode-content-transfer-encoding): Likewise - when encoding. + * mm-encode.el (mm-encode-content-transfer-encoding): + Likewise when encoding. * mm-bodies.el (mm-decode-content-transfer-encoding): De-canonicalize CRLF for all text content types, not just @@ -11336,20 +12871,20 @@ 2005-08-29 Jari Aalto <jari.aalto@cante.net> - * gnus-msg.el (gnus-inews-add-send-actions): Made - `message-post-method' lambda parameter ARG `&optional'. + * gnus-msg.el (gnus-inews-add-send-actions): + Make `message-post-method' lambda parameter ARG `&optional'. 2005-08-29 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-sum.el (gnus-summary-mime-map): Added - gnus-article-save-part-and-strip, gnus-article-delete-part and + * gnus-sum.el (gnus-summary-mime-map): + Add gnus-article-save-part-and-strip, gnus-article-delete-part and gnus-article-jump-to-part. - * gnus-art.el (gnus-article-edit-article): Added quiet argument. + * gnus-art.el (gnus-article-edit-article): Add quiet argument. (gnus-article-edit-part): Use it. - (gnus-article-part-wrapper): Added no-handle argument. - (gnus-article-save-part-and-strip, gnus-article-delete-part): New - functions. + (gnus-article-part-wrapper): Add no-handle argument. + (gnus-article-save-part-and-strip, gnus-article-delete-part): + New functions. 2005-08-29 Romain Francoise <romain@orebokech.com> @@ -11412,7 +12947,7 @@ * pgg.el (url-insert-file-contents): Don't autoload it, Emacs has it in url-handlers.el and XEmacs in url.el. Reported by Luca Capello and Romain Francoise. - (pgg-fetch-key-function): Removed, not used? + (pgg-fetch-key-function): Remove, not used? (pgg-insert-url-with-w3): Require url, to get url-insert-file-contents regardless of where it is defined. @@ -11469,8 +13004,8 @@ 2005-08-02 Katsumi Yamaoka <yamaoka@jpl.org> - * sieve-manage.el (sieve-manage-interactive-login): Use - make-local-variable rather than make-variable-buffer-local. + * sieve-manage.el (sieve-manage-interactive-login): + Use make-local-variable rather than make-variable-buffer-local. (sieve-manage-open): Ditto. (sieve-manage-authenticate): Ditto. @@ -11578,8 +13113,8 @@ 2005-07-16 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-msg.el (gnus-button-mailto): Remove - save-selected-window-window hackery because it relies on + * gnus-msg.el (gnus-button-mailto): + Remove save-selected-window-window hackery because it relies on save-selected-window internals. 2005-07-15 Katsumi Yamaoka <yamaoka@jpl.org> @@ -11593,14 +13128,14 @@ 2005-07-14 Hiroshi Fujishima <hiroshi.fujishima@gmail.com> (tiny change) - * gnus-score.el (gnus-score-edit-all-score): Set - gnus-score-edit-exit-function to gnus-score-edit-done and call + * gnus-score.el (gnus-score-edit-all-score): + Set gnus-score-edit-exit-function to gnus-score-edit-done and call gnus-message. 2005-07-14 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-msg.el (gnus-button-mailto): Remove - save-selected-window-window hackery because it relies on + * gnus-msg.el (gnus-button-mailto): + Remove save-selected-window-window hackery because it relies on save-selected-window internals. 2005-07-13 Katsumi Yamaoka <yamaoka@jpl.org> @@ -12161,8 +13696,8 @@ 2005-04-21 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-kill-buffer-query): Renamed from - `message-kill-buffer-query-if-modified'. Added :version. + * message.el (message-kill-buffer-query): Rename from + `message-kill-buffer-query-if-modified'. Add :version. 2005-04-19 Katsumi Yamaoka <yamaoka@jpl.org> @@ -12340,8 +13875,8 @@ 2005-03-09 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-msg.el (gnus-confirm-mail-reply-to-news): Add - gnus-expert-user to default. + * gnus-msg.el (gnus-confirm-mail-reply-to-news): + Add gnus-expert-user to default. 2005-03-08 Juergen Kreileder <jk@blackdown.de> (tiny change) @@ -12357,12 +13892,12 @@ 2005-03-06 Kevin Greiner <kevin.greiner@compsol.cc> - * gnus-start.el (gnus-convert-old-newsrc): Fixed numeric + * gnus-start.el (gnus-convert-old-newsrc): Fix numeric comparison on string. * gnus-agent.el (gnus-agent-long-article, gnus-agent-short-article) - (gnus-agent-score): Renamed category keywords to match gnus-cus. - (gnus-agent-summary-fetch-series): Modified to protect against + (gnus-agent-score): Rename category keywords to match gnus-cus. + (gnus-agent-summary-fetch-series): Modify to protect against gnus-agent-summary-fetch-group clearing processable flags. (gnus-agent-synchronize-group-flags): Update live group buffer as synchronization may occur due to the user toggle the plugged @@ -12371,10 +13906,10 @@ successfully downloaded. (gnus-agent-expire-group-1): Avoid using markers when the overview is in ascending order; greatly improves performance. - (gnus-agent-regenerate-group): Use - gnus-agent-synchronize-group-flags to reset read status in both + (gnus-agent-regenerate-group): + Use gnus-agent-synchronize-group-flags to reset read status in both gnus and server. - (gnus-agent-update-files-total-fetched-for): Fixed initial size. + (gnus-agent-update-files-total-fetched-for): Fix initial size. 2005-03-04 Reiner Steib <Reiner.Steib@gmx.de> @@ -12459,13 +13994,13 @@ 2005-02-25 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-sum.el (gnus-summary-move-article): Set - gnus-sum-hint-move-is-internal for gnus-request-move-article and + * gnus-sum.el (gnus-summary-move-article): + Set gnus-sum-hint-move-is-internal for gnus-request-move-article and whatever it calls (right now, only nnimap-request-move article respects it). - * nnimap.el (nnimap-request-move-article): When - gnus-sum-hint-move-is-internal is set, don't do the extra + * nnimap.el (nnimap-request-move-article): + When gnus-sum-hint-move-is-internal is set, don't do the extra nnimap-request-article. 2005-02-24 Reiner Steib <Reiner.Steib@gmx.de> @@ -12511,7 +14046,7 @@ 2005-02-21 Arne Jørgensen <arne@arnested.dk> - * nnrss.el (nnrss-verbose): Removed. + * nnrss.el (nnrss-verbose): Remove. (nnrss-request-group): Use `nnheader-message' instead. 2005-02-19 Mark Plaksin <happy@usg.edu> (tiny change) @@ -12569,7 +14104,7 @@ * smime.el (smime-cert-by-dns): Add doc-string. (smime-cert-by-ldap-1): Indent. - * mml-smime.el (mml-smime-get-ldap-cert): Renamed from + * mml-smime.el (mml-smime-get-ldap-cert): Rename from mml-smime-get-dns-ldap. (mml-smime-encrypt-query): Use new function. Default to ldap. @@ -12637,8 +14172,8 @@ * mm-view.el (mm-display-inline-fontify): Allow the name parameter as well as the filename parameter. - * mm-util.el (mm-decompress-buffer): Merge - gnus-mime-jka-compr-maybe-uncompress. + * mm-util.el (mm-decompress-buffer): + Merge gnus-mime-jka-compr-maybe-uncompress. (mm-find-buffer-file-coding-system): Doc fix; force decompressing of compressed data. @@ -12722,7 +14257,7 @@ 2005-01-26 Steve Youngs <steve@sxemacs.org> - * run-at-time.el: Removed. It is no longer needed as + * run-at-time.el: Remove. It is no longer needed as timer-funcs.el in the xemacs-base package has a working version of `run-at-time'. @@ -12806,8 +14341,8 @@ 2005-01-10 Reiner Steib <Reiner.Steib@gmx.de> * gnus.el (gnus-user-agent): Use list of symbols instead of - symbols. Display full version number for (S)XEmacs. Optionally - display (S)XEmacs codename. + symbols. Display full version number for (S)XEmacs. + Optionally display (S)XEmacs codename. * gnus-util.el (gnus-emacs-version): Update for new `gnus-user-agent'. @@ -13019,12 +14554,12 @@ 2004-11-25 Reiner Steib <Reiner.Steib@gmx.de> - * message.el (message-forbidden-properties): Fixed typo in doc + * message.el (message-forbidden-properties): Fix typo in doc string. 2004-11-25 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-util.el (gnus-replace-in-string): Added doc string. + * gnus-util.el (gnus-replace-in-string): Add doc string. * nnmail.el (nnmail-split-header-length-limit): Increase to 2048 to avoid problems when splitting mails with many recipients. @@ -13042,8 +14577,8 @@ 2004-12-03 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-sum.el (gnus-summary-limit-to-recipient): Implement - not-matching option. + * gnus-sum.el (gnus-summary-limit-to-recipient): + Implement not-matching option. 2004-12-02 Reiner Steib <Reiner.Steib@gmx.de> @@ -13162,8 +14697,8 @@ 2004-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> - * message.el (message-strip-forbidden-properties): Bind - buffer-read-only (etc) to nil. + * message.el (message-strip-forbidden-properties): + Bind buffer-read-only (etc) to nil. 2004-11-23 Katsumi Yamaoka <yamaoka@jpl.org> @@ -13370,8 +14905,8 @@ * deuglify.el (gnus-outlook-deuglify): Add :version. - * html2text.el: Beautify code. Improve doc strings. Some - checkdoc cleanup. + * html2text.el: Beautify code. Improve doc strings. + Some checkdoc cleanup. (html2text-get-attr, html2text-fix-paragraph): Simplify code. 2004-11-01 Alfred M. Szmidt <ams@kemisten.nu> (tiny change) @@ -13387,8 +14922,8 @@ for people who want to override the default SpamAssassin over Bogofilter preference (when both are set). (spam-necessary-extra-headers): Add spam-use-bogofilter as an option. - (spam-user-format-function-S): Check - spam-summary-score-preferred-header. + (spam-user-format-function-S): + Check spam-summary-score-preferred-header. (spam-extra-header-to-number): Add X-Bogosity header parsing. (spam-user-format-function-S): Format the score correctly. @@ -13485,7 +15020,7 @@ 2004-10-18 Reiner Steib <Reiner.Steib@gmx.de> * gnus-art.el (gnus-copy-article-ignored-headers): Default to - nil. Changed custom type. + nil. Change custom type. 2004-10-17 Reiner Steib <Reiner.Steib@gmx.de> @@ -13537,8 +15072,8 @@ * netrc.el (netrc-machine-user-or-password): Add convenience wrapper for netrc-machine. - * nnimap.el (nnimap-open-connection): Use - netrc-machine-user-or-password. + * nnimap.el (nnimap-open-connection): + Use netrc-machine-user-or-password. 2004-10-17 Richard M. Stallman <rms@gnu.org> @@ -13591,7 +15126,7 @@ * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port) (pop3-password-required, pop3-authentication-scheme) - (pop3-leave-mail-on-server): Made customizable. + (pop3-leave-mail-on-server): Make customizable. (pop3): New custom group. (pop3-retr): Remove `sleep-for' statements. Suggested by Dave Love <fx@gnu.org>. @@ -13600,8 +15135,8 @@ Windows/DOS. * imap.el (imap-parse-flag-list, imap-parse-body-extension) - (imap-parse-body): Fix incorrect use of `assert'. Suggested by - Dave Love <fx@gnu.org>. + (imap-parse-body): Fix incorrect use of `assert'. + Suggested by Dave Love <fx@gnu.org>. * mml.el (mml-minibuffer-read-disposition): Require match. Suggested by Dave Love <fx@gnu.org>. @@ -13660,8 +15195,8 @@ * mm-decode.el (mm-dissect-singlepart): Revert 2004-08-18 change. - * gnus-topic.el (gnus-topic-hierarchical-parameters): Use - gnus-current-topics instead of gnus-current-topic. + * gnus-topic.el (gnus-topic-hierarchical-parameters): + Use gnus-current-topics instead of gnus-current-topic. 2004-10-06 Jesper Harder <harder@ifa.au.dk> @@ -13733,8 +15268,8 @@ 2004-10-01 Kevin Greiner <kgreiner@compsol.cc> - * gnus-agent.el (gnus-agent-synchronize-group-flags): Added - support for sync'ing tick marks. + * gnus-agent.el (gnus-agent-synchronize-group-flags): + Add support for sync'ing tick marks. 2004-10-01 Katsumi Yamaoka <yamaoka@jpl.org> @@ -13743,8 +15278,8 @@ 2004-10-01 Kevin Greiner <kgreiner@compsol.cc> - * gnus-agent.el (gnus-agent-synchronize-group-flags): When - necessary, pass full group name to gnus-request-set-marks. + * gnus-agent.el (gnus-agent-synchronize-group-flags): + When necessary, pass full group name to gnus-request-set-marks. 2004-10-01 Simon Josefsson <jas@extundo.com> @@ -13773,11 +15308,11 @@ 2004-09-28 Kevin Greiner <kgreiner@compsol.cc> - * gnus-agent.el (gnus-agent-synchronize-group-flags): Replaced + * gnus-agent.el (gnus-agent-synchronize-group-flags): Replace gnus-requst-update-info with explicit code to sync the in-memory info read flags with the marks being sync'd to the backend. - *gnus-util.el (gnus-pp): Added optional stream to match pp API. + *gnus-util.el (gnus-pp): Add optional stream to match pp API. 2004-09-28 Teodor Zlatanov <tzz@lifelogs.com> @@ -13792,8 +15327,8 @@ 2004-09-28 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-registry.el (gnus-registry-split-fancy-with-parent): Use - gnus-extract-references instead of gnus-split-references. + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Use gnus-extract-references instead of gnus-split-references. * gnus-util.el (gnus-extract-references): Add new function, analogous to gnus-split-references but extracts only the message-ID without @@ -13849,7 +15384,7 @@ 2004-09-25 Kevin Greiner <kgreiner@compsol.cc> - * gnus-agent.el (gnus-agent-check-overview-buffer): Fixed range of + * gnus-agent.el (gnus-agent-check-overview-buffer): Fix range of deletion to remove entire duplicate line. Fixes merged article number bug. @@ -13866,10 +15401,10 @@ Updates marks in memory (in the info structure) AND in the backend. - * gnus-util.el (gnus-remassoc): Fixed typo in documentation. + * gnus-util.el (gnus-remassoc): Fix typo in documentation. - * nnagent.el (nnagent-request-set-mark): Use - gnus-agent-synchronize-group-flags, not backend's request-set-mark + * nnagent.el (nnagent-request-set-mark): + Use gnus-agent-synchronize-group-flags, not backend's request-set-mark method, to ensure that synchronization updates marks in the backend and in the info (in memory) structure. @@ -13886,7 +15421,7 @@ an error. * gnus-int.el (gnus-request-set-mark, gnus-request-update-mark): - Reverted 2004-09-21 change. The backend must be opened while + Revert 2004-09-21 change. The backend must be opened while synchronizing flags even when the backend stores the flags locally. @@ -13948,7 +15483,7 @@ * nnimap.el (nnimap-split-download-body, nnimap-dont-close) (nnimap-retrieve-groups-asynchronous): Add :version. - (nnimap-close-asynchronous): Add :version. Fixed typo in doc string. + (nnimap-close-asynchronous): Add :version. Fix typo in doc string. * mml.el (mml-content-disposition-parameters) (mml-insert-mime-headers-always): Add :version. @@ -14162,8 +15697,8 @@ 2004-09-09 Kevin Greiner <kgreiner@compsol.cc> - * gnus-agent.el (directory-files-and-attributes): Optionally - defined to support XEmacs. + * gnus-agent.el (directory-files-and-attributes): + Optionally defined to support XEmacs. 2004-09-09 Kevin Greiner <kgreiner@compsol.cc> @@ -14174,27 +15709,27 @@ article numbers even when local .overview file is missing. (gnus-agent-read-article-number): New function. Only accepts 27-bit article numbers. - (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use - gnus-agent-read-article-number. + (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): + Use gnus-agent-read-article-number. (gnus-agent-braid-nov): Rewrote to validate article numbers coming from backend while recognizing that article numbers in .overview must be valid. - (gnus-agent-update-files-total-fetched-for): Use - directory-files-and-attributes to improve performance. - * gnus-int.el (gnus-request-move-article): Use - gnus-agent-unfetch-articles in place of gnus-agent-expire to + (gnus-agent-update-files-total-fetched-for): + Use directory-files-and-attributes to improve performance. + * gnus-int.el (gnus-request-move-article): + Use gnus-agent-unfetch-articles in place of gnus-agent-expire to improve performance. - * gnus-start.el (gnus-convert-old-newsrc): Changed message text as + * gnus-start.el (gnus-convert-old-newsrc): Change message text as some users confused by references to .newsrc when they only have a .newsrc.eld file. (gnus-convert-mark-converter-prompt) - (gnus-convert-converter-needs-prompt): Fixed use of property list. + (gnus-convert-converter-needs-prompt): Fix use of property list. * legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt): New function. Used internally to only display 'gnus converting files' message when actually necessary. - * gnus-sum.el (): Removed (require 'gnus-agent) as required + * gnus-sum.el (): Remove (require 'gnus-agent) as required methods now autoloaded. 2004-09-03 Katsumi Yamaoka <yamaoka@jpl.org> @@ -14219,7 +15754,7 @@ * message.el: Don't autoload sha1 (there is a autoload cookie in sha1.el). - * sha1-el.el: Renamed to sha1.el. + * sha1-el.el: Rename to sha1.el. 2004-08-30 Juanma Barranquero <lektu@terra.es> @@ -14358,13 +15893,13 @@ * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. - * gnus-art.el (gnus-button-alist): Improve - `gnus-button-handle-library' entry. + * gnus-art.el (gnus-button-alist): + Improve `gnus-button-handle-library' entry. 2004-08-19 Sebastian Freundt <hroptatyr@gna.org> (tiny change) - * nnmaildir.el (nnmaildir--emlink-p, nnmaildir--enoent-p): Use - downcase, since XEmacs capitalizes error messages differently. + * nnmaildir.el (nnmaildir--emlink-p, nnmaildir--enoent-p): + Use downcase, since XEmacs capitalizes error messages differently. 2004-08-18 Jesper Harder <harder@ifa.au.dk> @@ -14373,8 +15908,8 @@ 2004-08-18 Florian Weimer <fw@deneb.enyo.de> - * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind - `mm-fill-flowed'. + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): + Bind `mm-fill-flowed'. * mm-decode.el (mm-dissect-singlepart): Check it. @@ -14408,8 +15943,8 @@ 2004-08-06 Simon Josefsson <jas@extundo.com> - * gnus-sum.el (gnus-article-loose-mime): Change default to t. Doc - fix. + * gnus-sum.el (gnus-article-loose-mime): Change default to t. + Doc fix. 2004-08-05 Katsumi Yamaoka <yamaoka@jpl.org> @@ -14418,8 +15953,8 @@ 2004-08-04 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-registry.el (gnus-registry-split-fancy-with-parent): Try - to append in-reply-to: data to the references: header. + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Try to append in-reply-to: data to the references: header. * netrc.el: Remove old encryption support, autoload gnus-encrypt.el. (netrc-parse): Use gnus-encrypt.el functions. @@ -14451,8 +15986,8 @@ 2004-07-25 Katsumi Yamaoka <yamaoka@jpl.org> - * rfc2047.el (rfc2047-encode-region): Don't infloop. Suggested by - Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>. + * rfc2047.el (rfc2047-encode-region): Don't infloop. + Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>. 2004-07-25 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -14533,8 +16068,8 @@ 2004-07-02 Katsumi Yamaoka <yamaoka@jpl.org> - * mm-encode.el (mm-content-transfer-encoding-defaults): Use - qp-or-base64 for the application/* types. + * mm-encode.el (mm-content-transfer-encoding-defaults): + Use qp-or-base64 for the application/* types. 2004-07-02 Joakim Verona <joakim@verona.se> (tiny change) @@ -14558,8 +16093,8 @@ 2004-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-group.el (gnus-group-get-new-news-this-group): Don't - update info that isn't there. + * gnus-group.el (gnus-group-get-new-news-this-group): + Don't update info that isn't there. 2004-06-29 Ilya N. Golubev <gin@mo.msk.ru>. @@ -14590,15 +16125,15 @@ (mm-coding-system-priorities): Use shift_jis and iso-8859-1 instead of japanese-shift-jis and iso-latin-1 respectively in order to share the default value with both Emacs and XEmacs-mule. - (mm-mule-charset-to-mime-charset): Make - mm-coding-system-priorities effective. + (mm-mule-charset-to-mime-charset): + Make mm-coding-system-priorities effective. (mm-sort-coding-systems-predicate): Canonicalize coding-systems while predicating of candidates upon the priorities. 2004-06-27 Jesper Harder <harder@ifa.au.dk> - * gnus-sum.el (gnus-summary-make-menu-bar): Add - gnus-uu-invert-processable. + * gnus-sum.el (gnus-summary-make-menu-bar): + Add gnus-uu-invert-processable. * gnus.el: Autoload gnus-uu-invert-processable. @@ -14618,8 +16153,8 @@ 2004-06-23 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option. - (gnus-cite-parse): Ignore quoted envelope From_. Suggested by - Karl Chen <quarl@nospam.quarl.org>. + (gnus-cite-parse): Ignore quoted envelope From_. + Suggested by Karl Chen <quarl@nospam.quarl.org>. 2004-06-23 Jesper Harder <harder@ifa.au.dk> @@ -14674,8 +16209,8 @@ (spam-move-ham-routine): Add code to copy/move ham or spam. (spam-fetch-field-fast): Improve doc and code, plus allow the 'number request. - (spam-list-of-checks, spam-list-of-statistical-checks): Remove - variables. + (spam-list-of-checks, spam-list-of-statistical-checks): + Remove variables. (spam-split, spam-find-spam): Use the new backend code. (spam-registration-functions): Remove variable. (spam-unregister-routine): Add convenience wrapper. @@ -14750,8 +16285,8 @@ (nnheader-fake-message-id-p): Change regex to accommodate new fake ID format. - * gnus-sum.el (gnus-get-newsgroup-headers): Call - nnheader-generate-fake-message-id with the article number. + * gnus-sum.el (gnus-get-newsgroup-headers): + Call nnheader-generate-fake-message-id with the article number. 2004-06-12 YAGI Tatsuya <ynyaaa@ybb.ne.jp> (tiny change) @@ -14822,8 +16357,8 @@ 2004-06-06 Lars Magne Ingebrigtsen <larsi@gnus.org> - * message.el (message-cite-articles-with-x-no-archive): New - variable. + * message.el (message-cite-articles-with-x-no-archive): + New variable. (message-cite-original): Use it. 2004-06-04 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -14857,12 +16392,12 @@ 2004-05-28 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-alist): Fixed regexp for manual links. + * gnus-art.el (gnus-button-alist): Fix regexp for manual links. - * gnus-group.el (gnus-group-get-new-news-this-group): Added - doc-string. + * gnus-group.el (gnus-group-get-new-news-this-group): + Add doc-string. - * gnus-start.el (gnus-activate-group): Added doc-string. + * gnus-start.el (gnus-activate-group): Add doc-string. 2004-05-28 Katsumi Yamaoka <yamaoka@jpl.org> @@ -14883,21 +16418,21 @@ 2004-05-27 Daniel Pittman <daniel@rimspace.net> - * spam.el (spam-report-resend-register-routine): Allow - spam-report-resend-to to be a group parameter or a global value. + * spam.el (spam-report-resend-register-routine): + Allow spam-report-resend-to to be a group parameter or a global value. 2004-05-26 Simon Josefsson <jas@extundo.com> * starttls.el: Merge with my GNUTLS based starttls.el. (starttls-gnutls-program, starttls-use-gnutls) (starttls-extra-arguments, starttls-process-connection-type) - (starttls-connect, starttls-failure, starttls-success): New - variables. + (starttls-connect, starttls-failure, starttls-success): + New variables. (starttls-program, starttls-extra-args): Doc fix. - (starttls-negotiate-gnutls, starttls-open-stream-gnutls): New - functions. - (starttls-negotiate, starttls-open-stream): Check - `starttls-use-gnutls' and pass on to corresponding *-gnutls + (starttls-negotiate-gnutls, starttls-open-stream-gnutls): + New functions. + (starttls-negotiate, starttls-open-stream): + Check `starttls-use-gnutls' and pass on to corresponding *-gnutls function if it is set. 2004-05-27 Katsumi Yamaoka <yamaoka@jpl.org> @@ -14911,8 +16446,8 @@ 2004-05-26 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-mark-new-messages-in-spam-group-as-spam): Add - variable. + * spam.el (spam-mark-new-messages-in-spam-group-as-spam): + Add variable. (spam-mark-junk-as-spam-routine): Use it. Allow to disable assigning the spam-mark to new messages. @@ -14964,8 +16499,8 @@ 2004-05-24 Daniel Pittman <daniel@rimspace.net> - * spam-report.el (spam-report-resend-to, spam-report-resend): Start - with resend-to set to nil, and then ask the user if necessary. + * spam-report.el (spam-report-resend-to, spam-report-resend): + Start with resend-to set to nil, and then ask the user if necessary. (spam-report-resend): spam-report-resend takes a list of articles, not separate article numbers. @@ -15054,8 +16589,8 @@ (spam-crm114-register-spam-routine) (spam-crm114-unregister-spam-routine) (spam-crm114-register-ham-routine) - (spam-crm114-unregister-ham-routine): Add CRM114 support. From - asjo@koldfront.dk (Adam Sjøgren). + (spam-crm114-unregister-ham-routine): Add CRM114 support. + From asjo@koldfront.dk (Adam Sjøgren). * gnus.el: Add spam-use-crm114. @@ -15083,7 +16618,7 @@ 2004-05-20 Katsumi Yamaoka <yamaoka@jpl.org> - * rfc2047.el (rfc2047-encode-function-alist): Renamed from + * rfc2047.el (rfc2047-encode-function-alist): Rename from `rfc2047-encoding-function-alist' in order to avoid conflicting with the old version. (rfc2047-encode-region): Concatenate words containing non-ASCII @@ -15096,17 +16631,17 @@ iso-2022-* charsets. (rfc2047-fold-region): Use existing whitespace for LWSP; make it sure not to break a line just after the header name. - (rfc2047-b-encode-region): Removed. + (rfc2047-b-encode-region): Remove. (rfc2047-b-encode-string): New function. - (rfc2047-q-encode-region): Removed. + (rfc2047-q-encode-region): Remove. (rfc2047-q-encode-string): New function. * mm-util.el (mm-replace-in-string): New function. 2004-05-20 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-msg.el (gnus-inews-make-draft-meta-information): Really - get it right. + * gnus-msg.el (gnus-inews-make-draft-meta-information): + Really get it right. (gnus-inews-make-draft): Really. 2004-05-19 Ben Menasha <bmenasha@benmenasha.net> @@ -15119,8 +16654,8 @@ * gnus-msg.el (gnus-inews-make-draft-meta-information): Fix quote stuff. - * gnus-start.el (gnus-subscribe-hierarchical-interactive): Match - on real group name. + * gnus-start.el (gnus-subscribe-hierarchical-interactive): + Match on real group name. * gnus-art.el (gnus-signature-limit): Doc fix. @@ -15128,8 +16663,8 @@ 2004-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-draft.el (gnus-draft-send): Bind - rfc2047-encode-encoded-words. + * gnus-draft.el (gnus-draft-send): + Bind rfc2047-encode-encoded-words. * rfc2047.el (rfc2047-encode-region): Encode =? strings. (rfc2047-encodable-p): Say that =? needs encoding. @@ -15148,8 +16683,8 @@ 2004-05-19 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-msg.el (gnus-summary-followup-with-original): Document - yanking of region when active. + * gnus-msg.el (gnus-summary-followup-with-original): + Document yanking of region when active. 2004-05-19 Katsumi Yamaoka <yamaoka@jpl.org> @@ -15159,7 +16694,7 @@ 2004-05-18 Reiner Steib <Reiner.Steib@gmx.de> * gnus-group.el (gnus-group-jump-to-group-prompt): Allow an alist. - (gnus-group-jump-to-group): Added prefix argument using + (gnus-group-jump-to-group): Add prefix argument using `gnus-group-jump-to-group-prompt'. Query before jumping to non-active group. @@ -15193,9 +16728,9 @@ 2004-05-18 Reiner Steib <Reiner.Steib@gmx.de> * gnus-picon.el (gnus-picon-style): New variable. - (gnus-picon-insert-glyph): Added optional `nostring' argument. - (gnus-picon-transform-address): Support `gnus-picon-style'. From - Jesper Harder <harder@ifa.au.dk>. + (gnus-picon-insert-glyph): Add optional `nostring' argument. + (gnus-picon-transform-address): Support `gnus-picon-style'. + From Jesper Harder <harder@ifa.au.dk>. 2004-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -15236,7 +16771,7 @@ (message-fill-field-address): Rename. (message-narrow-to-field): Find the start of the header. (message-header-format-alist): Don't pre-fill. - (message-fill-header): Removed. + (message-fill-header): Remove. (message-insert-header): New function. (message-shorten-references): Use it. @@ -15255,10 +16790,10 @@ 2004-05-16 Lars Magne Ingebrigtsen <larsi@gnus.org> - * message.el (message-idna-inside-rhs-p): Removed. + * message.el (message-idna-inside-rhs-p): Remove. (message-idna-to-ascii-rhs-1): Use proper address parsing. - * gnus-art.el (gnus-emphasis-alist): Removed strikethru; too many + * gnus-art.el (gnus-emphasis-alist): Remove strikethru; too many false positives. 2004-05-16 Kim-Minh Kaplan <kmkaplan-AwwS6Bc0PDVoiYX5Tdu9fQ@public.gmane.org> @@ -15281,7 +16816,7 @@ 2004-05-15 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-summary-prepare-exit): Fixed (length). + * spam.el (spam-summary-prepare-exit): Fix (length). 2004-05-14 Teodor Zlatanov <tzz@lifelogs.com> @@ -15296,8 +16831,8 @@ 2004-05-14 Kai Grossjohann <kgrossjo@eu.uu.net> - * nntp.el (nntp-request-set-mark, nntp-request-update-info): Call - nntp-possibly-create-directory, not nntp-possibly-change-group. + * nntp.el (nntp-request-set-mark, nntp-request-update-info): + Call nntp-possibly-create-directory, not nntp-possibly-change-group. (nntp-marks-changed-p): New arg SERVER. (nntp-request-update-info): Adjust caller. @@ -15312,13 +16847,13 @@ (nntp-marks-modtime, nntp-marks-directory): New variables. (nntp-request-set-mark, nntp-request-update-info) (nntp-possibly-create-directory, nntp-marks-changed-p) - (nntp-save-marks, nntp-open-marks, nntp-marks-directory): New - functions. + (nntp-save-marks, nntp-open-marks, nntp-marks-directory): + New functions. 2004-05-12 Jesper Harder <harder@ifa.au.dk> - * gnus-score.el (gnus-score-insert-help): Use - gnus-select-lowest-window. + * gnus-score.el (gnus-score-insert-help): + Use gnus-select-lowest-window. * gnus-ems.el (gnus-select-lowest-window): Copy definition of appt-select-lowest-window and rename to gnus-select-lowest-window. @@ -15358,8 +16893,8 @@ 2004-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus-agent.el (gnus-agent-read-agentview): Inline - gnus-uncompress-range. + * gnus-agent.el (gnus-agent-read-agentview): + Inline gnus-uncompress-range. 2004-05-01 TSUCHIYA Masatoshi <tsuchiya@namazu.org> @@ -15368,8 +16903,8 @@ 2004-04-30 TSUCHIYA Masatoshi <tsuchiya@namazu.org> - * gnus.el (spam-process, spam-autodetect-methods): Add - bsfilter and bsfilter-headers. + * gnus.el (spam-process, spam-autodetect-methods): + Add bsfilter and bsfilter-headers. * spam.el (spam-bsfilter): New customize group. (spam-use-bsfilter, spam-use-bsfilter-headers, spam-bsfilter-path) @@ -15419,7 +16954,7 @@ * spam.el (spam-summary-prepare-exit) (spam-mark-junk-as-spam-routine, spam-fetch-field-fast) (spam-split, spam-find-spam, spam-log-undo-registration) - (spam-check-blackholes, spam-enter-ham-BBDB): Changed message + (spam-check-blackholes, spam-enter-ham-BBDB): Change message level from 5 to 6. 2004-04-26 Katsumi Yamaoka <yamaoka@jpl.org> @@ -15520,7 +17055,7 @@ 2004-04-15 Kevin Greiner <kgreiner@xpediantsolutions.com> * legacy-gnus-agent.el - (gnus-agent-convert-to-compressed-agentview): Fixed typos with + (gnus-agent-convert-to-compressed-agentview): Fix typos with help from Florian Weimer <fw@deneb.enyo.de> 2004-04-15 Katsumi Yamaoka <yamaoka@jpl.org> @@ -15581,25 +17116,25 @@ `method' parameter is nil. Don't write nil entries into the active file. (gnus-agent-get-group-info): New function. - (gnus-agent-fetch-articles): Use - gnus-agent-update-files-total-fetched-for to increment disk space + (gnus-agent-fetch-articles): + Use gnus-agent-update-files-total-fetched-for to increment disk space used. - (gnus-agent-fetch-headers, gnus-agent-save-alist): Use - gnus-agent-update-view-total-fetched-for to increment disk space + (gnus-agent-fetch-headers, gnus-agent-save-alist): + Use gnus-agent-update-view-total-fetched-for to increment disk space used. - (gnus-agent-get-local): Added optional parameters to avoid calling + (gnus-agent-get-local): Add optional parameters to avoid calling gnus-group-real-name and gnus-find-method-for-group. (gnus-agent-set-local): Delete stored entry if either min, or max, are nil. - (gnus-agent-fetch-session): Reworded error/quit messages. On - quit, use gnus-agent-regenerate-group to record existence of any + (gnus-agent-fetch-session): Reworded error/quit messages. + On quit, use gnus-agent-regenerate-group to record existence of any articles fetched to disk before the quit occurred. (gnus-agent-expire-group-1): Use gnus-agent-with-refreshed-group, gnus-agent-update-view-total-fetched-for, and gnus-agent-update-files-total-fetched-for to decrement disk space used. - (gnus-agent-retrieve-headers): Use - gnus-agent-update-view-total-fetched-for to increment disk space + (gnus-agent-retrieve-headers): + Use gnus-agent-update-view-total-fetched-for to increment disk space used. (gnus-agent-regenerate-group): Replace gnus-group-update-group with gnus-agent-update-files-total-fetched-for to decrement disk @@ -15610,14 +17145,14 @@ (gnus-agent-update-view-total-fetched-for): New function. (gnus-agent-total-fetched-for): New function. - * gnus-cache.el (gnus-cache-save-buffers): Use - gnus-cache-update-overview-total-fetched-for to change disk space + * gnus-cache.el (gnus-cache-save-buffers): + Use gnus-cache-update-overview-total-fetched-for to change disk space used by this group. - (gnus-cache-possibly-enter-article): Use - gnus-cache-update-file-total-fetched-for to increment disk space + (gnus-cache-possibly-enter-article): + Use gnus-cache-update-file-total-fetched-for to increment disk space used by this group. - (gnus-cache-possibly-remove-article): Use - gnus-cache-update-file-total-fetched-for to decrement disk space + (gnus-cache-possibly-remove-article): + Use gnus-cache-update-file-total-fetched-for to decrement disk space used by this group. (gnus-cache-generate-nov-databases): Purge total fetched cache. (gnus-cache-rename-group): New function. @@ -15688,8 +17223,8 @@ 2004-03-27 Katsumi Yamaoka <yamaoka@jpl.org> - * message.el (message-exchange-point-and-mark): Use - message-mark-active-p. Suggested by Jesper Harder + * message.el (message-exchange-point-and-mark): + Use message-mark-active-p. Suggested by Jesper Harder <harder@ifa.au.dk>. 2004-03-26 Katsumi Yamaoka <yamaoka@jpl.org> @@ -15738,8 +17273,8 @@ 2004-03-19 Katsumi Yamaoka <yamaoka@jpl.org> - * gnus-art.el (gnus-mime-recompute-hierarchical-structure): New - user option. + * gnus-art.el (gnus-mime-recompute-hierarchical-structure): + New user option. (gnus-mime-multipart-functions): Doc and customization fix. (gnus-article-mime-hierarchy): New variable. (gnus-article-mime-hierarchy-next): New variable. @@ -15807,8 +17342,8 @@ 2004-03-09 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-read-local): Bind - nnheader-file-coding-system to gnus-agent-file-coding-system to + * gnus-agent.el (gnus-agent-read-local): + Bind nnheader-file-coding-system to gnus-agent-file-coding-system to avoid the implicit assumption that they will always be equal. (gnus-agent-save-local): Bind buffer-file-coding-system, not coding-system-for-write, as the with-temp-file macro first prints @@ -15823,16 +17358,16 @@ 2004-03-08 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-read-agentview): Removed support for + * gnus-agent.el (gnus-agent-read-agentview): Remove support for old file versions. - (gnus-group-prepare-hook): Removed function that converted list + (gnus-group-prepare-hook): Remove function that converted list form of gnus-agent-expire-days to group properties. * gnus-int.el: Autoload gnus-agent-regenerate-group. (gnus-request-accept-article): Re-indented. * gnus-start.el (gnus-convert-old-newsrc): Registered new - converters to handle old agent file formats. Added logic for a + converters to handle old agent file formats. Add logic for a "backup before upgrading warning". (gnus-convert-mark-converter-prompt): Developers can mark functions as needing (default), or not needing, @@ -15933,7 +17468,7 @@ 2004-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-agent.el (gnus-agent-file-header-cache): Removed. + * gnus-agent.el (gnus-agent-file-header-cache): Remove. (gnus-agent-possibly-alter-active): Avoid null in numeric comparison. (gnus-agent-set-local): Refuse to save null in local object table. @@ -15954,8 +17489,8 @@ * gnus-agent.el (gnus-agent-read-local, gnus-agent-save-local): Don't bind "obarray". - * gnus-sum.el (gnus-thread-sort-functions): Added - `gnus-thread-sort-by-most-recent-number' and + * gnus-sum.el (gnus-thread-sort-functions): + Add `gnus-thread-sort-by-most-recent-number' and `gnus-thread-sort-by-most-recent-date'. Reported by Kai Grossjohann <kai@emptydomain.de>. @@ -15965,8 +17500,8 @@ 2004-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com> - * gnus-cus.el (gnus-agent-customize-category): Removed - ignore-errors macro reference that required cl to be loaded at + * gnus-cus.el (gnus-agent-customize-category): + Remove ignore-errors macro reference that required cl to be loaded at run-time. * gnus-range.el (gnus-sorted-range-intersection): Now accepts @@ -16004,8 +17539,8 @@ * gnus-msg.el (gnus-setup-message): Ignore an article copy while parsing gnus-posting-styles when the message is not for replying. - * nnrss.el (nnrss-opml-export): Use - mm-set-buffer-file-coding-system instead of + * nnrss.el (nnrss-opml-export): + Use mm-set-buffer-file-coding-system instead of set-buffer-file-coding-system. 2004-02-27 Jesper Harder <harder@ifa.au.dk> @@ -16051,20 +17586,20 @@ * spam-stat.el (spam-stat-washing-hook): New option. (spam-stat-buffer-words): Use it. - (spam-stat-process-directory, spam-stat-test-directory): Use - insert-file-contents-literally. + (spam-stat-process-directory, spam-stat-test-directory): + Use insert-file-contents-literally. (spam-stat-coding-system): New variable. (spam-stat-load, spam-stat-save): Use it. 2004-02-25 Katsumi Yamaoka <yamaoka@jpl.org> - * spam-report.el (spam-report-plug-agent): Quote - spam-report-url-to-file and spam-report-url-ping-plain. + * spam-report.el (spam-report-plug-agent): + Quote spam-report-url-to-file and spam-report-url-ping-plain. 2004-02-25 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-button-alist, gnus-header-button-alist): Allow - / in mailto URLs. + * gnus-art.el (gnus-button-alist, gnus-header-button-alist): + Allow / in mailto URLs. 2004-02-24 Reiner Steib <Reiner.Steib@gmx.de> @@ -16072,9 +17607,8 @@ (spam-report-url-ping-temp-agent-function, spam-report-plug-agent) (spam-report-unplug-agent): Doc fixes. (spam-report-url-ping-mm-url, spam-report-url-to-file) - (spam-report-agentize, spam-report-deagentize): Autoload - -2004-02-24 Katsumi Yamaoka <yamaoka@jpl.org> + (spam-report-agentize, spam-report-deagentize): + Autoload 2004-02-24 Katsumi Yamaoka <yamaoka@jpl.org> * message.el (message-setup-fill-variables): Add mml tags to paragraph-start and paragraph-separate. Suggested by Andrew Korty @@ -16136,8 +17670,8 @@ (nntp-send-buffer, nntp-retrieve-groups, nntp-handle-authinfo) (nntp-possibly-change-group): Use it. - * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Use - with-current-buffer. + * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): + Use with-current-buffer. 2004-02-12 TAKAI Kousuke <tak@kmc.gr.jp> @@ -16274,8 +17808,8 @@ 2004-02-03 Jesper Harder <harder@ifa.au.dk> - * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Fix - format string mismatch. + * spam.el (spam-check-spamoracle, spam-spamoracle-learn): + Fix format string mismatch. * sieve.el (sieve-deactivate-all): do. @@ -16336,8 +17870,8 @@ New macros and functions. * nnmaildir.el (nnmaildir--group-maxnum, nnmaildir--update-nov): Handle > NLINK_MAX messages. - * nnmaildir.el (nnmaildir-request-set-mark): Use - nnmaildir--emlink-p and nnmaildir--eexist-p. + * nnmaildir.el (nnmaildir-request-set-mark): + Use nnmaildir--emlink-p and nnmaildir--eexist-p. 2004-01-25 Alex Schroeder <alex@gnu.org> @@ -16377,8 +17911,8 @@ 2004-01-23 Jesper Harder <harder@ifa.au.dk> - * spam-stat.el (spam-stat-store-gnus-article-buffer): Use - with-current-buffer. + * spam-stat.el (spam-stat-store-gnus-article-buffer): + Use with-current-buffer. (spam-stat-store-current-buffer): Use insert-buffer-substring to avoid consing a string. @@ -16404,29 +17938,29 @@ (gnus-agent-prompt-send-queue): New variables. (gnus-agent-send-mail): Use gnus-agent-queue-mail. * gnus-draft.el (gnus-group-send-queue): Pass the group name - "nndraft:queue" along to gnus-draft-send. Use - gnus-agent-prompt-send-queue. + "nndraft:queue" along to gnus-draft-send. + Use gnus-agent-prompt-send-queue. (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group is "nndraft:queue". Suggested by Gaute Strokkenes <gs234@srcf.ucam.org> - * gnus-agent.el (agent-disable-undownloaded-faces): Removed. - (agent-enable-undownloaded-faces): Added. + * gnus-agent.el (agent-disable-undownloaded-faces): Remove. + (agent-enable-undownloaded-faces): Add. (gnus-agent-cat-groups): Use eval-and-compile, not eval-when-compile, to define gnus-agent-set-cat-groups as the setf method of gnus-agent-cat-groups even when the buffer has been evaled. - (gnus-agent-save-active, gnus-agent-save-active-1): Merged to + (gnus-agent-save-active, gnus-agent-save-active-1): Merge to delete gnus-agent-save-active-1. - (gnus-agent-save-groups): Deleted. Identical to + (gnus-agent-save-groups): Delete. Identical to gnus-agent-save-active. (gnus-agent-write-active): No longer adjust agent's copy of active file as agent's adjustments are now stored in their own - file. Removed optional parameter. + file. Remove optional parameter. (gnus-agent-possibly-alter-active): Ignore groups of unagentized servers. Add use of min/max range limits from server's local file. - (gnus-agent-save-alist): Removed unused optional argument. + (gnus-agent-save-alist): Remove unused optional argument. (gnus-agent-load-local, gnus-agent-read-and-cache-local) (gnus-agent-read-local, gnus-agent-save-local, gnus-agent-get-local) (gnus-agent-set-local): A per-server file that keeps min/max range @@ -16434,10 +17968,10 @@ for altering many active ranges. (gnus-agent-expire-group, gnus-agent-expire): No longer save the active file (local makes it unnecessary). - (gnus-agent-regenerate-group): Fixed XEmacs compatibility. + (gnus-agent-regenerate-group): Fix XEmacs compatibility. - * gnus-cus.el (agent-disable-undownloaded-faces): Removed. - (agent-enable-undownloaded-faces): Added. + * gnus-cus.el (agent-disable-undownloaded-faces): Remove. + (agent-enable-undownloaded-faces): Add. * gnus-draft.el (gnus-draft-send): Bind gnus-agent-queue-mail to disable it when sending to "nndraft:queue". @@ -16450,7 +17984,7 @@ numbers of articles. Use gnus-range-map to avoid having to uncompress the unread list. (gnus-group-archive-directory, gnus-group-recent-archive-directory): - Fixed invalid ange-ftp reference. + Fix invalid ange-ftp reference. * gnus-range.el (gnus-range-map): Iterate over list or sequence. (gnus-sorted-range-intersection): Intersection of two ranges @@ -16461,11 +17995,11 @@ and agentized articles. (gnus-convert-old-newsrc): Rewrote in anticipation of having multiple version-dependent converters. - (gnus-groups-to-gnus-format): Replaced gnus-agent-save-groups with + (gnus-groups-to-gnus-format): Replace gnus-agent-save-groups with gnus-agent-save-active. (gnus-save-newsrc-file): Save dirty agent range limits. - * gnus-sum.el (gnus-select-newgroup): Replaced inline code with + * gnus-sum.el (gnus-select-newgroup): Replace inline code with gnus-agent-possibly-alter-active. (gnus-adjust-marked-articles): Faster handling of simple lists @@ -16506,8 +18040,8 @@ spam-use-spamassassin or spam-use-spamassassin-headers is on; spam-bogofilter-score otherwise. - * gnus.el (spam-process, spam-autodetect-methods): Add - spamassassin and spamassassin-headers. + * gnus.el (spam-process, spam-autodetect-methods): + Add spamassassin and spamassassin-headers. 2004-01-20 Nevin Kapur <nkapur@cs.caltech.edu> @@ -16591,11 +18125,11 @@ 2004-01-13 Simon Josefsson <jas@extundo.com> * gnus-score.el (gnus-score-edit-all-score): Fix prototype. - Invoke gnus-score-mode. Reported by - bojohan+news@dd.chalmers.se (Johan BockgÃ¥rd). + Invoke gnus-score-mode. + Reported by bojohan+news@dd.chalmers.se (Johan BockgÃ¥rd). - * gnus-range.el (gnus-compress-sequence): Doc fix. Suggested by - Jim Blandy <jimb@redhat.com> (tiny change). + * gnus-range.el (gnus-compress-sequence): Doc fix. + Suggested by Jim Blandy <jimb@redhat.com> (tiny change). 2004-01-12 Jesper Harder <harder@ifa.au.dk> @@ -16718,8 +18252,8 @@ * mm-bodies.el: base64 is always built-in. - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use - with-current-buffer. + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): + Use with-current-buffer. 2004-01-08 Katsumi Yamaoka <yamaoka@jpl.org> @@ -16756,8 +18290,8 @@ 2004-01-08 Jesper Harder <harder@ifa.au.dk> * gnus-art.el (gnus-mime-view-all-parts) - (gnus-article-part-wrapper, gnus-article-view-part): Use - with-current-buffer. + (gnus-article-part-wrapper, gnus-article-view-part): + Use with-current-buffer. 2004-01-07 Teodor Zlatanov <tzz@lifelogs.com> @@ -16804,10 +18338,10 @@ (spam-find-spam): Don't try to guess spam-cache-lookups. (spam-enter-whitelist, spam-enter-blacklist): Clear the spam-caches entry. - (spam-filelist-build-cache, spam-filelist-check-cache): Fix - caching of whitelist/blacklist entries. - (spam-check-whitelist, spam-check-blacklist): Invoke - spam-from-listed-p with a type, not a cache variable. + (spam-filelist-build-cache, spam-filelist-check-cache): + Fix caching of whitelist/blacklist entries. + (spam-check-whitelist, spam-check-blacklist): + Invoke spam-from-listed-p with a type, not a cache variable. (spam-from-listed-p): Wrap around spam-filelist-check-cache. 2004-01-07 Jesper Harder <harder@ifa.au.dk> @@ -16886,7 +18420,7 @@ 2004-01-06 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-treat-ansi-sequences): Changed default. + * gnus-art.el (gnus-treat-ansi-sequences): Change default. 2004-01-07 Steve Youngs <sryoungs@bigpond.net.au> @@ -16919,10 +18453,10 @@ * gnus-art.el (gnus-button-push): Use set-text-properties instead of gnus-. - * gnus.el: Changed calls to nnheader-run-at-time and + * gnus.el: Change calls to nnheader-run-at-time and password-run-at-time throughout to use run-at-time directly. - * password.el: Removed definition of run-at-time. + * password.el: Remove definition of run-at-time. 2004-01-05 Karl Pflästerer <sigurd@12move.de> (tiny change) @@ -16948,8 +18482,8 @@ * gnus-util.el (gnus-local-map-property): Remove. - * mm-view.el (mm-view-pkcs7-decrypt): Replace - gnus-completing-read-maybe-default with completing-read. + * mm-view.el (mm-view-pkcs7-decrypt): + Replace gnus-completing-read-maybe-default with completing-read. * gnus-util.el (gnus-completing-read): do. (gnus-completing-read-maybe-default): Remove. @@ -16969,8 +18503,8 @@ * netrc.el: Autoload password-read. (netrc): Add configuration group. - (netrc-encoding-method, netrc-openssl-path): Add - variables for encoding and decoding of files with symmetric + (netrc-encoding-method, netrc-openssl-path): + Add variables for encoding and decoding of files with symmetric ciphers. (netrc-encode): Add assistant function to encode a file with netrc-encoding-method. @@ -17057,8 +18591,8 @@ * smime.el (smime-point-at-eol): Replace with point-at-eol. - * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): Replace - with point-at-{eol,bol}. + * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): + Replace with point-at-{eol,bol}. * netrc.el (netrc-point-at-eol): Replace with point-at-eol. @@ -17095,13 +18629,13 @@ ntlm-smb-perm5, smb-perm6 into ntlm-smb-perm6, smb-sc into ntlm-smb-sc, smb-sbox into ntlm-smb-sbox, string-permute into ntlm-string-permute, string-lshift into ntlm-string-lshift, - string-xor into ntlm-string-xor. Suggested by - Jesper Harder <harder@myrealbox.com>. + string-xor into ntlm-string-xor. + Suggested by Jesper Harder <harder@myrealbox.com>. * ntlm.el: Don't include poem. - * md4.el (print-int32, print-string-hexa): Remove. Suggested by - Jesper Harder <harder@myrealbox.com>. + * md4.el (print-int32, print-string-hexa): Remove. + Suggested by Jesper Harder <harder@myrealbox.com>. * sasl-ntlm.el, ntlm.el, md4.el: New files. @@ -17115,8 +18649,8 @@ condition-case around loop. * pgg.el (pgg-passphrase-cache, pgg-run-at-time): Remove. - (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): Use - the password package. + (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): + Use the password package. 2003-02-19 Simon Josefsson <jas@extundo.com> @@ -17175,9 +18709,9 @@ 2004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org> - * gnus.el (gnus-logo-color-style): Changed colors to `no'. + * gnus.el (gnus-logo-color-style): Change colors to `no'. - * Moved to Changelog.2. + * Move to Changelog.2. 2004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -17198,7 +18732,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. diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 89405278bea..767b50bbe09 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -3828,8 +3828,7 @@ that Gnus will render it as html if the user wants that. Implemented the ability to save nnrss-group-alist so that any new - feeds the you subscribe to will be found the next time you start - up. + feeds you subscribe to will be found the next time you start up. Implemented support for RSS 2.0 elements (author, pubDate). @@ -16434,7 +16433,7 @@ 2001-01-09 Didier Verna <didier@xemacs.org> * gnus-agent.el: Moved some XEmacs specific hook add-ons from - `gnus-xmas-[re]define' to avoid loosing user custom settings. + `gnus-xmas-[re]define' to avoid losing user custom settings. * gnus-art.el: Ditto. * gnus-group.el: Ditto. * gnus-salt.el: Ditto. diff --git a/lisp/gnus/color.el b/lisp/gnus/color.el new file mode 100644 index 00000000000..07044333c4b --- /dev/null +++ b/lisp/gnus/color.el @@ -0,0 +1,269 @@ +;;; color.el --- Color manipulation laboratory routines -*- coding: utf-8; -*- + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Julien Danjou <julien@danjou.info> +;; Keywords: html + +;; 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 package provides color manipulation functions. + +;;; Code: + +(eval-when-compile + (require 'cl)) + +;; Emacs < 23.3 +(eval-and-compile + (unless (boundp 'float-pi) + (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...)."))) + +(defun color-rgb->hex (red green blue) + "Return hexadecimal notation for RED GREEN BLUE color. +RED GREEN BLUE must be values between 0 and 1 inclusively." + (format "#%02x%02x%02x" + (* red 255) (* green 255) (* blue 255))) + +(defun color-complement (color) + "Return the color that is the complement of COLOR." + (let ((color (color-rgb->normalize color))) + (list (- 1.0 (car color)) + (- 1.0 (cadr color)) + (- 1.0 (caddr color))))) + +(defun color-complement-hex (color) + "Return the color that is the complement of COLOR, in hexadecimal format." + (apply 'color-rgb->hex (color-complement color))) + +(defun color-rgb->hsv (red green blue) + "Convert RED GREEN BLUE values to HSV representation. +Hue is in radians. Saturation and values are between 0 and 1 +inclusively." + (let* ((r (float red)) + (g (float green)) + (b (float blue)) + (max (max r g b)) + (min (min r g b))) + (list + (/ (* 2 float-pi + (cond ((and (= r g) (= g b)) 0) + ((and (= r max) + (>= g b)) + (* 60 (/ (- g b) (- max min)))) + ((and (= r max) + (< g b)) + (+ 360 (* 60 (/ (- g b) (- max min))))) + ((= max g) + (+ 120 (* 60 (/ (- b r) (- max min))))) + ((= max b) + (+ 240 (* 60 (/ (- r g) (- max min))))))) + 360) + (if (= max 0) + 0 + (- 1 (/ min max))) + (/ max 255.0)))) + +(defun color-rgb->hsl (red green blue) + "Convert RED GREEN BLUE colors to their HSL representation. +RED, GREEN and BLUE must be between 0 and 1 inclusively." + (let* ((r red) + (g green) + (b blue) + (max (max r g b)) + (min (min r g b)) + (delta (- max min)) + (l (/ (+ max min) 2.0))) + (list + (if (= max min) + 0 + (* 2 float-pi + (/ (cond ((= max r) + (+ (/ (- g b) delta) (if (< g b) 6 0))) + ((= max g) + (+ (/ (- b r) delta) 2)) + (t + (+ (/ (- r g) delta) 4))) + 6))) + (if (= max min) + 0 + (if (> l 0.5) + (/ delta (- 2 (+ max min))) + (/ delta (+ max min)))) + l))) + +(defun color-srgb->xyz (red green blue) + "Converts RED GREEN BLUE colors from the sRGB color space to CIE XYZ. +RED, BLUE and GREEN must be between 0 and 1 inclusively." + (let ((r (if (<= red 0.04045) + (/ red 12.95) + (expt (/ (+ red 0.055) 1.055) 2.4))) + (g (if (<= green 0.04045) + (/ green 12.95) + (expt (/ (+ green 0.055) 1.055) 2.4))) + (b (if (<= blue 0.04045) + (/ blue 12.95) + (expt (/ (+ blue 0.055) 1.055) 2.4)))) + (list (+ (* 0.4124564 r) (* 0.3575761 g) (* 0.1804375 b)) + (+ (* 0.21266729 r) (* 0.7151522 g) (* 0.0721750 b)) + (+ (* 0.0193339 r) (* 0.1191920 g) (* 0.9503041 b))))) + +(defun color-xyz->srgb (X Y Z) + "Converts CIE X Y Z colors to sRGB color space." + (let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z))) + (g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z))) + (b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z)))) + (list (if (<= r 0.0031308) + (* 12.92 r) + (- (* 1.055 (expt r (/ 1 2.4))) 0.055)) + (if (<= g 0.0031308) + (* 12.92 g) + (- (* 1.055 (expt g (/ 1 2.4))) 0.055)) + (if (<= b 0.0031308) + (* 12.92 b) + (- (* 1.055 (expt b (/ 1 2.4))) 0.055))))) + +(defconst color-d65-xyz '(0.950455 1.0 1.088753) + "D65 white point in CIE XYZ.") + +(defconst color-cie-ε (/ 216 24389.0)) +(defconst color-cie-κ (/ 24389 27.0)) + +(defun color-xyz->lab (X Y Z &optional white-point) + "Converts CIE XYZ to CIE L*a*b*. +WHITE-POINT can be specified as (X Y Z) white point to use. If +none is set, `color-d65-xyz' is used." + (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) + (let* ((xr (/ X Xr)) + (yr (/ Y Yr)) + (zr (/ Z Zr)) + (fx (if (> xr color-cie-ε) + (expt xr (/ 1 3.0)) + (/ (+ (* color-cie-κ xr) 16) 116.0))) + (fy (if (> yr color-cie-ε) + (expt yr (/ 1 3.0)) + (/ (+ (* color-cie-κ yr) 16) 116.0))) + (fz (if (> zr color-cie-ε) + (expt zr (/ 1 3.0)) + (/ (+ (* color-cie-κ zr) 16) 116.0)))) + (list + (- (* 116 fy) 16) ; L + (* 500 (- fx fy)) ; a + (* 200 (- fy fz)))))) ; b + +(defun color-lab->xyz (L a b &optional white-point) + "Converts CIE L*a*b* to CIE XYZ. +WHITE-POINT can be specified as (X Y Z) white point to use. If +none is set, `color-d65-xyz' is used." + (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) + (let* ((fy (/ (+ L 16) 116.0)) + (fz (- fy (/ b 200.0))) + (fx (+ (/ a 500.0) fy)) + (xr (if (> (expt fx 3.0) color-cie-ε) + (expt fx 3.0) + (/ (- (* fx 116) 16) color-cie-κ))) + (yr (if (> L (* color-cie-κ color-cie-ε)) + (expt (/ (+ L 16) 116.0) 3.0) + (/ L color-cie-κ))) + (zr (if (> (expt fz 3) color-cie-ε) + (expt fz 3.0) + (/ (- (* 116 fz) 16) color-cie-κ)))) + (list (* xr Xr) ; X + (* yr Yr) ; Y + (* zr Zr))))) ; Z + +(defun color-srgb->lab (red green blue) + "Converts RGB to CIE L*a*b*." + (apply 'color-xyz->lab (color-srgb->xyz red green blue))) + +(defun color-rgb->normalize (color) + "Normalize a RGB color to values between 0 and 1 inclusively." + (mapcar (lambda (x) (/ x 65535.0)) (x-color-values color))) + +(defun color-lab->srgb (L a b) + "Converts CIE L*a*b* to RGB." + (apply 'color-xyz->srgb (color-lab->xyz L a b))) + +(defun color-cie-de2000 (color1 color2 &optional kL kC kH) + "Computes the CIEDE2000 color distance between COLOR1 and COLOR2. +Colors must be in CIE L*a*b* format." + (destructuring-bind (Lâ‚ aâ‚ bâ‚) color1 + (destructuring-bind (Lâ‚‚ aâ‚‚ bâ‚‚) color2 + (let* ((kL (or kL 1)) + (kC (or kC 1)) + (kH (or kH 1)) + (Câ‚ (sqrt (+ (expt aâ‚ 2.0) (expt bâ‚ 2.0)))) + (Câ‚‚ (sqrt (+ (expt aâ‚‚ 2.0) (expt bâ‚‚ 2.0)))) + (CÌ„ (/ (+ Câ‚ Câ‚‚) 2.0)) + (G (* 0.5 (- 1 (sqrt (/ (expt CÌ„ 7.0) (+ (expt CÌ„ 7.0) (expt 25 7.0))))))) + (a′₠(* (+ 1 G) aâ‚)) + (a′₂ (* (+ 1 G) aâ‚‚)) + (C′₠(sqrt (+ (expt a′₠2.0) (expt bâ‚ 2.0)))) + (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt bâ‚‚ 2.0)))) + (h′₠(if (and (= bâ‚ 0) (= a′₠0)) + 0 + (let ((v (atan bâ‚ a′â‚))) + (if (< v 0) + (+ v (* 2 float-pi)) + v)))) + (h′₂ (if (and (= bâ‚‚ 0) (= a′₂ 0)) + 0 + (let ((v (atan bâ‚‚ a′₂))) + (if (< v 0) + (+ v (* 2 float-pi)) + v)))) + (ΔL′ (- Lâ‚‚ Lâ‚)) + (ΔC′ (- C′₂ C′â‚)) + (Δh′ (cond ((= (* C′₠C′₂) 0) + 0) + ((<= (abs (- h′₂ h′â‚)) float-pi) + (- h′₂ h′â‚)) + ((> (- h′₂ h′â‚) float-pi) + (- (- h′₂ h′â‚) (* 2 float-pi))) + ((< (- h′₂ h′â‚) (- float-pi)) + (+ (- h′₂ h′â‚) (* 2 float-pi))))) + (ΔH′ (* 2 (sqrt (* C′₠C′₂)) (sin (/ Δh′ 2.0)))) + (L̄′ (/ (+ Lâ‚ Lâ‚‚) 2.0)) + (C̄′ (/ (+ C′₠C′₂) 2.0)) + (h̄′ (cond ((= (* C′₠C′₂) 0) + (+ h′₠h′₂)) + ((<= (abs (- h′₠h′₂)) float-pi) + (/ (+ h′₠h′₂) 2.0)) + ((< (+ h′₠h′₂) (* 2 float-pi)) + (/ (+ h′₠h′₂ (* 2 float-pi)) 2.0)) + ((>= (+ h′₠h′₂) (* 2 float-pi)) + (/ (+ h′₠h′₂ (* -2 float-pi)) 2.0)))) + (T (+ 1 + (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30))))) + (* 0.24 (cos (* h̄′ 2))) + (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6)))) + (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63))))))) + (Δθ (* (degrees-to-radians 30) (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25)) 2.0))))) + (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0)))))) + (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0)))))) + (Sc (+ 1 (* C̄′ 0.045))) + (Sh (+ 1 (* 0.015 C̄′ T))) + (Rt (- (* (sin (* Δθ 2)) Rc)))) + (sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0) + (expt (/ ΔC′ (* Sc kC)) 2.0) + (expt (/ ΔH′ (* Sh kH)) 2.0) + (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH))))))))) + +(provide 'color) + +;;; color.el ends here diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el index 33d2ddd6a71..1f705674962 100644 --- a/lisp/gnus/ecomplete.el +++ b/lisp/gnus/ecomplete.el @@ -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)) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 04bdb3be626..8edfecde152 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -513,8 +513,8 @@ manipulated as follows: ;; Set up the menu. (when (gnus-visual-p 'agent-menu 'menu) (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer)))) - (unless (assq 'gnus-agent-mode minor-mode-alist) - (push gnus-agent-mode-status minor-mode-alist)) + (unless (assq mode minor-mode-alist) + (push (cons mode (cdr gnus-agent-mode-status)) minor-mode-alist)) (unless (assq mode minor-mode-map-alist) (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" buffer)))) @@ -695,7 +695,9 @@ minor mode in all Gnus buffers." ;; 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) @@ -801,12 +803,13 @@ be a select method." (setq group (or group gnus-newsgroup-name)) (unless group (error "No group on the current line")) - - (gnus-agent-while-plugged - (let ((gnus-command-method (gnus-find-method-for-group group))) - (gnus-agent-with-fetch - (gnus-agent-fetch-group-1 group gnus-command-method) - (gnus-message 5 "Fetching %s...done" group))))) + (if (not (gnus-agent-group-covered-p group)) + (message "%s isn't covered by the agent" group) + (gnus-agent-while-plugged + (let ((gnus-command-method (gnus-find-method-for-group group))) + (gnus-agent-with-fetch + (gnus-agent-fetch-group-1 group gnus-command-method) + (gnus-message 5 "Fetching %s...done" group)))))) (defun gnus-agent-add-group (category arg) "Add the current group to an agent category." diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 32411066da1..8d8aaa0e36e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -916,25 +916,25 @@ image type in XEmacs if it is built with the libcompface library." "Function used to decode addresses.") (defvar gnus-article-dumbquotes-map - '(("\200" "EUR") - ("\202" ",") - ("\203" "f") - ("\204" ",,") - ("\205" "...") - ("\213" "<") - ("\214" "OE") - ("\221" "`") - ("\222" "'") - ("\223" "``") - ("\224" "\"") - ("\225" "*") - ("\226" "-") - ("\227" "--") - ("\230" "~") - ("\231" "(TM)") - ("\233" ">") - ("\234" "oe") - ("\264" "'")) + '((?\200 "EUR") + (?\202 ",") + (?\203 "f") + (?\204 ",,") + (?\205 "...") + (?\213 "<") + (?\214 "OE") + (?\221 "`") + (?\222 "'") + (?\223 "``") + (?\224 "\"") + (?\225 "*") + (?\226 "-") + (?\227 "--") + (?\230 "~") + (?\231 "(TM)") + (?\233 ">") + (?\234 "oe") + (?\264 "'")) "Table for MS-to-Latin1 translation.") (defcustom gnus-ignored-mime-types nil @@ -1590,7 +1590,7 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(defcustom gnus-treat-fill-long-lines nil +(defcustom gnus-treat-fill-long-lines '(typep "text/plain") "Fill long lines. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." @@ -1621,9 +1621,6 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) -(defvar gnus-article-wash-function nil - "Function used for converting HTML into text.") - (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error)) (mm-coding-system-p 'utf-8) (executable-find idna-program)) @@ -1639,8 +1636,17 @@ This requires GNU Libidn, and by default only enabled if it is found." :group 'gnus-article :type 'boolean) -(defcustom gnus-blocked-images "." - "Images that have URLs matching this regexp will be blocked." +(defcustom gnus-inhibit-images nil + "Non-nil means inhibit displaying of images inline in the article body." + :version "24.1" + :group 'gnus-article + :type 'boolean) + +(defcustom gnus-blocked-images 'gnus-block-private-groups + "Images that have URLs matching this regexp will be blocked. +This can also be a function to be evaluated. If so, it will be +called with the group name as the parameter, and should return a +regexp." :version "24.1" :group 'gnus-art :type 'regexp) @@ -1664,7 +1670,7 @@ This requires GNU Libidn, and by default only enabled if it is found." (gnus-treat-highlight-signature gnus-article-highlight-signature) (gnus-treat-buttonize gnus-article-add-buttons) (gnus-treat-fill-article gnus-article-fill-cited-article) - (gnus-treat-fill-long-lines gnus-article-fill-long-lines) + (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines) (gnus-treat-strip-cr gnus-article-remove-cr) (gnus-treat-unsplit-urls gnus-article-unsplit-urls) (gnus-treat-date-ut gnus-article-date-ut) @@ -2114,6 +2120,35 @@ try this wash." (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 @@ -2138,9 +2173,18 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (when (article-goto-body) (let ((inhibit-read-only t)) (dolist (elem map) - (save-excursion - (while (search-forward (car elem) nil t) - (replace-match (cadr elem))))))))) + (let ((from (car elem)) + (to (cadr elem))) + (save-excursion + (if (stringp from) + (while (search-forward from nil t) + (replace-match to)) + (while (not (eobp)) + (if (eq (following-char) from) + (progn + (delete-char 1) + (insert to)) + (forward-char 1))))))))))) (defun article-treat-overstrike () "Translate overstrikes into bold text." @@ -2233,6 +2277,17 @@ unfolded." (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 @@ -2685,118 +2740,16 @@ If READ-CHARSET, ask for a coding system." (when (interactive-p) (gnus-treat-article nil)))) - -(defun article-wash-html (&optional read-charset) - "Format an HTML article. -If READ-CHARSET, ask for a coding system. If it is a number, the -charset defined in `gnus-summary-show-article-charset-alist' is used." - (interactive "P") - (save-excursion - (let ((inhibit-read-only t) - charset) - (if read-charset - (if (or (and (numberp read-charset) - (setq charset - (cdr - (assq read-charset - gnus-summary-show-article-charset-alist)))) - (setq charset (mm-read-coding-system "Charset: "))) - (let ((gnus-summary-show-article-charset-alist - (list (cons 1 charset)))) - (with-current-buffer gnus-summary-buffer - (gnus-summary-show-article 1))) - (error "No charset is given")) - (when (gnus-buffer-live-p gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct (mail-header-parse-content-type ct)))) - (setq charset (and ctl - (mail-content-type-get ctl 'charset))) - (when (stringp charset) - (setq charset (intern (downcase charset))))))) - (unless charset - (setq charset gnus-newsgroup-charset))) - (article-goto-body) - (save-window-excursion - (save-restriction - (narrow-to-region (point) (point-max)) - (let* ((func (or gnus-article-wash-function mm-text-html-renderer)) - (entry (assq func mm-text-html-washer-alist))) - (when entry - (setq func (cdr entry))) - (cond - ((functionp func) - (funcall func)) - (t - (apply (car func) (cdr func)))))))))) - -;; External. -(declare-function w3-region "ext:w3-display" (st nd)) - -(defun gnus-article-wash-html-with-w3 () - "Wash the current buffer with w3." - (mm-setup-w3) - (let ((w3-strict-width (window-width)) - (url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil)) - (condition-case () - (w3-region (point-min) (point-max)) - (error)))) - -;; External. -(declare-function w3m-region "ext:w3m" (start end &optional url charset)) - -(defun gnus-article-wash-html-with-w3m () - "Wash the current buffer with emacs-w3m." - (mm-setup-w3m) - (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) - w3m-force-redisplay) - (w3m-region (point-min) (point-max))) - ;; Put the mark meaning this part was rendered by emacs-w3m. - (put-text-property (point-min) (point-max) 'mm-inline-text-html-with-w3m t) - (when (and mm-inline-text-html-with-w3m-keymap - (boundp 'w3m-minor-mode-map) - w3m-minor-mode-map) - (if (and (boundp 'w3m-link-map) - w3m-link-map) - (let* ((start (point-min)) - (end (point-max)) - (on (get-text-property start 'w3m-href-anchor)) - (map (copy-keymap w3m-link-map)) - next) - (set-keymap-parent map w3m-minor-mode-map) - (while (< start end) - (if on - (progn - (setq next (or (text-property-any start end - 'w3m-href-anchor nil) - end)) - (put-text-property start next 'keymap map)) - (setq next (or (text-property-not-all start end - 'w3m-href-anchor nil) - end)) - (put-text-property start next 'keymap w3m-minor-mode-map)) - (setq start next - on (not on)))) - (put-text-property (point-min) (point-max) 'keymap w3m-minor-mode-map)))) - -(defvar charset) ;; Bound by `article-wash-html'. - -(defun gnus-article-wash-html-with-w3m-standalone () - "Wash the current buffer with w3m." - (if (mm-w3m-standalone-supports-m17n-p) - (progn - (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'. - ;; The default. - (setq charset 'iso-8859-1)) - (let ((coding-system-for-write charset) - (coding-system-for-read charset)) - (call-process-region - (point-min) (point-max) - "w3m" t t nil "-dump" "-T" "text/html" - "-I" (symbol-name charset) "-O" (symbol-name charset)))) - (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html"))) +(defun article-wash-html () + "Format an HTML article." + (interactive) + (let ((handles nil) + (buffer-read-only nil)) + (when (gnus-buffer-live-p gnus-original-article-buffer) + (setq handles (mm-dissect-buffer t t))) + (article-goto-body) + (delete-region (point) (point-max)) + (mm-inline-text-html handles))) (defvar gnus-article-browse-html-temp-list nil "List of temporary files created by `gnus-article-browse-html-parts'. @@ -4341,6 +4294,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-date-lapsed article-emphasize article-treat-dumbquotes + article-treat-non-ascii article-normalize-headers ;;(article-show-all . gnus-article-show-all-headers) ))) @@ -4393,7 +4347,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) (gnus-summary-make-menu-bar)) - (gnus-turn-off-edit-menu 'article) (unless (boundp 'gnus-article-article-menu) (easy-menu-define gnus-article-article-menu gnus-article-mode-map "" @@ -4905,11 +4858,17 @@ General format specifiers can also be used. See Info node (defun gnus-article-jump-to-part (n) "Jump to MIME part N." (interactive "P") - (pop-to-buffer gnus-article-buffer) - ;; FIXME: why is it necessary? - (sit-for 0) - (let ((parts (length gnus-article-mime-handle-alist))) - (or n (setq n (read-number (format "Jump to part (2..%s): " parts)))) + (let ((parts (with-current-buffer gnus-article-buffer + (length gnus-article-mime-handle-alist)))) + (when (zerop parts) + (error "No such part")) + (pop-to-buffer gnus-article-buffer) + ;; FIXME: why is it necessary? + (sit-for 0) + (or n + (setq n (if (= parts 1) + 1 + (read-number (format "Jump to part (1..%s): " parts))))) (unless (and (integerp n) (<= n parts) (>= n 1)) (setq n (progn @@ -5209,7 +5168,7 @@ are decompressed." (if (or coding-system (and charset (setq coding-system (mm-charset-to-coding-system charset)) - (not (eq charset 'ascii)))) + (not (eq coding-system 'ascii)))) (progn (mm-enable-multibyte) (insert (mm-decode-coding-string contents coding-system)) @@ -5384,9 +5343,7 @@ specified charset." (gnus-mime-view-part-as-type nil (lambda (type) (stringp (mailcap-mime-info type)))) (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (mm-display-part handle)))))) + (mm-display-part handle nil t))))) (defun gnus-mime-view-part-internally (&optional handle) "View the MIME part under point with an internal viewer. @@ -5405,9 +5362,7 @@ If no internal viewer is available, use an external viewer." (gnus-mime-view-part-as-type nil (lambda (type) (mm-inlinable-p handle type))) (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (gnus-bind-safe-url-regexp (mm-display-part handle))))))) + (gnus-bind-safe-url-regexp (mm-display-part handle)))))) (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at \(point\)." @@ -5470,6 +5425,10 @@ If INTERACTIVE, call FUNCTION interactivly." (when (gnus-article-goto-part n) ;; We point the cursor and the arrow at the MIME button ;; when the `function' prompt the user for something. + (unless (and (pos-visible-in-window-p) + (> (count-lines (point) (window-end)) + (/ (1- (window-height)) 3))) + (recenter (/ (1- (window-height)) 3))) (let ((cursor-in-non-selected-windows t) (overlay-arrow-string "=>") (overlay-arrow-position (point-marker))) @@ -5481,11 +5440,10 @@ If INTERACTIVE, call FUNCTION interactivly." (funcall function)) (interactive (call-interactively - function - (cdr (assq n gnus-article-mime-handle-alist)))) + function (get-text-property (point) 'gnus-data))) (t (funcall function - (cdr (assq n gnus-article-mime-handle-alist))))) + (get-text-property (point) 'gnus-data)))) (set-marker overlay-arrow-position nil) (unless gnus-auto-select-part (gnus-select-frame-set-input-focus frame) @@ -5650,7 +5608,41 @@ all parts." (defun gnus-article-goto-part (n) "Go to MIME part N." - (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) + (when gnus-break-pages + (widen)) + (prog1 + (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) + part handle end next handles) + (when start + (goto-char start) + (if (setq handle (get-text-property start 'gnus-data)) + start + ;; Go to the displayed subpart, assuming this is + ;; multipart/alternative. + (setq part start + end (point-at-eol)) + (while (and (not handle) + part + (< part end) + (setq next (text-property-not-all part end + 'gnus-data nil))) + (setq part next + handle (get-text-property part 'gnus-data)) + (push (cons handle part) handles) + (unless (mm-handle-displayed-p handle) + (setq handle nil + part (text-property-any part end 'gnus-data nil)))) + (unless handle + ;; No subpart is displayed, so we find preferred one. + (setq part + (cdr (assq (mm-preferred-alternative + (nreverse (mapcar 'car handles))) + handles)))) + (if part + (goto-char (1+ part)) + start)))) + (when gnus-break-pages + (gnus-narrow-to-page)))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name @@ -5759,7 +5751,7 @@ all parts." (save-restriction (article-goto-body) (narrow-to-region (point) (point-max)) - (gnus-treat-article nil 1 1) + (gnus-treat-article nil 1 1 "text/plain") (widen))) (unless ihandles ;; Highlight the headers. @@ -5859,7 +5851,12 @@ If displaying \"text/html\" is discouraged \(see (while ignored (when (string-match (pop ignored) type) (throw 'ignored nil))) - (if (and (setq not-attachment + (if (and (not (and (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-inhibit-images) + gnus-inhibit-images) + (string-match "\\`image/" type))) + (setq not-attachment (and (not (mm-inline-override-p handle)) (or (not (mm-handle-disposition handle)) (equal (car (mm-handle-disposition handle)) @@ -6047,7 +6044,7 @@ If displaying \"text/html\" is discouraged \(see (gnus-treat-article nil (length gnus-article-mime-handle-alist) (gnus-article-mime-total-parts) - (mm-handle-media-type handle)))))) + (mm-handle-media-type preferred)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend @@ -6888,6 +6885,18 @@ If given a prefix, show the hidden text instead." (point)) (set-buffer buf)))))) +(defun gnus-block-private-groups (group) + (if (gnus-news-group-p group) + ;; Block nothing in news groups. + nil + ;; Block everything anywhere else. + ".")) + +(defun gnus-blocked-images () + (if (functionp gnus-blocked-images) + (funcall gnus-blocked-images gnus-newsgroup-name) + gnus-blocked-images)) + ;;; ;;; Article editing ;;; @@ -8137,6 +8146,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-url-mailto (url) ;; Send mail to someone + (setq url (replace-regexp-in-string "\n" " " url)) (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) (let (to args subject func) @@ -8146,8 +8156,7 @@ url is put as the `gnus-button-url' overlay property on the button." (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) (concat "to=" (match-string 1 url) "&" (match-string 2 url)) - (concat "to=" url))) - t) + (concat "to=" url)))) subject (cdr-safe (assoc "subject" args))) (gnus-msg-mail) (while args @@ -8298,16 +8307,19 @@ For example: ;;; Treatment top-level handling. ;;; -(defun gnus-treat-article (condition &optional part-number total-parts type) - (let ((length (- (point-max) (point-min))) +(defvar gnus-inhibit-article-treatments nil) + +(defun gnus-treat-article (gnus-treat-condition + &optional part-number total-parts gnus-treat-type) + (let ((gnus-treat-length (- (point-max) (point-min))) (alist gnus-treatment-function-alist) (article-goto-body-goes-to-point-min-p t) (treated-type - (or (not type) + (or (not gnus-treat-type) (catch 'found (let ((list gnus-article-treat-types)) (while list - (when (string-match (pop list) type) + (when (string-match (pop list) gnus-treat-type) (throw 'found t))))))) (highlightp (gnus-visual-p 'article-highlight 'highlight)) val elem) @@ -8320,6 +8332,8 @@ For example: (symbol-value (car elem)))) (when (and (or (consp val) treated-type) + (or (not gnus-inhibit-article-treatments) + (eq gnus-treat-condition 'head)) (gnus-treat-predicate val) (or (not (get (car elem) 'highlight)) highlightp)) @@ -8329,16 +8343,16 @@ For example: ;; Dynamic variables. (defvar part-number) (defvar total-parts) -(defvar type) -(defvar condition) -(defvar length) +(defvar gnus-treat-type) +(defvar gnus-treat-condition) +(defvar gnus-treat-length) (defun gnus-treat-predicate (val) (cond ((null val) nil) - (condition - (eq condition val)) + (gnus-treat-condition + (eq gnus-treat-condition val)) ((and (listp val) (stringp (car val))) (apply 'gnus-or (mapcar `(lambda (s) @@ -8354,7 +8368,7 @@ For example: ((eq pred 'not) (not (gnus-treat-predicate (car val)))) ((eq pred 'typep) - (equal (car val) type)) + (equal (car val) gnus-treat-type)) (t (error "%S is not a valid predicate" pred))))) ((eq val t) @@ -8366,7 +8380,7 @@ For example: ((eq val 'last) (eq part-number total-parts)) ((numberp val) - (< length val)) + (< gnus-treat-length val)) (t (error "%S is not a valid value" val)))) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 423750893d8..1fcbf352f14 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -1,6 +1,7 @@ ;;; gnus-bookmark.el --- Bookmarks in Gnus -;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Keywords: news @@ -538,7 +539,7 @@ Optional argument SHOW means show them unconditionally." (let ((bmrk (gnus-bookmark-bmenu-bookmark))) (setq gnus-bookmark-bmenu-hidden-bookmarks (cons bmrk gnus-bookmark-bmenu-hidden-bookmarks)) - (let ((start (save-excursion (end-of-line) (point)))) + (let ((start (point-at-eol))) (move-to-column gnus-bookmark-bmenu-file-column t) ;; Strip off `mouse-face' from the white spaces region. (if (gnus-bookmark-mouse-available-p) @@ -572,10 +573,9 @@ Optional argument SHOW means show them unconditionally." "Kill from point to end of line. If optional arg NEWLINE-TOO is non-nil, delete the newline too. Does not affect the kill ring." - (let ((eol (save-excursion (end-of-line) (point)))) - (delete-region (point) eol) - (if (and newline-too (looking-at "\n")) - (delete-char 1)))) + (delete-region (point) (point-at-eol)) + (if (and newline-too (looking-at "\n")) + (delete-char 1))) (defun gnus-bookmark-get-details (bmk-name details-list) "Get details for a Gnus BMK-NAME depending on DETAILS-LIST." diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 822996069cc..50ab1c64a23 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -383,9 +383,14 @@ Returns the list of articles removed." "Insert all the articles cached for this group into the current buffer." (interactive) (let ((gnus-verbose (max 6 gnus-verbose))) - (if (not gnus-newsgroup-cached) - (gnus-message 3 "No cached articles for this group") - (gnus-summary-goto-subjects gnus-newsgroup-cached)))) + (cond + ((not gnus-newsgroup-cached) + (gnus-message 3 "No cached articles for this group")) + ;; This is faster if there are few articles to insert. + ((< (length gnus-newsgroup-cached) 20) + (gnus-summary-goto-subjects gnus-newsgroup-cached)) + (t + (gnus-summary-include-articles gnus-newsgroup-cached))))) (defun gnus-summary-limit-include-cached () "Limit the summary buffer to articles that are cached." diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 7419cedac5f..aa719076e36 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -516,10 +516,15 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (setq m (cdr m)))) marks)))) -(defun gnus-article-fill-cited-article (&optional force width) +(defun gnus-article-fill-cited-long-lines () + (gnus-article-fill-cited-article nil t)) + +(defun gnus-article-fill-cited-article (&optional width long-lines) "Do word wrapping in the current article. -If WIDTH (the numerical prefix), use that text width when filling." - (interactive (list t current-prefix-arg)) +If WIDTH (the numerical prefix), use that text width when +filling. If LONG-LINES, only fill sections that have lines +longer than the frame width." + (interactive "P") (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) @@ -535,8 +540,24 @@ If WIDTH (the numerical prefix), use that text width when filling." (fill-prefix (if (string= (cdar marks) "") "" (concat (cdar marks) " "))) + (do-fill (not long-lines)) use-hard-newlines) - (fill-region (point-min) (point-max))) + (unless do-fill + (setq do-fill (gnus-article-foldable-buffer (cdar marks)))) + ;; Note: the XEmacs version of `fill-region' inserts a newline + ;; unless the region ends with a newline. + (when do-fill + (if (not long-lines) + (fill-region (point-min) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (when (prog1 + (> (current-column) (window-width)) + (forward-line 1)) + (save-restriction + (narrow-to-region (line-beginning-position 0) (point)) + (fill-region (point-min) (point-max)))))))) (set-marker (caar marks) nil) (setq marks (cdr marks))) (when marks @@ -548,23 +569,28 @@ If WIDTH (the numerical prefix), use that text width when filling." gnus-cite-loose-attribution-alist nil gnus-cite-article nil))))) -(defun gnus-article-natural-long-line-p () - "Return true if the current line is long, and it's natural text." - (save-excursion - (beginning-of-line) - (and - ;; The line is long. - (> (- (line-end-position) (line-beginning-position)) - (frame-width)) - ;; It doesn't start with spaces. - (not (looking-at " ")) - ;; Not cited text. - (let ((line-number (1+ (count-lines (point-min) (point)))) - citep) - (dolist (elem gnus-cite-prefix-alist) - (when (member line-number (cdr elem)) - (setq citep t))) - (not citep))))) +(defun gnus-article-foldable-buffer (prefix) + (let ((do-fill nil) + columns) + (goto-char (point-min)) + (while (not (eobp)) + (unless (> (length prefix) (- (point-max) (point))) + (forward-char (length prefix))) + (skip-chars-forward " \t") + (unless (eolp) + (let ((elem (assq (current-column) columns))) + (unless elem + (setq elem (cons (current-column) 0)) + (push elem columns)) + (setcdr elem (1+ (cdr elem))))) + (end-of-line) + (when (> (current-column) (window-width)) + (setq do-fill t)) + (forward-line 1)) + (and do-fill + ;; We know know that there are long lines here, but does this look + ;; like code? Check for ragged edges on the left. + (< (length columns) 3)))) (defun gnus-article-hide-citation (&optional arg force) "Toggle hiding of all cited text except attribution lines. diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 05bbaf53465..a257e5495a7 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -133,8 +133,7 @@ DELAY is a string, giving the length of the time. Possible values are: (message-add-header (format "%s: %s" gnus-delay-header deadline))) (set-buffer-modified-p t) ;; If group does not exist, create it. - (let ((group (format "nndraft:%s" gnus-delay-group))) - (gnus-agent-queue-setup gnus-delay-group)) + (gnus-agent-queue-setup gnus-delay-group) (message-disassociate-draft) (nndraft-request-associate-buffer gnus-delay-group) (save-buffer 0) diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 9f992d567d7..ad40117b446 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -32,9 +32,6 @@ (require 'nnheader) (require 'nntp) (require 'nnmail) -(require 'gnus-util) - -(autoload 'parse-time-string "parse-time" nil nil) (defgroup gnus-demon nil "Demonic behavior." @@ -46,14 +43,16 @@ Each handler is a list on the form \(FUNCTION TIME IDLE) -FUNCTION is the function to be called. -TIME is the number of `gnus-demon-timestep's between each call. -If nil, never call. If t, call each `gnus-demon-timestep'. -If IDLE is t, only call if Emacs has been idle for a while. If IDLE -is a number, only call when Emacs has been idle more than this number -of `gnus-demon-timestep's. If IDLE is nil, don't care about -idleness. If IDLE is a number and TIME is nil, then call once each -time Emacs has been idle for IDLE `gnus-demon-timestep's." +FUNCTION is the function to be called. TIME is the number of +`gnus-demon-timestep's between each call. +If nil, never call. If t, call each `gnus-demon-timestep'. + +If IDLE is t, only call each time Emacs has been idle for TIME. +If IDLE is a number, only call when Emacs has been idle more than +this number of `gnus-demon-timestep's. +If IDLE is nil, don't care about idleness. +If IDLE is a number and TIME is nil, then call once each time +Emacs has been idle for IDLE `gnus-demon-timestep's." :group 'gnus-demon :type '(repeat (list function (choice :tag "Time" @@ -66,19 +65,16 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (integer :tag "steps" 1))))) (defcustom gnus-demon-timestep 60 - "*Number of seconds in each demon timestep." + "Number of seconds in each demon timestep." :group 'gnus-demon :type 'integer) ;;; Internal variables. -(defvar gnus-demon-timer nil) -(defvar gnus-demon-idle-has-been-called nil) -(defvar gnus-demon-idle-time 0) -(defvar gnus-demon-handler-state nil) -(defvar gnus-demon-last-keys nil) +(defvar gnus-demon-timers nil + "List of idle timers which are running.") (defvar gnus-inhibit-demon nil - "*If non-nil, no daemonic function will be run.") + "If non-nil, no daemonic function will be run.") ;;; Functions. @@ -96,149 +92,67 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (unless no-init (gnus-demon-init))) +(defun gnus-demon-idle-since () + "Return the number of seconds since when Emacs is idle." + (if (featurep 'xemacs) + (itimer-time-difference (current-time) last-command-event-time) + (float-time (or (current-idle-time) + '(0 0 0))))) + +(defun gnus-demon-run-callback (func &optional idle) + "Run FUNC if Emacs has been idle for longer than IDLE seconds." + (unless gnus-inhibit-demon + (when (or (not idle) + (<= idle (gnus-demon-idle-since))) + (with-local-quit + (ignore-errors + (funcall func)))))) + (defun gnus-demon-init () "Initialize the Gnus daemon." (interactive) (gnus-demon-cancel) - (when gnus-demon-handlers + (dolist (handler gnus-demon-handlers) ;; Set up the timer. - (setq gnus-demon-timer - (run-at-time - gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) - ;; Reset control variables. - (setq gnus-demon-handler-state - (mapcar - (lambda (handler) - (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) - (nth 2 handler))) - gnus-demon-handlers)) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil))) + (let* ((func (nth 0 handler)) + (time (nth 1 handler)) + (idle (nth 2 handler)) + ;; Compute time according with timestep. + ;; If t, replace by 1 + (time (cond ((eq time t) + gnus-demon-timestep) + ((null time) nil) + (t (* time gnus-demon-timestep)))) + (timer + (cond + ;; (func number t) + ;; Call when Emacs has been idle for `time' + ((and (numberp time) (eq idle t)) + (run-with-timer time time 'gnus-demon-run-callback func time)) + ;; (func number number) + ;; Call every `time' when Emacs has been idle for `idle' + ((and (numberp time) (numberp idle)) + (run-with-timer time time 'gnus-demon-run-callback func idle)) + ;; (func nil number) + ;; Only call when Emacs has been idle for `idle' + ((and (null time) (numberp idle)) + (run-with-idle-timer (* idle gnus-demon-timestep) t + 'gnus-demon-run-callback func)) + ;; (func number nil) + ;; Call every `time' + ((and (numberp time) (null idle)) + (run-with-timer t time 'gnus-demon-run-callback func))))) + (when timer + (add-to-list 'gnus-demon-timers timer))))) (gnus-add-shutdown 'gnus-demon-cancel 'gnus) (defun gnus-demon-cancel () "Cancel any Gnus daemons." (interactive) - (when gnus-demon-timer - (nnheader-cancel-timer gnus-demon-timer)) - (setq gnus-demon-timer nil - gnus-demon-idle-has-been-called nil) - (condition-case () - (nnheader-cancel-function-timers 'gnus-demon) - (error t))) - -(defun gnus-demon-is-idle-p () - "Whether Emacs is idle or not." - ;; We do this simply by comparing the 100 most recent keystrokes - ;; with the ones we had last time. If they are the same, one might - ;; guess that Emacs is indeed idle. This only makes sense if one - ;; calls this function seldom -- like once a minute, which is what - ;; we do here. - (let ((keys (recent-keys))) - (or (equal keys gnus-demon-last-keys) - (progn - (setq gnus-demon-last-keys keys) - nil)))) - -(defun gnus-demon-time-to-step (time) - "Find out how many seconds to TIME, which is on the form \"17:43\"." - (if (not (stringp time)) - time - (let* ((now (current-time)) - ;; obtain NOW as discrete components -- make a vector for speed - (nowParts (decode-time now)) - ;; obtain THEN as discrete components - (thenParts (parse-time-string time)) - (thenHour (elt thenParts 2)) - (thenMin (elt thenParts 1)) - ;; convert time as elements into number of seconds since EPOCH. - (then (encode-time 0 - thenMin - thenHour - ;; If THEN is earlier than NOW, make it - ;; same time tomorrow. Doc for encode-time - ;; says that this is OK. - (+ (elt nowParts 3) - (if (or (< thenHour (elt nowParts 2)) - (and (= thenHour (elt nowParts 2)) - (<= thenMin (elt nowParts 1)))) - 1 0)) - (elt nowParts 4) - (elt nowParts 5) - (elt nowParts 6) - (elt nowParts 7) - (elt nowParts 8))) - ;; calculate number of seconds between NOW and THEN - (diff (+ (* 65536 (- (car then) (car now))) - (- (cadr then) (cadr now))))) - ;; return number of timesteps in the number of seconds - (round (/ diff gnus-demon-timestep))))) - -(defun gnus-demon () - "The Gnus daemon that takes care of running all Gnus handlers." - ;; Increase or reset the time Emacs has been idle. - (if (gnus-demon-is-idle-p) - (incf gnus-demon-idle-time) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil)) - ;; Disable all daemonic stuff if we're in the minibuffer - (when (and (not (window-minibuffer-p (selected-window))) - (not gnus-inhibit-demon)) - ;; Then we go through all the handler and call those that are - ;; sufficiently ripe. - (let ((handlers gnus-demon-handler-state) - (gnus-inhibit-demon t) - ;; Try to avoid dialog boxes, e.g. by Mailcrypt. - ;; Unfortunately, Emacs 20's `message-or-box...' doesn't - ;; obey `use-dialog-box'. - use-dialog-box (last-nonmenu-event 10) - handler time idle) - (while handlers - (setq handler (pop handlers)) - (cond - ((numberp (setq time (nth 1 handler))) - ;; These handlers use a regular timeout mechanism. We decrease - ;; the timer if it hasn't reached zero yet. - (unless (zerop time) - (setcar (nthcdr 1 handler) (decf time))) - (and (zerop time) ; If the timer now is zero... - ;; Test for appropriate idleness - (progn - (setq idle (nth 2 handler)) - (cond - ((null idle) t) ; Don't care about idle. - ((numberp idle) ; Numerical idle... - (< idle gnus-demon-idle-time)) ; Idle timed out. - (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle. - ;; So we call the handler. - (gnus-with-local-quit - (ignore-errors (funcall (car handler))) - ;; And reset the timer. - (setcar (nthcdr 1 handler) - (gnus-demon-time-to-step - (nth 1 (assq (car handler) gnus-demon-handlers))))))) - ;; These are only supposed to be called when Emacs is idle. - ((null (setq idle (nth 2 handler))) - ;; We do nothing. - ) - ((and (not (numberp idle)) - (gnus-demon-is-idle-p)) - ;; We want to call this handler each and every time that - ;; Emacs is idle. - (gnus-with-local-quit - (ignore-errors (funcall (car handler))))) - (t - ;; We want to call this handler only if Emacs has been idle - ;; for a specified number of timesteps. - (and (not (memq (car handler) gnus-demon-idle-has-been-called)) - (< idle gnus-demon-idle-time) - (gnus-demon-is-idle-p) - (gnus-with-local-quit - (ignore-errors (funcall (car handler))) - ;; Make sure the handler won't be called once more in - ;; this idle-cycle. - (push (car handler) gnus-demon-idle-has-been-called))))))))) + (dolist (timer gnus-demon-timers) + (nnheader-cancel-timer timer)) + (setq gnus-demon-timers nil)) (defun gnus-demon-add-disconnection () "Add daemonic server disconnection to Gnus." diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 76d469b66f9..c2b95c7099b 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -368,7 +368,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." header ": "))) (setq value (if (listp (nth 1 head)) - (gnus-completing-read prompt (cons '("*" nil) (nth 1 head)) + (gnus-completing-read prompt (cons "*" (mapcar 'car (nth 1 head))) t value 'gnus-diary-header-value-history) (read-string prompt value diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index a12046f73b8..8b6d3911e11 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -1,7 +1,7 @@ ;;; gnus-dired.el --- utility functions where gnus and dired meet -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Authors: Benjamin Rutt <brutt@bloomington.in.us>, ;; Shenghuo Zhu <zsh@cs.rochester.edu> @@ -122,6 +122,8 @@ See `mail-user-agent' for more information." (push (buffer-name buffer) buffers)))) (nreverse buffers)))) +(autoload 'gnus-completing-read "gnus-util") + ;; Method to attach files to a mail composition. (defun gnus-dired-attach (files-to-attach) "Attach dired's marked files to a gnus message composition. diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index d53873045fd..e397a701da8 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -310,6 +310,8 @@ Obeys the standard process/prefix convention." (while buffs (set-buffer (setq buff (pop buffs))) (if (and buffer-file-name + (equal (file-remote-p file) + (file-remote-p buffer-file-name)) (string-equal (file-truename buffer-file-name) (file-truename file)) (buffer-modified-p)) diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index e1e37eb37c2..d7d90767124 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el @@ -162,102 +162,6 @@ (autoload 'gnus-alive-p "gnus-util") (autoload 'mm-disable-multibyte "mm-util") -(defun gnus-x-splash () - "Show a splash screen using a pixmap in the current buffer." - (interactive) - (unless window-system - (error "`gnus-x-splash' requires running on the window system")) - (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p) - (interactive-p)) - "*gnus-x-splash*" - gnus-group-buffer))) - (let ((inhibit-read-only t) - (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) - pixmap fcw fch width height fringes sbars left yoffset top ls) - (erase-buffer) - (sit-for 0) ;; Necessary for measuring the window size correctly. - (when (and file - (ignore-errors - (let ((coding-system-for-read 'raw-text)) - (with-temp-buffer - (mm-disable-multibyte) - (insert-file-contents file) - (goto-char (point-min)) - (setq pixmap (read (current-buffer))))))) - (setq fcw (float (frame-char-width)) - fch (float (frame-char-height)) - width (/ (car pixmap) fcw) - height (/ (cadr pixmap) fch) - fringes (if (fboundp 'window-fringes) - (eval '(window-fringes)) - '(10 11 nil)) - sbars (frame-parameter nil 'vertical-scroll-bars)) - (cond ((eq sbars 'right) - (setq sbars - (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw)))) - (sbars - (setq sbars - (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw) - 0))) - (t - (setq sbars '(0 . 0)))) - (setq left (- (* (round (/ (1- (/ (+ (window-width) - (car sbars) (cdr sbars) - (/ (+ (or (car fringes) 0) - (or (cadr fringes) 0)) - fcw)) - width)) - 2)) - width) - (car sbars) - (/ (or (car fringes) 0) fcw)) - yoffset (cadr (window-edges)) - top (max 0 (- (* (max (if (and (boundp 'tool-bar-mode) - tool-bar-mode - (not (featurep 'gtk)) - (eq (frame-first-window) - (selected-window))) - 1 0) - (round (/ (1- (/ (+ (1- (window-height)) - (* 2 yoffset)) - height)) - 2))) - height) - yoffset)) - ls (/ (or line-spacing 0) fch) - height (max 0 (- height ls))) - (cond ((>= (- top ls) 1) - (insert - (propertize - " " - 'display `(space :width 0 :ascent 100)) - "\n" - (propertize - " " - 'display `(space :width 0 :height ,(- top ls 1) :ascent 100)) - "\n")) - ((> (- top ls) 0) - (insert - (propertize - " " - 'display `(space :width 0 :height ,(- top ls) :ascent 100)) - "\n"))) - (if (and (> width 0) (> left 0)) - (insert (propertize - " " - 'display `(space :width ,left :height ,height :ascent 0))) - (setq width (+ width left))) - (when (> width 0) - (insert (propertize - " " - 'display `(space :width ,width :height ,height :ascent 0) - 'face `(gnus-splash :stipple ,pixmap)))) - (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min))) - (redraw-frame (selected-frame)) - (sit-for 0)))) - ;;; Image functions. (defun gnus-image-type-available-p (type) @@ -277,7 +181,7 @@ (defun gnus-put-image (glyph &optional string category) (let ((point (point))) - (insert-image glyph (or string "*")) + (insert-image glyph (or string " ")) (put-text-property point (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point) diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 2444c9e7818..27f65c04094 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -26,13 +26,15 @@ (require 'gravatar) (require 'gnus-art) +(require 'mail-extr) ;; Because of binding `mail-extr-disable-voodoo'. (defgroup gnus-gravatar nil "Gnus Gravatar." :group 'gnus-visual) -(defcustom gnus-gravatar-size 32 - "How big should gravatars be displayed." +(defcustom gnus-gravatar-size nil + "How big should gravatars be displayed. +If nil, default to `gravatar-size'." :type 'integer :version "24.1" :group 'gnus-gravatar) @@ -51,31 +53,25 @@ (defun gnus-gravatar-transform-address (header category &optional force) (gnus-with-article-headers - (let ((addresses - (mail-header-parse-addresses - ;; mail-header-parse-addresses does not work (reliably) on - ;; decoded headers. - (or - (ignore-errors - (mail-encode-encoded-word-string - (or (mail-fetch-field header) ""))) - (mail-fetch-field header)))) - (gravatar-size gnus-gravatar-size) - name) + (let* ((mail-extr-disable-voodoo t) + (addresses (mail-extract-address-components + (or (mail-fetch-field header) "") t)) + (gravatar-size gnus-gravatar-size) + name) (dolist (address addresses) - (when (and (setq name (cdr address)) - (string-match "\\`\\*+ " name)) ;; (X-)Faces exist. - (setcdr address (setq name (substring name (match-end 0))))) + (when (and (setq name (car address)) + (string-match "\\` +" name)) + (setcar address (setq name (substring name (match-end 0))))) (when (or force (not (and gnus-gravatar-too-ugly (or (string-match gnus-gravatar-too-ugly - (car address)) + (cadr address)) (and name (string-match gnus-gravatar-too-ugly name)))))) (ignore-errors (gravatar-retrieve - (car address) + (cadr address) 'gnus-gravatar-insert (list header address category)))))))) @@ -88,14 +84,17 @@ Set image category to CATEGORY." (when (buffer-live-p (current-buffer)) (gnus-article-goto-header header) (mail-header-narrow-to-field) - (let ((real-name (cdr address)) - (mail-address (car address))) - (when (if real-name ; have a realname, go for it! - (and (search-forward real-name nil t) - (search-backward real-name nil t)) - (and (search-forward mail-address nil t) - (search-backward mail-address nil t))) - (goto-char (1- (point))) + (let ((real-name (car address)) + (mail-address (cadr address))) + (when (if real-name + (re-search-forward + (concat (gnus-replace-in-string + (regexp-quote real-name) "[\t ]+" "[\t\n ]+") + "\\|" + (regexp-quote mail-address)) + nil t) + (search-forward mail-address nil t)) + (goto-char (1- (match-beginning 0))) ;; If we're on the " quoting the name, go backward (when (looking-at "[\"<]") (goto-char (1- (point)))) @@ -104,8 +103,7 @@ Set image category to CATEGORY." ;; example we were fetching someaddress, and then we change to ;; another mail with the same someaddress. (unless (memq 'gnus-gravatar (text-properties-at (point))) - (let ((inhibit-read-only t) - (point (point))) + (let ((point (point))) (unless (featurep 'xemacs) (setq gravatar (append gravatar gnus-gravatar-properties))) (gnus-put-image gravatar nil category) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 0d047133cd0..5ece1457163 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -55,6 +55,8 @@ (autoload 'gnus-agent-total-fetched-for "gnus-agent") (autoload 'gnus-cache-total-fetched-for "gnus-cache") +(autoload 'gnus-group-make-nnir-group "nnir") + (defcustom gnus-no-groups-message "No Gnus is good news" "*Message displayed by Gnus when no groups are available." :group 'gnus-start @@ -117,10 +119,11 @@ If nil, only list groups that have unread articles." :type 'boolean) (defcustom gnus-group-default-list-level gnus-level-subscribed - "*Default listing level. + "Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil." :group 'gnus-group-listing - :type 'integer) + :type '(choice (integer :tag "Level") + (function :tag "Function returning level"))) (defcustom gnus-group-list-inactive-groups t "*If non-nil, inactive groups will be listed." @@ -653,6 +656,7 @@ simple manner.") "D" gnus-group-enter-directory "f" gnus-group-make-doc-group "w" gnus-group-make-web-group + "G" gnus-group-make-nnir-group "M" gnus-group-read-ephemeral-group "r" gnus-group-rename-group "R" gnus-group-make-rss-group @@ -737,7 +741,6 @@ simple manner.") "e" gnus-score-edit-all-score) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "C" gnus-group-fetch-control "d" gnus-group-describe-group "v" gnus-version) @@ -757,7 +760,6 @@ simple manner.") (symbol-value 'gnus-topic-mode))) (defun gnus-group-make-menu-bar () - (gnus-turn-off-edit-menu 'group) (unless (boundp 'gnus-group-reading-menu) (easy-menu-define @@ -804,10 +806,6 @@ simple manner.") ["Describe" gnus-group-describe-group :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil '(:help "Display description of the current group"))] - ["Fetch control message" gnus-group-fetch-control - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display the archived control message for the current group"))] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) ["Expire articles" gnus-group-expire-articles @@ -905,6 +903,7 @@ simple manner.") ["Add the help group" gnus-group-make-help-group t] ["Make a doc group..." gnus-group-make-doc-group t] ["Make a web group..." gnus-group-make-web-group t] + ["Make a search group..." gnus-group-make-nnir-group t] ["Make a virtual group..." gnus-group-make-empty-virtual t] ["Add a group to a virtual..." gnus-group-add-to-virtual t] ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] @@ -1086,8 +1085,7 @@ When FORCE, rebuild the tool bar." (when (and (not (featurep 'xemacs)) (boundp 'tool-bar-mode) tool-bar-mode - ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). - ;; Why? --rsteib + (display-graphic-p) (or (not gnus-group-tool-bar-map) force)) (let* ((load-path (gmm-image-load-path-for-library "gnus" @@ -1166,6 +1164,12 @@ The following commands are available: (mouse-set-point e) (gnus-group-read-group nil)) +(defun gnus-group-default-list-level () + "Return the real value for `gnus-group-default-list-level'." + (if (functionp gnus-group-default-list-level) + (funcall gnus-group-default-list-level) + gnus-group-default-list-level)) + ;; Look at LEVEL and find out what the level is really supposed to be. ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens ;; will depend on whether `gnus-group-use-permanent-levels' is used. @@ -1175,13 +1179,13 @@ The following commands are available: (or (setq gnus-group-use-permanent-levels (or level (if (numberp gnus-group-use-permanent-levels) gnus-group-use-permanent-levels - (or gnus-group-default-list-level + (or (gnus-group-default-list-level) gnus-level-subscribed)))) - gnus-group-default-list-level gnus-level-subscribed)) + (gnus-group-default-list-level) gnus-level-subscribed)) (number-or-nil level) (t - (or level gnus-group-default-list-level gnus-level-subscribed)))) + (or level (gnus-group-default-list-level) gnus-level-subscribed)))) (defun gnus-group-setup-buffer () (set-buffer (gnus-get-buffer-create gnus-group-buffer)) @@ -1227,7 +1231,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (prefix-numeric-value current-prefix-arg) (or (gnus-group-default-level nil t) - gnus-group-default-list-level + (gnus-group-default-list-level) gnus-level-subscribed)))) (unless level (setq level (car gnus-group-list-mode) @@ -1597,9 +1601,7 @@ if it is a string, only list groups matching REGEXP." (when (inline (gnus-visual-p 'group-highlight 'highlight)) (gnus-group-highlight-line gnus-tmp-group beg end)) (gnus-run-hooks 'gnus-group-update-hook) - (forward-line) - ;; Allow XEmacs to remove front-sticky text properties. - (gnus-group-remove-excess-properties))) + (forward-line))) (defun gnus-group-update-eval-form (group list) "Eval `car' of each element of LIST, and return the first that return t. @@ -1888,7 +1890,7 @@ If FIRST-TOO, the current line is also eligible as a target." (unless no-advance (gnus-group-next-group 1)) (decf n)) - (gnus-summary-position-point) + (gnus-group-position-point) n)) (defun gnus-group-unmark-group (n) @@ -2190,11 +2192,13 @@ if it is not a list." require-match initial-input (or hist 'gnus-group-history) def)) - (if (if (listp collection) - (member group (mapcar 'symbol-name collection)) - (symbol-value (intern-soft group collection))) - group - (mm-encode-coding-string group (gnus-group-name-charset nil group))))) + (unless (if (listp collection) + (member group (mapcar 'symbol-name collection)) + (symbol-value (intern-soft group collection))) + (setq group + (mm-encode-coding-string + group (gnus-group-name-charset nil group)))) + (gnus-replace-in-string group "\n" ""))) ;;;###autoload (defun gnus-fetch-group (group &optional articles) @@ -2263,7 +2267,7 @@ Return the name of the group if selection was successful." (list ;; (gnus-read-group "Group name: ") (gnus-group-completing-read) - (gnus-read-method "From method: "))) + (gnus-read-method "From method"))) ;; Transform the select method into a unique server. (when (stringp method) (setq method (gnus-server-to-method method))) @@ -2424,9 +2428,9 @@ the bug number, and browsing the URL must return mbox output." (while (re-search-forward "^To: " nil t) (end-of-line) (insert (format ", %s@%s" number - (replace-regexp-in-string - "/.*$" "" - (replace-regexp-in-string "^http://" "" mbox-url))))) + (gnus-replace-in-string + (gnus-replace-in-string mbox-url "^http://" "") + "/.*$" "")))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group "gnus-read-ephemeral-bug" @@ -2670,7 +2674,7 @@ server." (interactive (list (gnus-read-group "Group name: ") - (gnus-read-method "From method: "))) + (gnus-read-method "From method"))) (when (stringp method) (setq method (or (gnus-server-to-method method) method))) @@ -3677,7 +3681,7 @@ If given numerical prefix, toggle the N next groups." Killed newsgroups are subscribed. If SILENT, don't try to update the group line." (interactive (list (gnus-group-completing-read - nil (gnus-read-active-file-p)))) + nil nil (gnus-read-active-file-p)))) (let ((newsrc (gnus-group-entry group))) (cond ((string-match "^[ \t]*$" group) @@ -3979,7 +3983,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n - (point))) + (point-marker))) group method (gnus-inhibit-demon t) ;; Binding this variable will inhibit multiple fetchings @@ -4010,35 +4014,9 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (goto-char beg)) (when gnus-goto-next-group-when-activating (gnus-group-next-unread-group 1 t)) - (gnus-summary-position-point) + (gnus-group-position-point) ret)) -(defun gnus-group-fetch-control (group) - "Fetch the archived control messages for the current group. -If given a prefix argument, prompt for a group." - (interactive - (list (or (when current-prefix-arg - (gnus-group-completing-read)) - (gnus-group-group-name) - gnus-newsgroup-name))) - (unless group - (error "No group name given")) - (let ((name (gnus-group-real-name group)) - hierarchy) - (when (string-match "\\(^[^\\.]+\\)\\..*" name) - (setq hierarchy (match-string 1 name)) - (if gnus-group-fetch-control-use-browse-url - (browse-url (concat "ftp://ftp.isc.org/usenet/control/" - hierarchy "/" name ".gz")) - (let ((enable-local-variables nil)) - (gnus-group-read-ephemeral-group - group - `(nndoc ,group (nndoc-address - ,(find-file-noselect - (concat "/ftp@ftp.isc.org:/usenet/control/" - hierarchy "/" name ".gz"))) - (nndoc-article-type mbox)) t nil nil)))))) - (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) @@ -4208,8 +4186,14 @@ groups. With 2 C-u's, use most complete method possible to query the server for new groups, and subscribe the new groups as zombies." (interactive "p") - (gnus-find-new-newsgroups (or arg 1)) - (gnus-group-list-groups)) + (let ((new-groups (gnus-find-new-newsgroups (or arg 1))) + current-group) + (gnus-group-list-groups) + (setq current-group (gnus-group-group-name)) + (dolist (group new-groups) + (gnus-group-jump-to-group group)) + (when current-group + (gnus-group-jump-to-group current-group)))) (defun gnus-group-edit-global-kill (&optional article group) "Edit the global kill file. diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index c1472118cf8..63a14b204fb 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -29,9 +29,10 @@ ;;; Code: (eval-when-compile (require 'cl)) -(eval-when-compile (require 'mm-decode)) (require 'gnus-art) +(eval-when-compile (require 'mm-decode)) + (require 'mm-url) (require 'url) (require 'url-cache) @@ -168,7 +169,14 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." (defun gnus-html-wash-images () "Run through current buffer and replace img tags by images." - (let (tag parameters string start end images url) + (let (tag parameters string start end images url alt-text + inhibit-images blocked-images) + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + (setq inhibit-images gnus-inhibit-images + blocked-images (gnus-blocked-images))) + (setq inhibit-images gnus-inhibit-images + blocked-images (gnus-blocked-images))) (goto-char (point-min)) ;; Search for all the images first. (while (re-search-forward "<img_alt \\([^>]*\\)>" nil t) @@ -179,74 +187,91 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." (delete-region (match-beginning 0) (match-end 0))) (setq end (point)) (when (string-match "src=\"\\([^\"]+\\)" parameters) - (setq url (gnus-html-encode-url (match-string 1 parameters))) (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) - (if (string-match "^cid:\\(.*\\)" url) + (setq url (gnus-html-encode-url (match-string 1 parameters)) + alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" + parameters) + (xml-substitute-special (match-string 2 parameters)))) + (gnus-add-text-properties + start end + (list 'image-url url + 'image-displayer `(lambda (url start end) + (gnus-html-display-image url start end + ,alt-text)) + 'gnus-image (list url start end alt-text))) + (widget-convert-button + 'url-link start (point) + :help-echo alt-text + :keymap gnus-html-image-map + url) + (if (string-match "\\`cid:" url) ;; URLs with cid: have their content stashed in other ;; parts of the MIME structure, so just insert them ;; immediately. - (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)))) - (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-string-or string "*") 'cid) - (gnus-add-image 'cid image)))) + (let* ((handle (mm-get-content-id (substring url (match-end 0)))) + (image (when (and handle + (not inhibit-images)) + (gnus-create-image + (mm-with-part handle (buffer-string)) + nil t)))) + (if image + (progn + (gnus-put-image + (gnus-rescale-image + image (gnus-html-maximum-image-size)) + (gnus-string-or (prog1 + (buffer-substring start end) + (delete-region start end)) + "*") + 'cid) + (gnus-add-image 'cid image)) + (widget-convert-button + 'link start end + :action 'gnus-html-insert-image + :help-echo url + :keymap gnus-html-image-map + :button-keymap gnus-html-image-map))) ;; 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) - (if (gnus-html-image-url-blocked-p - url - (if (buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-blocked-images) - gnus-blocked-images)) - (progn - (widget-convert-button - 'link start end - :action 'gnus-html-insert-image - :help-echo url - :keymap gnus-html-image-map - :button-keymap gnus-html-image-map) - (let ((overlay (gnus-make-overlay start end)) - (spec (list url start end alt-text))) - (gnus-overlay-put overlay 'local-map gnus-html-image-map) - (gnus-overlay-put overlay 'gnus-image spec) - (gnus-put-text-property - start end - 'gnus-image spec))) - ;; Non-blocked url - (let ((width - (when (string-match "width=\"?\\([0-9]+\\)" parameters) - (string-to-number (match-string 1 parameters)))) - (height - (when (string-match "height=\"?\\([0-9]+\\)" parameters) - (string-to-number (match-string 1 parameters))))) - ;; Don't fetch images that are really small. They're - ;; probably tracking pictures. - (when (and (or (null height) - (> height 4)) - (or (null width) - (> width 4))) - (gnus-html-display-image url start end alt-text)))))))))) - -(defun gnus-html-display-image (url start end alt-text) + (if (or inhibit-images + (gnus-html-image-url-blocked-p url blocked-images)) + (widget-convert-button + 'link start end + :action 'gnus-html-insert-image + :help-echo url + :keymap gnus-html-image-map + :button-keymap gnus-html-image-map) + ;; Non-blocked url + (let ((width + (when (string-match "width=\"?\\([0-9]+\\)" parameters) + (string-to-number (match-string 1 parameters)))) + (height + (when (string-match "height=\"?\\([0-9]+\\)" parameters) + (string-to-number (match-string 1 parameters))))) + ;; Don't fetch images that are really small. They're + ;; probably tracking pictures. + (when (and (or (null height) + (> height 4)) + (or (null width) + (> width 4))) + (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) - ;; We don't have it, so schedule it for fetching - ;; asynchronously. - (gnus-html-schedule-image-fetching - (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))) + (or alt-text (setq alt-text "*")) + (if (string-match "\\`cid:" url) + (let ((handle (mm-get-content-id (substring url (match-end 0))))) + (when handle + (gnus-html-put-image (mm-with-part handle (buffer-string)) + url alt-text))) + (if (gnus-html-cache-expired url gnus-html-image-cache-ttl) + ;; We don't have it, so schedule it for fetching + ;; asynchronously. + (gnus-html-schedule-image-fetching + (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)))) (defun gnus-html-wash-tags () (let (tag parameters string start end images url) @@ -330,7 +355,7 @@ Use ALT-TEXT for the image string." (replace-match "" t t)) (mm-url-decode-entities))) -(defun gnus-html-insert-image () +(defun gnus-html-insert-image (&rest args) "Fetch and insert the image under point." (interactive) (apply 'gnus-html-display-image (get-text-property (point) 'gnus-image))) @@ -343,15 +368,19 @@ Use ALT-TEXT for the image string." (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." (interactive) (let ((url (get-text-property (point) 'gnus-string))) - (if (not url) - (message "No URL at point") - (browse-url url)))) + (cond + ((not url) + (message "No link under point")) + ((string-match "^mailto:" url) + (gnus-url-mailto url)) + (t + (browse-url url))))) (defun gnus-html-schedule-image-fetching (buffer image) "Retrieve IMAGE, and place it into BUFFER on arrival." @@ -410,9 +439,9 @@ Return a string with image data." "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 @@ -425,7 +454,8 @@ Return a string with image data." (save-excursion (goto-char start) (let ((alt-text (or alt-text - (buffer-substring-no-properties start end)))) + (buffer-substring-no-properties start end))) + (inhibit-read-only t)) (if (and image ;; Kludge to avoid displaying 30x30 gif images, which ;; seems to be a signal of a broken image. @@ -446,15 +476,16 @@ Return a string with image data." (let ((image (gnus-rescale-image image (gnus-html-maximum-image-size)))) (delete-region start end) (gnus-put-image image alt-text 'external) - (gnus-put-text-property start (point) 'help-echo alt-text) - (gnus-overlay-put - (gnus-make-overlay start (point)) 'local-map - gnus-html-displayed-image-map) + (widget-convert-button + 'url-link start (point) + :help-echo alt-text + :keymap gnus-html-displayed-image-map + url) (gnus-put-text-property start (point) '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 @@ -477,25 +508,19 @@ Return a string with image data." 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) - (let ((blocked-images (with-current-buffer summary - gnus-blocked-images))) + (let (inhibit-images blocked-images) + (with-current-buffer summary + (setq inhibit-images gnus-inhibit-images + blocked-images (gnus-blocked-images))) (save-match-data - (while (re-search-forward "<img[^>]+src=[\"']\\([^\"']+\\)" nil t) - (let ((url (gnus-html-encode-url (match-string 1)))) - (unless (gnus-html-image-url-blocked-p url blocked-images) + (while (re-search-forward "<img[^>]+src=[\"']\\(http[^\"']+\\)" nil t) + (let ((url (gnus-html-encode-url + (mm-url-decode-entities-string (match-string 1))))) + (unless (or inhibit-images + (gnus-html-image-url-blocked-p url blocked-images)) (when (gnus-html-cache-expired url gnus-html-image-cache-ttl) (gnus-html-schedule-image-fetching nil (list url)))))))))) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 19bcffe0049..43284540125 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -100,8 +100,6 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." ;; Stream is already opened. nil ;; Open NNTP server. - (unless gnus-nntp-service - (setq gnus-nntp-server nil)) (when confirm ;; Read server name with completion. (setq gnus-nntp-server @@ -261,20 +259,21 @@ If it is down, start it up (again)." (gnus-message 1 "Denied server %s" server) nil) ;; Open the server. - (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) + (let* ((open-server-function + (gnus-get-function gnus-command-method 'open-server)) (result - (condition-case err - (funcall open-server-function - (nth 1 gnus-command-method) - (nthcdr 2 gnus-command-method)) - (error - (gnus-message 1 "Unable to open server %s due to: %s" - server (error-message-string err)) - nil) - (quit - (gnus-message 1 "Quit trying to open server %s" server) - nil))) - open-offline) + (condition-case err + (funcall open-server-function + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method)) + (error + (gnus-message 1 "Unable to open server %s due to: %s" + server (error-message-string err)) + nil) + (quit + (gnus-message 1 "Quit trying to open server %s" server) + nil))) + open-offline) ;; If this hasn't been opened before, we add it to the list. (unless elem (setq elem (list gnus-command-method nil) @@ -504,11 +503,21 @@ If BUFFER, insert the article in that group." article (gnus-group-real-name group) (nth 1 gnus-command-method) buffer))) -(defun gnus-request-thread (id) - "Request the thread containing the article specified by Message-ID id." +(defun gnus-request-thread (header) + "Request the headers in the thread containing the article specified by HEADER." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) (funcall (gnus-get-function gnus-command-method 'request-thread) - id))) + header))) + +(defun gnus-warp-to-article () + "Warps from an article in a virtual group to the article in its +real group. Does nothing on a real group." + (interactive) + (let ((gnus-command-method + (gnus-find-method-for-group gnus-newsgroup-name))) + (when (gnus-check-backend-function + 'warp-to-article (car gnus-command-method)) + (funcall (gnus-get-function gnus-command-method 'warp-to-article))))) (defun gnus-request-head (article group) "Request the head of ARTICLE in GROUP." @@ -655,7 +664,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (result (funcall (gnus-get-function gnus-command-method 'request-move-article) article (gnus-group-real-name group) - (nth 1 gnus-command-method) accept-function last move-is-internal))) + (nth 1 gnus-command-method) accept-function + last move-is-internal))) (when (and result gnus-agent (gnus-agent-method-p gnus-command-method)) (gnus-agent-unfetch-articles group (list article))) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index a3c5112ee41..d77abfa1c61 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -55,7 +55,7 @@ method to use when posting." (sexp :tag "Methods" ,gnus-select-method))) (defcustom gnus-outgoing-message-group nil - "*All outgoing messages will be put in this group. + "All outgoing messages will be put in this group. If you want to store all your outgoing mail and articles in the group \"nnml:archive\", you set this variable to that value. This variable can also be a list of group names. @@ -70,6 +70,8 @@ of names)." (string :tag "Group") (repeat :tag "List of groups" (string :tag "Group")))) +(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1") + (defcustom gnus-mailing-list-groups nil "*If non-nil a regexp matching groups that are really mailing lists. This is useful when you're reading a mailing list that has been @@ -397,7 +399,6 @@ Thank you for your help in stamping out bugs. (message-mode-hook (copy-sequence message-mode-hook))) (setq mml-buffer-list nil) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) ;; message-newsreader and message-mailer were formerly set in ;; gnus-inews-add-send-actions, but this is too late when ;; message-generate-headers-first is used. --ansel @@ -826,7 +827,6 @@ header line with the old Message-ID." (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) message-send-actions) ;; Add Gcc header. - (gnus-inews-insert-archive-gcc) (gnus-inews-insert-gcc)))) @@ -1294,7 +1294,6 @@ composing a new message." (goto-char (point-max)) (insert mail-header-separator) ;; Add Gcc header. - (gnus-inews-insert-archive-gcc) (gnus-inews-insert-gcc) (goto-char (point-min)) (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move) @@ -1307,24 +1306,6 @@ See `gnus-summary-mail-forward' for ARG." (interactive "P") (gnus-summary-mail-forward arg t)) -(defvar gnus-nastygram-message - "The following article was inappropriately posted to %s.\n\n" - "Format string to insert in nastygrams. -The current group name will be inserted at \"%s\".") - -(defun gnus-summary-mail-nastygram (n) - "Send a nastygram to the author of the current article." - (interactive "P") - (when (or gnus-expert-user - (gnus-y-or-n-p - "Really send a nastygram to the author of the current article? ")) - (let ((group gnus-newsgroup-name)) - (gnus-summary-reply-with-original n) - (set-buffer gnus-message-buffer) - (message-goto-body) - (insert (format gnus-nastygram-message group)) - (message-send-and-exit)))) - (defun gnus-summary-mail-crosspost-complaint (n) "Send a complaint about crossposting to the current article(s)." (interactive "P") @@ -1580,7 +1561,6 @@ this is a reply." (gnus-setup-message 'compose-bounce (message-bounce) ;; Add Gcc header. - (gnus-inews-insert-archive-gcc) (gnus-inews-insert-gcc) ;; If there are references, we fetch the article we answered to. (when parent @@ -1628,7 +1608,7 @@ this is a reply." (unless (gnus-check-server method) (error "Can't open server %s" (if (stringp method) method (car method)))) - (unless (gnus-request-group group nil method) + (unless (gnus-request-group group t method) (gnus-request-create-group group method)) (setq mml-externalize-attachments (if (stringp gnus-gcc-externalize-attachments) @@ -1694,44 +1674,13 @@ this is a reply." (gnus-group-mark-article-read group (cdr group-art))) (kill-buffer (current-buffer))))))))) -(defun gnus-inews-insert-gcc () - "Insert Gcc headers based on `gnus-outgoing-message-group'." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let* ((group gnus-outgoing-message-group) - (gcc (cond - ((functionp group) - (funcall group)) - ((or (stringp group) (listp group)) - group)))) - (when gcc - (insert "Gcc: " - (if (stringp gcc) - (if (string-match " " gcc) - (concat "\"" gcc "\"") - gcc) - (mapconcat (lambda (group) - (if (string-match " " group) - (concat "\"" group "\"") - group)) - gcc " ")) - "\n")))))) - -(defun gnus-inews-insert-archive-gcc (&optional group) +(defun gnus-inews-insert-gcc (&optional group) "Insert the Gcc to say where the article is to be archived." - (setq group (cond (group - (gnus-group-decoded-name group)) - (gnus-newsgroup-name - (gnus-group-decoded-name gnus-newsgroup-name)) - (t - ""))) - (let* ((var gnus-message-archive-group) + (let* ((group (or group gnus-newsgroup-name)) + (group (when group (gnus-group-decoded-name group))) + (var (or gnus-outgoing-message-group gnus-message-archive-group)) (gcc-self-val - (and gnus-newsgroup-name - (not (equal gnus-newsgroup-name "")) - (gnus-group-find-parameter - gnus-newsgroup-name 'gcc-self))) + (and group (gnus-group-find-parameter group 'gcc-self))) result (groups (cond @@ -1891,7 +1840,11 @@ this is a reply." (setq v (cond ((stringp value) - value) + (if (and (stringp match) + (gnus-string-match-p "\\\\[&[:digit:]]" value) + (match-beginning 1)) + (gnus-match-substitute-replacement value nil nil group) + value)) ((or (symbolp value) (functionp value)) (cond ((functionp value) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 6c2233f9c40..79080f21b7a 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -551,8 +551,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." key gnus-registry-max-track-groups))) (dolist (group groups) - (push group found-full) - (setq found (append (list group) (delete group found))))) + (when (and group (gnus-registry-follow-group-p group)) + (push group found-full) + (setq found (append (list group) (delete group found)))))) (push key matches) (gnus-message ;; raise level of messaging if gnus-registry-track-extra @@ -580,8 +581,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." key gnus-registry-max-track-groups))) (dolist (group groups) - (push group found-full) - (setq found (append (list group) (delete group found))))) + (when (and group (gnus-registry-follow-group-p group)) + (push group found-full) + (setq found (append (list group) (delete group found)))))) (push key matches) (gnus-message ;; raise level of messaging if gnus-registry-track-extra diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index b532b740455..19fd5fe6636 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -34,6 +34,8 @@ (require 'gnus-int) (require 'gnus-range) +(autoload 'gnus-group-make-nnir-group "nnir") + (defcustom gnus-server-mode-hook nil "Hook run in `gnus-server-mode' buffers." :group 'gnus-server @@ -113,6 +115,7 @@ If nil, a faster, but more primitive, buffer is used instead." ["Kill" gnus-server-kill-server t] ["Yank" gnus-server-yank-server t] ["Copy" gnus-server-copy-server t] + ["Show" gnus-server-show-server t] ["Edit" gnus-server-edit-server t] ["Regenerate" gnus-server-regenerate-server t] ["Compact" gnus-server-compact-server t] @@ -150,6 +153,7 @@ If nil, a faster, but more primitive, buffer is used instead." "c" gnus-server-copy-server "a" gnus-server-add-server "e" gnus-server-edit-server + "S" gnus-server-show-server "s" gnus-server-scan-server "O" gnus-server-open-server @@ -165,6 +169,8 @@ If nil, a faster, but more primitive, buffer is used instead." "g" gnus-server-regenerate-server + "G" gnus-group-make-nnir-group + "z" gnus-server-compact-server "\C-c\C-i" gnus-info-find-node @@ -605,6 +611,18 @@ The following commands are available: (gnus-server-position-point)) 'edit-server))) +(defun gnus-server-show-server (server) + "Show the definition of the server on the current line." + (interactive (list (gnus-server-server-name))) + (unless server + (error "No server on current line")) + (let ((info (gnus-server-to-method server))) + (gnus-edit-form + info "Showing the server." + `(lambda (form) + (gnus-server-position-point)) + 'edit-server))) + (defun gnus-server-scan-server (server) "Request a scan from the current server." (interactive (list (gnus-server-server-name))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 26da22e478a..8663d67fd0a 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -775,14 +775,6 @@ prompt the user for the name of an NNTP server to use." (if gnus-agent (gnus-agentize)) - (when gnus-simple-splash - (setq gnus-simple-splash nil) - (cond - ((featurep 'xemacs) - (gnus-xmas-splash)) - (window-system - (gnus-x-splash)))) - (let ((level (and (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect @@ -1108,53 +1100,53 @@ for new groups, and subscribe the new groups as zombies." 'gnus-subscribe-zombies) t) (t gnus-check-new-newsgroups)))) - (unless (gnus-check-first-time-used) - (if (or (consp check) - (eq check 'ask-server)) - ;; Ask the server for new groups. - (gnus-ask-server-for-new-groups) - ;; Go through the active hashtb and look for new groups. - (let ((groups 0) - group new-newsgroups) - (gnus-message 5 "Looking for new newsgroups...") - (unless gnus-have-read-active-file - (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (message-make-date)) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go though every newsgroup in `gnus-active-hashtb' and compare - ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) - gnus-active-hashtb) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups)) - (if (> groups 0) - (gnus-message 5 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has")) - (gnus-message 5 "No new newsgroups."))))))) + (if (or (consp check) + (eq check 'ask-server)) + ;; Ask the server for new groups. + (gnus-ask-server-for-new-groups) + ;; Go through the active hashtb and look for new groups. + (let ((groups 0) + group new-newsgroups) + (gnus-message 5 "Looking for new newsgroups...") + (unless gnus-have-read-active-file + (gnus-read-active-file)) + (setq gnus-newsrc-last-checked-date (message-make-date)) + (unless gnus-killed-hashtb + (gnus-make-hashtable-from-killed)) + ;; Go though every newsgroup in `gnus-active-hashtb' and compare + ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. + (mapatoms + (lambda (sym) + (if (or (null (setq group (symbol-name sym))) + (not (boundp sym)) + (null (symbol-value sym)) + (gnus-gethash group gnus-killed-hashtb) + (gnus-gethash group gnus-newsrc-hashtb)) + () + (let ((do-sub (gnus-matches-options-n group))) + (cond + ((eq do-sub 'subscribe) + (setq groups (1+ groups)) + (gnus-sethash group group gnus-killed-hashtb) + (gnus-call-subscribe-functions + gnus-subscribe-options-newsgroup-method group)) + ((eq do-sub 'ignore) + nil) + (t + (setq groups (1+ groups)) + (gnus-sethash group group gnus-killed-hashtb) + (if gnus-subscribe-hierarchical-interactive + (push group new-newsgroups) + (gnus-call-subscribe-functions + gnus-subscribe-newsgroup-method group))))))) + gnus-active-hashtb) + (when new-newsgroups + (gnus-subscribe-hierarchical-interactive new-newsgroups)) + (if (> groups 0) + (gnus-message 5 "%d new newsgroup%s arrived." + groups (if (> groups 1) "s have" " has")) + (gnus-message 5 "No new newsgroups.")) + groups)))) (defun gnus-matches-options-n (group) ;; Returns `subscribe' if the group is to be unconditionally @@ -1252,54 +1244,7 @@ for new groups, and subscribe the new groups as zombies." (gnus-message 5 "No new newsgroups")) (when got-new (setq gnus-newsrc-last-checked-date new-date)) - got-new)) - -(defun gnus-check-first-time-used () - (catch 'ended - ;; First check if any of the following files exist. If they do, - ;; it's not the first time the user has used Gnus. - (dolist (file (list (concat gnus-current-startup-file ".el") - (concat gnus-current-startup-file ".eld") - (concat gnus-startup-file ".el") - (concat gnus-startup-file ".eld"))) - (when (file-exists-p file) - (throw 'ended nil))) - (gnus-message 6 "First time user; subscribing you to default groups") - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (setq gnus-newsrc-last-checked-date (message-make-date)) - ;; Subscribe to the default newsgroups. - (let ((groups (or gnus-default-subscribed-newsgroups - gnus-backup-default-subscribed-newsgroups)) - group) - (if (eq groups t) - ;; If t, we subscribe (or not) all groups as if they were new. - (mapatoms - (lambda (sym) - (when (setq group (symbol-name sym)) - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (push group gnus-killed-list)))))) - gnus-active-hashtb) - (dolist (group groups) - ;; Only subscribe the default groups that are activated. - (when (gnus-active group) - (gnus-group-change-level - group gnus-level-default-subscribed gnus-level-killed))) - (with-current-buffer gnus-group-buffer - ;; Don't error if the group already exists. This happens when a - ;; first-time user types 'F'. -- didier - (gnus-group-make-help-group t)) - (when gnus-novice-user - (gnus-message 7 "`A k' to list killed groups")))))) + new-newsgroups)) (defun gnus-subscribe-group (group &optional previous method) "Subscribe GROUP and put it after PREVIOUS." @@ -1757,16 +1702,20 @@ If SCAN, request a scan of that group as well." (destructuring-bind (method method-type infos dummy) elem (when (and method infos (not (gnus-method-denied-p method))) - (unless (gnus-server-opened method) - (gnus-open-server method)) - (when (and - (gnus-server-opened method) - (gnus-check-backend-function - 'retrieve-group-data-early (car method))) - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (setcar (nthcdr 3 elem) - (gnus-retrieve-group-data-early method infos)))))) + ;; If the open-server method doesn't exist, then the method + ;; itself doesn't exist, so we ignore it. + (if (not (ignore-errors (gnus-get-function method 'open-server))) + (setq type-cache (delq elem type-cache)) + (unless (gnus-server-opened method) + (gnus-open-server method)) + (when (and + (gnus-server-opened method) + (gnus-check-backend-function + 'retrieve-group-data-early (car method))) + (when (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan nil method)) + (setcar (nthcdr 3 elem) + (gnus-retrieve-group-data-early method infos))))))) ;; Do the rest of the retrieval. (dolist (elem type-cache) @@ -2037,7 +1986,9 @@ If SCAN, request a scan of that group as well." (while (setq method (pop methods)) ;; Only do each method once, in case the methods appear more ;; than once in this list. - (unless (member method methods) + (when (and (not (member method methods)) + ;; Check whether the backend exists. + (ignore-errors (gnus-get-function method 'open-server))) (if (or debug-on-error debug-on-quit) (gnus-read-active-file-1 method force) (condition-case () @@ -2090,7 +2041,7 @@ If SCAN, request a scan of that group as well." (gnus-message 5 "%s" mesg) (gnus-active-to-gnus-format method gnus-active-hashtb nil t) ;; We mark this active file as read. - (push method gnus-have-read-active-file) + (add-to-list 'gnus-have-read-active-file method) (gnus-message 5 "%sdone" mesg))))))) (defun gnus-read-active-file-2 (groups method) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 568e2976268..1bb4b4a6895 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -60,6 +60,8 @@ (autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t) (autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t) (autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t) +(autoload 'nnir-article-rsv "nnir" nil nil 'macro) +(autoload 'nnir-article-group "nnir" nil nil 'macro) (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -1361,6 +1363,16 @@ the normal Gnus MIME machinery." (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) (?L gnus-tmp-lines ?s) + (?Z (or ,(gnus-macroexpand-all + '(nnir-article-rsv (mail-header-number gnus-tmp-header))) + 0) ?d) + (?G (or ,(gnus-macroexpand-all + '(nnir-article-group (mail-header-number gnus-tmp-header))) + "") ?s) + (?g (or ,(gnus-macroexpand-all + '(gnus-group-short-name + (nnir-article-group (mail-header-number gnus-tmp-header)))) + "") ?s) (?O gnus-tmp-downloaded ?c) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) @@ -1581,6 +1593,8 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") gnus-newsgroup-prepared gnus-summary-highlight-line-function gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook + (gnus-summary-article-delete-hook . global) + (gnus-summary-article-move-hook . global) gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers gnus-thread-expunge-below @@ -1901,6 +1915,7 @@ increase the score of each group you read." "a" gnus-summary-post-news "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article + [tab] gnus-summary-widget-forward "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article @@ -2061,8 +2076,10 @@ increase the score of each group you read." "D" gnus-summary-enter-digest-group "R" gnus-summary-refer-references "T" gnus-summary-refer-thread + "W" gnus-warp-to-article "g" gnus-summary-show-article "s" gnus-summary-isearch-article + [tab] gnus-summary-widget-forward "P" gnus-summary-print-article "S" gnus-sticky-article "M" gnus-mailing-list-insinuate @@ -2095,6 +2112,7 @@ increase the score of each group you read." "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) @@ -2132,7 +2150,7 @@ increase the score of each group you read." "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 @@ -2169,8 +2187,7 @@ increase the score of each group you read." "v" gnus-version "d" gnus-summary-describe-group "h" gnus-summary-describe-briefly - "i" gnus-info-find-node - "C" gnus-group-fetch-control) + "i" gnus-info-find-node) (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) "e" gnus-summary-expire-articles @@ -2420,6 +2437,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) 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] @@ -2747,9 +2765,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Original sort" gnus-summary-sort-by-original t]) ("Help" ["Describe group" gnus-summary-describe-group t] - ["Fetch control message" gnus-group-fetch-control - ,@(if (featurep 'xemacs) nil - '(:help "Display the archived control message for the current group"))] ["Read manual" gnus-info-find-node t]) ("Modes" ["Pick and read" gnus-pick-mode t] @@ -4510,7 +4525,7 @@ the id of the parent article (if any)." (while (not (eobp)) (ignore-errors (setq article (read (current-buffer)) - header (gnus-nov-parse-line article dependencies))) + header (gnus-nov-parse-line article dependencies t))) (when header (with-current-buffer gnus-summary-buffer (push header gnus-newsgroup-headers) @@ -5472,7 +5487,7 @@ or a straight list of headers." (substring subject (match-end 1))))) (mail-header-set-subject header subject)))))) -(defun gnus-fetch-headers (articles) +(defun gnus-fetch-headers (articles &optional limit force-new dependencies) "Fetch headers of ARTICLES." (let ((name (gnus-group-decoded-name gnus-newsgroup-name))) (gnus-message 5 "Fetching headers for %s..." name) @@ -5481,16 +5496,17 @@ or a straight list of headers." (setq gnus-headers-retrieved-by (gnus-retrieve-headers articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers)))) + (or limit + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and + (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers))))) (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers)) + articles force-new dependencies gnus-newsgroup-name t) + (gnus-get-newsgroup-headers dependencies force-new)) (gnus-message 5 "Fetching headers for %s...done" name)))) (defun gnus-select-newsgroup (group &optional read-all select-articles) @@ -6190,7 +6206,13 @@ The resulting hash table is returned, or nil if no Xrefs were found." (info (nth 2 entry)) (active (gnus-active group)) range) - (when entry + (if (not entry) + ;; Group that Gnus doesn't know exists, but still allow the + ;; backend to set marks. + (gnus-request-set-mark + group (list (list (gnus-compress-sequence (sort articles #'<)) + 'add '(read)))) + ;; Normal, subscribed groups. (setq range (gnus-compute-read-articles group articles)) (with-current-buffer gnus-group-buffer (gnus-undo-register @@ -6942,7 +6964,9 @@ displayed, no centering will be performed." ;; Various summary commands (defun gnus-summary-select-article-buffer () - "Reconfigure windows to show the article buffer." + "Reconfigure windows to show the article buffer. +If `gnus-widen-article-buffer' is set, show only the article +buffer." (interactive) (if (not (gnus-buffer-live-p gnus-article-buffer)) (error "There is no article buffer for this summary buffer") @@ -7025,7 +7049,11 @@ The prefix argument ALL means to select all articles." (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." (interactive "P") - (gnus-summary-reselect-current-group all t)) + (let ((config gnus-current-window-configuration)) + (gnus-summary-reselect-current-group all t) + (gnus-configure-windows config) + (when (eq config 'article) + (gnus-summary-select-article)))) (defun gnus-summary-update-info (&optional non-destructive) (save-excursion @@ -7584,9 +7612,11 @@ be displayed." (null (get-buffer gnus-article-buffer)) (not (eq article (cdr gnus-article-current))) (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) + gnus-newsgroup-name)) + (not (get-buffer gnus-original-article-buffer)))) (and (not gnus-single-article-buffer) (or (null gnus-current-article) + (not (get-buffer gnus-original-article-buffer)) (not (eq gnus-current-article article)))) force) ;; The requested article is different from the current article. @@ -8290,10 +8320,6 @@ articles that are younger than AGE days." (gnus-summary-limit articles)) (gnus-summary-position-point)) -(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) -(make-obsolete - 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4") - (defun gnus-summary-limit-to-unread (&optional all) "Limit the summary buffer to articles that are not marked as read. If ALL is non-nil, limit strictly to unread articles." @@ -8384,10 +8410,6 @@ If UNREPLIED (the prefix), limit to unreplied articles." (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) -(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) -(make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exclude-marks "Emacs 20.4") - (defun gnus-summary-limit-exclude-marks (marks &optional reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are marked @@ -8443,7 +8465,11 @@ When called interactively, ID is the Message-ID of the current article." (interactive (list (mail-header-id (gnus-summary-article-header)))) (let ((articles (gnus-articles-in-thread - (gnus-id-to-thread (gnus-root-id id))))) + (gnus-id-to-thread (gnus-root-id id)))) + ;;we REALLY want the whole thread---this prevents cut-threads + ;;from removing the thread we want to include. + (gnus-fetch-old-headers nil) + (gnus-build-sparse-threads nil)) (prog1 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) (gnus-summary-limit-include-matching-articles @@ -8488,6 +8514,18 @@ fetched for this group." (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) (gnus-summary-position-point))) +(defun gnus-summary-include-articles (articles) + "Fetch the headers for ARTICLES and then display the summary lines." + (let ((gnus-inhibit-demon t) + (gnus-agent nil) + (gnus-read-all-available-headers t)) + (setq gnus-newsgroup-headers + (gnus-merge + 'list gnus-newsgroup-headers + (gnus-fetch-headers articles nil t) + 'gnus-article-sort-by-number)) + (gnus-summary-limit (append articles gnus-newsgroup-limit)))) + (defun gnus-summary-limit-exclude-dormant () "Hide all dormant articles." (interactive) @@ -8829,30 +8867,39 @@ fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil fetch what's specified by the `gnus-refer-thread-limit' variable." (interactive "P") + (gnus-warp-to-article) (let ((id (mail-header-id (gnus-summary-article-header))) + (gnus-inhibit-demon t) + (gnus-agent nil) + (gnus-summary-ignore-duplicates t) + (gnus-read-all-available-headers t) (limit (if limit (prefix-numeric-value limit) gnus-refer-thread-limit))) - (if (gnus-check-backend-function 'request-thread gnus-newsgroup-name) - (gnus-request-thread id) - (unless (eq gnus-fetch-old-headers 'invisible) - (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) - ;; Retrieve the headers and read them in. - (if (numberp limit) - (gnus-retrieve-headers - (list (min - (+ (mail-header-number - (gnus-summary-article-header)) - limit) - gnus-newsgroup-end)) - gnus-newsgroup-name (* limit 2)) - ;; gnus-refer-thread-limit is t, i.e. fetch _all_ - ;; headers. - (gnus-retrieve-headers (list gnus-newsgroup-end) - gnus-newsgroup-name limit) - (gnus-message 5 "Fetching headers for %s...done" - gnus-newsgroup-name)))) - (when (eq gnus-headers-retrieved-by 'nov) - (gnus-build-all-threads)) + (setq gnus-newsgroup-headers + (gnus-merge + 'list gnus-newsgroup-headers + (if (gnus-check-backend-function + 'request-thread gnus-newsgroup-name) + (gnus-request-thread (gnus-summary-article-header)) + (let* ((last (if (numberp limit) + (min (+ (mail-header-number + (gnus-summary-article-header)) + limit) + gnus-newsgroup-highest) + gnus-newsgroup-highest)) + (subject (gnus-simplify-subject + (mail-header-subject + (gnus-summary-article-header)))) + (refs (split-string (or (mail-header-references + (gnus-summary-article-header)) + ""))) + (gnus-parse-headers-hook + (lambda () (goto-char (point-min)) + (keep-lines + (regexp-opt (append refs (list id subject))))))) + (gnus-fetch-headers (list last) (if (numberp limit) + (* 2 limit) limit) t))) + 'gnus-article-sort-by-number)) (gnus-summary-limit-include-thread id))) (defun gnus-summary-refer-article (message-id) @@ -9049,6 +9096,15 @@ Obeys the standard process/prefix convention." (t (error "Couldn't select virtual nndoc group"))))) +(defun gnus-summary-widget-forward (arg) + "Move point to the next field or button in the article. +With optional ARG, move across that many fields." + (interactive "p") + (gnus-summary-select-article) + (gnus-configure-windows 'article) + (select-window (gnus-get-buffer-window gnus-article-buffer)) + (widget-forward arg)) + (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." @@ -9323,41 +9379,26 @@ to save in." (ps-despool filename)) (defun gnus-print-buffer () - (let ((buffer (generate-new-buffer " *print*"))) - (unwind-protect - (progn - (copy-to-buffer buffer (point-min) (point-max)) - (set-buffer buffer) - (gnus-remove-text-with-property 'gnus-decoration) - (when (gnus-visual-p 'article-highlight 'highlight) - ;; Copy-to-buffer doesn't copy overlay. So redo - ;; highlight. - (let ((gnus-article-buffer buffer)) - (gnus-article-highlight-citation t) - (gnus-article-highlight-signature) - (gnus-article-emphasize) - (gnus-article-delete-invisible-text))) - (let ((ps-left-header - (list - (concat "(" - (gnus-summary-print-truncate-and-quote - (mail-header-subject gnus-current-headers) - 66) ")") - (concat "(" - (gnus-summary-print-truncate-and-quote - (mail-header-from gnus-current-headers) - 45) ")"))) - (ps-right-header - (list - "/pagenumberstring load" - (concat "(" - (mail-header-date gnus-current-headers) ")")))) - (gnus-run-hooks 'gnus-ps-print-hook) - (save-excursion - (if ps-print-color-p - (ps-spool-buffer-with-faces) - (ps-spool-buffer))))) - (kill-buffer buffer)))) + (let ((ps-left-header + (list + (concat "(" + (gnus-summary-print-truncate-and-quote + (mail-header-subject gnus-current-headers) + 66) ")") + (concat "(" + (gnus-summary-print-truncate-and-quote + (mail-header-from gnus-current-headers) + 45) ")"))) + (ps-right-header + (list + "/pagenumberstring load" + (concat "(" + (mail-header-date gnus-current-headers) ")")))) + (gnus-run-hooks 'gnus-ps-print-hook) + (save-excursion + (if ps-print-color-p + (ps-spool-buffer-with-faces) + (ps-spool-buffer))))) (defun gnus-summary-show-complete-article () "Show a complete version of the current article. @@ -9386,9 +9427,10 @@ article currently." If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset input. -If ARG (the prefix) is non-nil and not a number, show the raw article -without any article massaging functions being run. Normally, the key -strokes are `C-u g'." +If ARG (the prefix) is non-nil and not a number, show the article, +but without running any of the article treatment functions +article. Normally, the keystroke is `C-u g'. When using `C-u +C-u g', show the raw article." (interactive "P") (cond ((numberp arg) @@ -9430,6 +9472,11 @@ strokes are `C-u g'." ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) + ((or (equal arg '(16)) + (eq arg t)) + ;; C-u C-u g + (let ((gnus-inhibit-article-treatments t)) + (gnus-summary-select-article nil 'force))) (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. @@ -9693,6 +9740,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." articles) (while articles (setq article (pop articles)) + ;; Set any marks that may have changed in the summary buffer. + (when gnus-preserve-marks + (gnus-summary-push-marks-to-backend article)) (setq art-group (cond @@ -9707,7 +9757,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (move-is-internal (gnus-server-equal from-method to-method))) (gnus-request-move-article article ; Article to move - gnus-newsgroup-name ; From newsgroup + gnus-newsgroup-name ; From newsgroup (nth 1 (gnus-find-method-for-group gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article @@ -9716,11 +9766,13 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (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? + ; Is this move internal? + (gnus-group-real-name to-newsgroup))))) ;; Copy the article. ((eq action 'copy) (with-current-buffer copy-buf - (when (gnus-request-article-this-buffer article gnus-newsgroup-name) + (when (gnus-request-article-this-buffer article + gnus-newsgroup-name) (save-restriction (nnheader-narrow-to-headers) (dolist (hdr gnus-copy-article-ignored-headers) @@ -9730,7 +9782,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (message-tokenize-header - (mail-header-xref (gnus-summary-article-header article)) + (mail-header-xref (gnus-summary-article-header + article)) " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) ":" (number-to-string article))) @@ -9747,7 +9800,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (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))) + to-newsgroup select-method (not articles) + t))) (setq new-xref (concat new-xref " " (car art-group) ":" (number-to-string (cdr art-group)))) @@ -9796,7 +9850,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (marks (if expirable gnus-article-mark-lists (delete '(expirable . expire) - (copy-sequence gnus-article-mark-lists)))) + (copy-sequence + gnus-article-mark-lists)))) (to-article (cdr art-group))) ;; Enter the article into the cache in the new group, @@ -9813,10 +9868,11 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (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) + (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)) + (setcdr gnus-newsgroup-active to-article)) (while marks (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) @@ -9827,7 +9883,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; 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))) + (set (intern (format "gnus-newsgroup-%s" + (caar marks))) (cons to-article (symbol-value (intern (format "gnus-newsgroup-%s" @@ -9875,7 +9932,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-newsgroup select-method)) - ;;;!!!Why is this necessary? + ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) (when (eq action 'move) @@ -9895,6 +9952,20 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-summary-position-point) (gnus-set-mode-line 'summary))) +(defun gnus-summary-push-marks-to-backend (article) + (let ((set nil) + (marks gnus-article-mark-lists)) + (when (memq article gnus-newsgroup-unreads) + (push 'read set)) + (while marks + (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks)))))) + (push (cdar marks) set)) + (pop marks)) + (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set))))) + (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to. @@ -9933,7 +10004,7 @@ current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." (interactive (list current-prefix-arg - (let* ((methods (gnus-methods-using 'respool)) + (let* ((methods (mapcar #'car (gnus-methods-using 'respool))) (methname (symbol-name (or gnus-summary-respool-default-method (car (gnus-find-method-for-group @@ -10147,13 +10218,13 @@ confirmation before the articles are deleted." ;; The backend might not have been able to delete the article ;; after all. (unless (memq (car articles) not-deleted) - (gnus-summary-mark-article (car articles) gnus-canceled-mark)) - (let* ((article (car articles)) - (ghead (gnus-data-header - (assoc article (gnus-data-list nil))))) - (run-hook-with-args 'gnus-summary-article-delete-hook - 'delete ghead gnus-newsgroup-name nil - nil)) + (gnus-summary-mark-article (car articles) gnus-canceled-mark) + (let* ((article (car articles)) + (ghead (gnus-data-header + (assoc article (gnus-data-list nil))))) + (run-hook-with-args 'gnus-summary-article-delete-hook + 'delete ghead gnus-newsgroup-name nil + nil))) (setq articles (cdr articles)))) (when not-deleted (gnus-message 4 "Couldn't delete articles %s" not-deleted))) @@ -10252,7 +10323,7 @@ groups." "Make edits to the current article permanent." (interactive) (save-excursion - ;; The buffer restriction contains the entire article if it exists. + ;; The buffer restriction contains the entire article if it exists. (when (article-goto-body) (let ((lines (count-lines (point) (point-max))) (length (- (point-max) (point))) @@ -10272,15 +10343,25 @@ groups." (delete-region (match-beginning 1) (match-end 1)) (insert (number-to-string lines)))))) ;; Replace the article. - (let ((buf (current-buffer))) + (let ((buf (current-buffer)) + (article (cdr gnus-article-current)) + replace-result) (with-temp-buffer (insert-buffer-substring buf) - (if (and (not read-only) - (not (gnus-request-replace-article - (cdr gnus-article-current) (car gnus-article-current) - (current-buffer) t))) + (not (setq replace-result + (gnus-request-replace-article + article (car gnus-article-current) + (current-buffer) t)))) (error "Couldn't replace article") + ;; If we got a number back, then that's the new article number + ;; for this article. Otherwise, the article number didn't change. + (when (numberp replace-result) + (with-current-buffer gnus-summary-buffer + (setq gnus-newsgroup-limit (delq article gnus-newsgroup-limit)) + (gnus-summary-limit gnus-newsgroup-limit) + (setq article replace-result) + (gnus-summary-goto-subject article t))) ;; Update the summary buffer. (if (and references (equal (message-tokenize-header references " ") @@ -10294,38 +10375,29 @@ groups." (point-min) (point-max))) header) (with-temp-buffer - (insert (format "211 %d Article retrieved.\n" - (cdr gnus-article-current))) + (insert (format "211 %d Article retrieved.\n" article)) (insert head) (insert ".\n") (let ((nntp-server-buffer (current-buffer))) - (setq header (car (gnus-get-newsgroup-headers - nil t)))) + (setq header (car (gnus-get-newsgroup-headers nil t)))) (with-current-buffer gnus-summary-buffer - (gnus-data-set-header - (gnus-data-find (cdr gnus-article-current)) - header) - (gnus-summary-update-article-line - (cdr gnus-article-current) header) - (if (gnus-summary-goto-subject - (cdr gnus-article-current) nil t) - (gnus-summary-update-secondary-mark - (cdr gnus-article-current)))))))) + (gnus-data-set-header (gnus-data-find article) header) + (gnus-summary-update-article-line article header) + (if (gnus-summary-goto-subject article nil t) + (gnus-summary-update-secondary-mark article))))))) ;; Update threads. (set-buffer (or buffer gnus-summary-buffer)) - (gnus-summary-update-article (cdr gnus-article-current)) - (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) - (gnus-summary-update-secondary-mark - (cdr gnus-article-current)))) + (gnus-summary-update-article article) + (if (gnus-summary-goto-subject article nil t) + (gnus-summary-update-secondary-mark article))) ;; Prettify the article buffer again. (unless no-highlight (with-current-buffer gnus-article-buffer - ;;;!!! Fix this -- article should be rehighlighted. - ;;;(gnus-run-hooks 'gnus-article-display-hook) + ;;!!! Fix this -- article should be rehighlighted. + ;;(gnus-run-hooks 'gnus-article-display-hook) (set-buffer gnus-original-article-buffer) (gnus-request-article - (cdr gnus-article-current) - (car gnus-article-current) (current-buffer)))) + article (car gnus-article-current) (current-buffer)))) ;; Prettify the summary buffer line. (when (gnus-visual-p 'summary-highlight 'highlight) (gnus-run-hooks 'gnus-visual-mark-article-hook)))))) @@ -11205,6 +11277,7 @@ with that article." (mail-header-subject (gnus-data-header (car data))))) (t nil))) (end-point (save-excursion + (goto-char (gnus-data-pos (car data))) (if (gnus-summary-go-to-next-thread) (point) (point-max)))) articles) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 5326b938cf4..fa4bf076a30 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -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 @@ Uses `gnus-extract-address-components'." (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 @@ Symbols are also allowed; their print names are used instead." (> (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. @@ -888,6 +902,7 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and (defun gnus-write-buffer (file) "Write the current buffer's contents to FILE." + (require 'nnmail) (let ((file-name-coding-system nnmail-pathname-coding-system)) ;; Make sure the directory exists. (gnus-make-directory (file-name-directory file)) @@ -1123,6 +1138,7 @@ In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless FILENAME exists and is Babyl format." (require 'rmail) (require 'mm-util) + (require 'nnmail) ;; Some of this codes is borrowed from rmailout.el. (setq filename (expand-file-name filename)) ;; FIXME should we really be messing with this defcustom? @@ -1214,6 +1230,7 @@ FILENAME exists and is Babyl format." (defun gnus-output-to-mail (filename &optional ask) "Append the current article to a mail file named FILENAME." + (require 'nnmail) (setq filename (expand-file-name filename)) (let ((artbuf (current-buffer)) (tmpbuf (get-buffer-create " *Gnus-output*"))) @@ -1651,10 +1668,16 @@ SPEC is a predicate specifier that contains stuff like `or', `and', initial-input history def)) -(autoload 'iswitchb-read-buffer "iswitchb") +(declare-function iswitchb-read-buffer "iswitchb" + (prompt &optional default require-match start matches-set)) +(defvar iswitchb-temp-buflist) + (defun gnus-iswitchb-completing-read (prompt collection &optional require-match initial-input history def) "`iswitchb' based completing-read function." + ;; Make sure iswitchb is loaded before we let-bind its variables. + ;; If it is loaded inside the let, variables can become unbound afterwards. + (require 'iswitchb) (let ((iswitchb-make-buflist-hook (lambda () (setq iswitchb-temp-buflist @@ -1667,11 +1690,11 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (nreverse filtered-choices)))))) (unwind-protect (progn - (when (not iswitchb-mode) - (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (or iswitchb-mode + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) (iswitchb-read-buffer prompt def require-match)) - (when (not iswitchb-mode) - (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) + (or iswitchb-mode + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) (defun gnus-graphic-display-p () (if (featurep 'xemacs) @@ -1758,14 +1781,16 @@ CHOICE is a list of the choice char and help message at IDX." (kill-buffer buf)) tchar)) -(if (fboundp 'select-frame-set-input-focus) +(if (featurep 'emacs) (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) - ;; XEmacs 21.4, SXEmacs - (defun gnus-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) + (if (fboundp 'select-frame-set-input-focus) + (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) + ;; XEmacs 21.4, SXEmacs + (defun gnus-select-frame-set-input-focus (frame) + "Select FRAME, raise it, and set input focus, if possible." + (raise-frame frame) + (select-frame frame) + (focus-frame frame)))) (defun gnus-frame-or-window-display-name (object) "Given a frame or window, return the associated display name. @@ -1930,25 +1955,6 @@ empty directories from OLD-PATH." (defalias 'gnus-set-process-query-on-exit-flag 'process-kill-without-query)) -(if (fboundp 'with-local-quit) - (defalias 'gnus-with-local-quit 'with-local-quit) - (defmacro gnus-with-local-quit (&rest body) - "Execute BODY, allowing quits to terminate BODY but not escape further. -When a quit terminates BODY, `gnus-with-local-quit' returns nil but -requests another quit. That quit will be processed as soon as quitting -is allowed once again. (Immediately, if `inhibit-quit' is nil.)" - ;;(declare (debug t) (indent 0)) - `(condition-case nil - (let ((inhibit-quit nil)) - ,@body) - (quit (setq quit-flag t) - ;; This call is to give a chance to handle quit-flag - ;; in case inhibit-quit is nil. - ;; Without this, it will not be handled until the next function - ;; call, and that might allow it to exit thru a condition-case - ;; that intends to handle the quit signal next time. - (eval '(ignore nil)))))) - (defalias 'gnus-read-shell-command (if (fboundp 'read-shell-command) 'read-shell-command 'read-string)) @@ -1993,6 +1999,65 @@ Sizes are in pixels." image))) image))) +(defun gnus-list-memq-of-list (elements list) + "Return non-nil if any of the members of ELEMENTS are in LIST." + (let ((found nil)) + (dolist (elem elements) + (setq found (or found + (memq elem list)))) + found)) + +(eval-and-compile + (cond + ((fboundp 'match-substitute-replacement) + (defalias 'gnus-match-substitute-replacement 'match-substitute-replacement)) + (t + (defun gnus-match-substitute-replacement (replacement &optional fixedcase literal string subexp) + "Return REPLACEMENT as it will be inserted by `replace-match'. +In other words, all back-references in the form `\\&' and `\\N' +are substituted with actual strings matched by the last search. +Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same +meaning as for `replace-match'. + +This is the definition of match-substitute-replacement in subr.el from GNU Emacs." + (let ((match (match-string 0 string))) + (save-match-data + (set-match-data (mapcar (lambda (x) + (if (numberp x) + (- x (match-beginning 0)) + x)) + (match-data t))) + (replace-match replacement fixedcase literal match subexp))))))) + +(if (fboundp 'string-match-p) + (defalias 'gnus-string-match-p 'string-match-p) + (defsubst gnus-string-match-p (regexp string &optional start) + "\ +Same as `string-match' except this function does not change the match data." + (save-match-data + (string-match regexp string start)))) + +(eval-and-compile + (if (fboundp 'macroexpand-all) + (defalias 'gnus-macroexpand-all 'macroexpand-all) + (defun gnus-macroexpand-all (form &optional environment) + "Return result of expanding macros at all levels in FORM. +If no macros are expanded, FORM is returned unchanged. +The second optional arg ENVIRONMENT specifies an environment of macro +definitions to shadow the loaded ones for use in file byte-compilation." + (if (consp form) + (let ((idx 1) + (len (length (setq form (copy-sequence form)))) + expanded) + (while (< idx len) + (setcar (nthcdr idx form) (gnus-macroexpand-all (nth idx form) + environment)) + (setq idx (1+ idx))) + (if (eq (setq expanded (macroexpand form environment)) form) + form + (gnus-macroexpand-all expanded environment))) + form)))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 809e4c339be..652d9fda94c 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -228,50 +228,6 @@ See the Gnus manual for an explanation of the syntax used.") (pop list)) (cadr (assq (car list) gnus-window-configuration))) -(defun gnus-windows-old-to-new (setting) - ;; First we take care of the really, really old Gnus 3 actions. - (when (symbolp setting) - (setq setting - ;; Take care of ooold GNUS 3.x values. - (cond ((eq setting 'SelectArticle) 'article) - ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject)) - 'summary) - ((memq setting '(ExitNewsgroup)) 'group) - (t setting)))) - (if (or (listp setting) - (not (and gnus-window-configuration - (memq setting '(group summary article))))) - setting - (let* ((elem - (cond - ((eq setting 'group) - (gnus-window-configuration-element - '(group newsgroups ExitNewsgroup))) - ((eq setting 'summary) - (gnus-window-configuration-element - '(summary SelectNewsgroup SelectSubject ExpandSubject))) - ((eq setting 'article) - (gnus-window-configuration-element - '(article SelectArticle))))) - (total (apply '+ elem)) - (types '(group summary article)) - (pbuf (if (eq setting 'newsgroups) 'group 'summary)) - (i 0) - perc out) - (while (< i 3) - (or (not (numberp (nth i elem))) - (zerop (nth i elem)) - (progn - (setq perc (if (= i 2) - 1.0 - (/ (float (nth i elem)) total))) - (push (if (eq pbuf (nth i types)) - (list (nth i types) perc 'point) - (list (nth i types) perc)) - out))) - (incf i)) - `(vertical 1.0 ,@(nreverse out))))) - ;;;###autoload (defun gnus-add-configuration (conf) "Add the window configuration CONF to `gnus-buffer-configuration'." @@ -293,18 +249,9 @@ See the Gnus manual for an explanation of the syntax used.") (defun gnus-configure-frame (split &optional window) "Split WINDOW according to SPLIT." - (let ((current-window - (or (get-buffer-window (current-buffer)) (selected-window)))) - (unless window - (setq window current-window)) + (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window))) + (window (or window current-window))) (select-window window) - ;; This might be an old-style buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) ;; The SPLIT might be something that is to be evaled to ;; return a new SPLIT. (while (and (not (assq (car split) gnus-window-to-buffer)) @@ -423,56 +370,55 @@ See the Gnus manual for an explanation of the syntax used.") (set-window-configuration setting) (setq gnus-current-window-configuration setting) (setq force (or force gnus-always-force-window-configuration)) - (setq setting (gnus-windows-old-to-new setting)) (let ((split (if (symbolp setting) - (cadr (assq setting gnus-buffer-configuration)) - setting)) - all-visible) + (cadr (assq setting gnus-buffer-configuration)) + setting)) + all-visible) (setq gnus-frame-split-p nil) (unless split - (error "No such setting in `gnus-buffer-configuration': %s" setting)) + (error "No such setting in `gnus-buffer-configuration': %s" setting)) (if (and (setq all-visible (gnus-all-windows-visible-p split)) - (not force)) - ;; All the windows mentioned are already visible, so we just - ;; put point in the assigned buffer, and do not touch the - ;; winconf. - (select-window all-visible) - - ;; Make sure "the other" buffer, nntp-server-buffer, is live. - (unless (gnus-buffer-live-p nntp-server-buffer) - (nnheader-init-server-buffer)) - - ;; Either remove all windows or just remove all Gnus windows. - (let ((frame (selected-frame))) - (unwind-protect - (if gnus-use-full-window - ;; We want to remove all other windows. - (if (not gnus-frame-split-p) - ;; This is not a `frame' split, so we ignore the - ;; other frames. - (delete-other-windows) - ;; This is a `frame' split, so we delete all windows - ;; on all frames. - (gnus-delete-windows-in-gnusey-frames)) - ;; Just remove some windows. - (gnus-remove-some-windows) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer))) - (select-frame frame))) - - (let (gnus-window-frame-focus) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer)) - (gnus-configure-frame split) - (run-hooks 'gnus-configure-windows-hook) - (when gnus-window-frame-focus - (gnus-select-frame-set-input-focus - (window-frame gnus-window-frame-focus)))))))) + (not force)) + ;; All the windows mentioned are already visible, so we just + ;; put point in the assigned buffer, and do not touch the + ;; winconf. + (select-window all-visible) + + ;; Make sure "the other" buffer, nntp-server-buffer, is live. + (unless (gnus-buffer-live-p nntp-server-buffer) + (nnheader-init-server-buffer)) + + ;; Either remove all windows or just remove all Gnus windows. + (let ((frame (selected-frame))) + (unwind-protect + (if gnus-use-full-window + ;; We want to remove all other windows. + (if (not gnus-frame-split-p) + ;; This is not a `frame' split, so we ignore the + ;; other frames. + (delete-other-windows) + ;; This is a `frame' split, so we delete all windows + ;; on all frames. + (gnus-delete-windows-in-gnusey-frames)) + ;; Just remove some windows. + (gnus-remove-some-windows) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer))) + (select-frame frame))) + + (let (gnus-window-frame-focus) + (if (featurep 'xemacs) + (switch-to-buffer nntp-server-buffer) + (set-buffer nntp-server-buffer)) + (gnus-configure-frame split) + (run-hooks 'gnus-configure-windows-hook) + (when gnus-window-frame-focus + (gnus-select-frame-set-input-focus + (window-frame gnus-window-frame-focus)))))))) (defun gnus-delete-windows-in-gnusey-frames () "Do a `delete-other-windows' in all frames that have Gnus windows." diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index c944f4a307d..b4f7f836189 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1,8 +1,8 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, +;; 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -308,9 +308,6 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) -(unless (fboundp 'gnus-group-remove-excess-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore)) - (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) @@ -353,7 +350,6 @@ be set in `.emacs' instead." (list str)) line))) (defalias 'gnus-mode-line-buffer-identification 'identity)) - (defalias 'gnus-characterp 'numberp) (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) (defalias 'gnus-key-press-event-p 'numberp) @@ -921,7 +917,8 @@ be set in `.emacs' instead." ;;; Gnus buffers ;;; -(defvar gnus-buffers nil) +(defvar gnus-buffers nil + "List of buffers handled by Gnus.") (defun gnus-get-buffer-create (name) "Do the same as `get-buffer-create', but store the created buffer." @@ -953,7 +950,8 @@ be set in `.emacs' instead." ;;; Splash screen. -(defvar gnus-group-buffer "*Group*") +(defvar gnus-group-buffer "*Group*" + "Name of the Gnus group buffer.") (defface gnus-splash '((((class color) @@ -992,8 +990,6 @@ be set in `.emacs' instead." (while (search-forward "\t" nil t) (replace-match " " t t)))))) -(defvar gnus-simple-splash nil) - ;;(format "%02x%02x%02x" 114 66 20) "724214" (defvar gnus-logo-color-alist @@ -1033,50 +1029,47 @@ be set in `.emacs' instead." "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) - (cond - ((and - (fboundp 'find-image) - (display-graphic-p) - ;; Make sure the library defining `image-load-path' is loaded - ;; (`find-image' is autoloaded) (and discard the result). Else, we may - ;; get "defvar ignored because image-load-path is let-bound" when calling - ;; `find-image' below. - (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) - (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) - (image-load-path (cond (data-directory - (list data-directory)) - ((boundp 'image-load-path) - (symbol-value 'image-load-path)) - (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" - :color-symbols - (("thing" . ,(car gnus-logo-colors)) - ("shadow" . ,(cadr gnus-logo-colors)) - ("oort" . "#eeeeee") - ("background" . ,(face-background 'default)))) - (:type svg :file "gnus.svg") - (:type png :file "gnus.png") - (:type pbm :file "gnus.pbm" - ;; Account for the pbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)) - (:type xbm :file "gnus.xbm" - ;; Account for the xbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) - (when image - (let ((size (image-size image))) - (insert-char ?\n (max 0 (round (- (window-height) - (or y (cdr size)) 1) 2))) - (insert-char ?\ (max 0 (round (- (window-width) - (or x (car size))) 2))) - (insert-image image)) - (setq gnus-simple-splash nil) - t)))) - (t + (unless (and + (fboundp 'find-image) + (display-graphic-p) + ;; Make sure the library defining `image-load-path' is + ;; loaded (`find-image' is autoloaded) (and discard the + ;; result). Else, we may get "defvar ignored because + ;; image-load-path is let-bound" when calling `find-image' + ;; below. + (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) + (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) + (image-load-path (cond (data-directory + (list data-directory)) + ((boundp 'image-load-path) + (symbol-value 'image-load-path)) + (t load-path))) + (image (find-image + `((:type xpm :file "gnus.xpm" + :color-symbols + (("thing" . ,(car gnus-logo-colors)) + ("shadow" . ,(cadr gnus-logo-colors)))) + (:type svg :file "gnus.svg") + (:type png :file "gnus.png") + (:type pbm :file "gnus.pbm" + ;; Account for the pbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default)) + (:type xbm :file "gnus.xbm" + ;; Account for the xbm's background. + :background ,(face-foreground 'gnus-splash) + :foreground ,(face-background 'default)))))) + (when image + (let ((size (image-size image))) + (insert-char ?\n (max 0 (round (- (window-height) + (or y (cdr size)) 1) 2))) + (insert-char ?\ (max 0 (round (- (window-width) + (or x (car size))) 2))) + (insert-image image)) + (goto-char (point-min)) + t))) (insert - (format " %s + (format " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -1095,8 +1088,7 @@ be set in `.emacs' instead." _ __ -" - "")) +")) ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) @@ -1108,10 +1100,9 @@ be set in `.emacs' instead." (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. (put-text-property (point-min) (point-max) 'face 'gnus-splash) - (setq gnus-simple-splash t))) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat " " gnus-version)) - (set-buffer-modified-p t)) + (goto-char (point-min)) + (setq mode-line-buffer-identification (concat " " gnus-version)) + (set-buffer-modified-p t))) (eval-when (load) (let ((command (format "%s" this-command))) @@ -1267,15 +1258,6 @@ by the user. If you want to change servers, you should use `gnus-select-method'. See the documentation to that variable.") -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - (defcustom gnus-nntpserver-file "/etc/nntpserver" "A file with only the name of the nntp server in it." :group 'gnus-files @@ -1299,20 +1281,11 @@ Check the NNTPSERVER environment variable and the ;;;###autoload (custom-autoload 'gnus-select-method "gnus")) (defcustom gnus-select-method - (condition-case nil - (nconc - (list 'nntp (or (condition-case nil - (gnus-getenv-nntpserver) - (error nil)) - (when (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service))) - (error nil)) + (list 'nntp (or (gnus-getenv-nntpserver) + (when (and gnus-default-nntp-server + (not (string= gnus-default-nntp-server ""))) + gnus-default-nntp-server) + "news")) "Default method for selecting a newsgroup. This variable should be a list, where the first element is how the news is to be fetched, the second is the address. @@ -1356,12 +1329,12 @@ updated if the value of this variable is nil, even if you change the value of `gnus-message-archive-method' afterward. If you want the saved \"archive\" method to be updated whenever you change the value of `gnus-message-archive-method', set this variable to a non-nil value." - :version "23.1" ;; No Gnus + :version "23.1" :group 'gnus-server :group 'gnus-message :type 'boolean) -(defcustom gnus-message-archive-group nil +(defcustom gnus-message-archive-group '((format-time-string "sent.%Y-%m")) "*Name of the group in which to save the messages you've written. This can either be a string; a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list @@ -1381,8 +1354,12 @@ unprefixed -- which implicitly means \"store on the archive server\". However, you may wish to store the message on some other server. In that case, just return a fully prefixed name of the group -- \"nnml+private:mail.misc\", for instance." + :version "24.1" :group 'gnus-message :type '(choice (const :tag "none" nil) + (const :tag "Weekly" ((format-time-string "sent.%Yw%U"))) + (const :tag "Monthly" ((format-time-string "sent.%Y-%m"))) + (const :tag "Yearly" ((format-time-string "sent.%Y"))) function sexp string)) @@ -1393,14 +1370,14 @@ To make Gnus query you for a server, you have to give `gnus' a non-numeric prefix - `C-u M-x gnus', in short." :group 'gnus-server :type '(repeat string)) +(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") (defcustom gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead." + "The name of the host running the NNTP server." :group 'gnus-server :type '(choice (const :tag "disable" nil) string)) +(make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1") (defcustom gnus-secondary-select-methods nil "A list of secondary methods that will be used for reading news. @@ -1414,11 +1391,6 @@ you could set this variable: :group 'gnus-server :type '(repeat gnus-select-method)) -(defvar gnus-backup-default-subscribed-newsgroups - '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") - "Default default new newsgroups the first time Gnus is run. -Should be set in paths.el, and shouldn't be touched by the user.") - (defcustom gnus-local-domain nil "Local domain name without a host name. The DOMAINNAME environment variable is used instead if it is defined. @@ -1429,10 +1401,6 @@ no need to set this variable." string)) (make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1") -(defvar gnus-local-organization nil - "String with a description of what organization (if any) the user belongs to. -Obsolete variable; use `message-user-organization' instead.") - ;; Customization variables (defcustom gnus-refer-article-method 'current @@ -1462,14 +1430,6 @@ list, Gnus will try all the methods in the list until it finds a match." (nnweb "refer" (nnweb-type google))) gnus-select-method)))) -(defcustom gnus-group-fetch-control-use-browse-url nil - "*Non-nil means that control messages are displayed using `browse-url'. -Otherwise they are fetched with ange-ftp and displayed in an ephemeral -group." - :version "22.1" - :group 'gnus-group-various - :type 'boolean) - (defcustom gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in @@ -1499,7 +1459,7 @@ Also see `gnus-large-ephemeral-newsgroup'." integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) - "*Non-nil means that the default name of a file to save articles in is the group name. + "Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead. If this variable is a list, and the list contains the element @@ -1509,8 +1469,8 @@ saving; and if it contains the element `not-kill', long file names will not be used for kill files. Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t." +type you're using. On `usg-unix-v' this variable defaults to nil while +on all other systems it defaults to t." :group 'gnus-start :type '(radio (sexp :format "Non-nil\n" :match (lambda (widget value) @@ -1648,7 +1608,7 @@ slower." ("nnweb" none) ("nnrss" none) ("nnagent" post-mail) - ("nnimap" post-mail address prompt-address physical-address) + ("nnimap" post-mail address prompt-address physical-address respool) ("nnmaildir" mail respool address) ("nnnil" none)) "*An alist of valid select methods. @@ -2810,7 +2770,8 @@ gnus-registry.el will populate this if it's loaded.") ("gnus-cite" :interactive t gnus-article-highlight-citation gnus-article-hide-citation-maybe gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) + gnus-article-hide-citation-in-followups + gnus-article-fill-cited-long-lines) ("gnus-kill" gnus-kill gnus-apply-kill-file-internal gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score) @@ -3580,16 +3541,6 @@ that that variable is buffer-local to the summary buffers." gnus-valid-select-methods))) (equal (nth 1 m1) (nth 1 m2))))))) -(defun gnus-methods-sloppily-equal (m1 m2) - ;; Same method. - (or - (eq m1 m2) - ;; Type and name are equal. - (and - (eq (car m1) (car m2)) - (equal (cadr m1) (cadr m2)) - (gnus-sloppily-equal-method-parameters m1 m2)))) - (defsubst gnus-sloppily-equal-method-parameters (m1 m2) ;; Check parameters for sloppy equalness. (let ((p1 (copy-sequence (cddr m1))) @@ -3618,6 +3569,16 @@ that that variable is buffer-local to the summary buffers." ;; If p2 now is empty, they were equal. (null p2)))) +(defun gnus-methods-sloppily-equal (m1 m2) + ;; Same method. + (or + (eq m1 m2) + ;; Type and name are equal. + (and + (eq (car m1) (car m2)) + (equal (cadr m1) (cadr m2)) + (gnus-sloppily-equal-method-parameters m1 m2)))) + (defun gnus-server-equal (m1 m2) "Say whether two methods are equal." (let ((m1 (cond ((null m1) gnus-select-method) @@ -3937,7 +3898,9 @@ GROUP can also be an INFO structure." (not (eq (caar old-params) name))) (setq new-params (append new-params (list (car old-params))))) (setq old-params (cdr old-params))) - (gnus-group-set-info new-params (gnus-info-group info) 'params))))) + (if (listp group) + (gnus-info-set-params info new-params t) + (gnus-group-set-info new-params (gnus-info-group info) 'params)))))) (defun gnus-group-remove-parameter (group name) "Remove parameter NAME from GROUP. diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 1bd5be74013..137a18f27eb 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -501,6 +501,8 @@ See `mail-source-bind'." (t value))) +(autoload 'nnheader-message "nnheader") + (defun mail-source-fetch (source callback &optional method) "Fetch mail from SOURCE and call CALLBACK zero or more times. CALLBACK will be called with the name of the file where (some of) @@ -594,6 +596,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) 0) (funcall callback mail-source-crash-box info))) +(autoload 'gnus-float-time "gnus-util") + (defvar mail-source-incoming-last-checked-time nil) (defun mail-source-delete-crash-box () @@ -614,7 +618,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; Don't check for old incoming files more than once per day to ;; save a lot of file accesses. (when (or (null mail-source-incoming-last-checked-time) - (> (time-to-seconds + (> (gnus-float-time (time-since mail-source-incoming-last-checked-time)) (* 24 60 60))) (setq mail-source-incoming-last-checked-time (current-time)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c9ddba42896..de9eef5ea73 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -161,7 +161,7 @@ If this variable is nil, no such courtesy message will be added." :type 'regexp) (defcustom message-from-style mail-from-style - "*Specifies how \"From\" headers look. + "Specifies how \"From\" headers look. If nil, they contain just the return address like: king@grassland.com @@ -277,7 +277,7 @@ This is a list of regexps and regexp matches." regexp)) (defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" + "^\\([GF]cc\\|Resent-Fcc\\|Xref\\|X-Draft-From\\|X-Gnus-Agent-Meta-Information\\):" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers @@ -306,7 +306,7 @@ any confusion." ;;; Start of variables adopted from `message-utils.el'. -(defcustom message-subject-trailing-was-query 'ask +(defcustom message-subject-trailing-was-query t "*What to do with trailing \"(was: <old subject>)\" in subject lines. If nil, leave the subject unchanged. If it is the symbol `ask', query the user what do do. In this case, the subject is matched against @@ -314,7 +314,7 @@ the user what do do. In this case, the subject is matched against `message-subject-trailing-was-query' is t, always strip the trailing old subject. In this case, `message-subject-trailing-was-regexp' is used." - :version "22.1" + :version "24.1" :type '(choice (const :tag "never" nil) (const :tag "always strip" t) (const ask)) @@ -322,7 +322,7 @@ used." :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 @@ -507,14 +507,9 @@ This is used by `message-kill-buffer'." :group 'message-buffers :type 'boolean) -(defvar gnus-local-organization) (defcustom message-user-organization - (or (and (boundp 'gnus-local-organization) - (stringp gnus-local-organization) - gnus-local-organization) - (getenv "ORGANIZATION") - t) - "*String to be used as an Organization header. + (or (getenv "ORGANIZATION") t) + "String to be used as an Organization header. If t, use `message-user-organization-file'." :group 'message-headers :type '(choice string @@ -1139,13 +1134,17 @@ It is a vector of the following headers: :error "All header lines must be newline terminated") (defcustom message-default-headers "" - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines." + "Header lines to be inserted in outgoing messages. +This can be set to a string containing or a function returning +header lines to be inserted before you edit the message, so you +can edit or delete these lines. If set to a function, it is +called and its result is inserted." :version "23.2" :group 'message-headers :link '(custom-manual "(message)Message Headers") - :type 'message-header-lines) + :type '(choice + (message-header-lines :tag "String") + (function :tag "Function"))) (defcustom message-default-mail-headers ;; Ease the transition from mail-mode to message-mode. See bugs#4431, 5555. @@ -2639,7 +2638,6 @@ PGG manual, depending on the value of `mml2015-use'." (define-key message-mode-map "\C-a" 'message-beginning-of-line) (define-key message-mode-map "\t" 'message-tab) - (define-key message-mode-map "\M-;" 'comment-region) (define-key message-mode-map "\M-n" 'message-display-abbrev)) @@ -2916,6 +2914,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (mail-aliases-setup)))) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) + (add-hook 'completion-at-point-functions 'message-completion-function nil t) (unless buffer-file-name (message-set-auto-save-file-name)) (unless (buffer-base-buffer) @@ -3044,10 +3043,22 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (interactive) (message-position-on-field "Summary" "Subject")) -(defun message-goto-body (&optional interactivep) +(eval-when-compile + (defmacro message-called-interactively-p (kind) + (condition-case nil + (progn + (eval '(called-interactively-p 'any)) + ;; Emacs >=23.2 + `(called-interactively-p ,kind)) + ;; Emacs <23.2 + (wrong-number-of-arguments '(called-interactively-p)) + ;; XEmacs + (void-function '(interactive-p))))) + +(defun message-goto-body () "Move point to the beginning of the message body." - (interactive (list t)) - (when (and interactivep + (interactive) + (when (and (message-called-interactively-p 'any) (looking-at "[ \t]*\n")) (expand-abbrev)) (goto-char (point-min)) @@ -3056,7 +3067,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (defun message-in-body-p () "Return t if point is in the message body." - (let ((body (save-excursion (message-goto-body) (point)))) + (let ((body (save-excursion (message-goto-body)))) (>= (point) body))) (defun message-goto-eoh () @@ -4206,7 +4217,7 @@ conformance." (?r ,(format "Replace non-printable characters with \"%s\" and send" message-replacement-char)) - (?i "Ignore non-printable characters and send") + (?s "Send as is without removing anything") (?e "Continue editing")))) (if (eq choice ?e) (error "Non-printable characters")) @@ -4479,6 +4490,8 @@ This function could be useful in `message-setup-hook'." (save-restriction (message-narrow-to-headers) (and news + (not (message-fetch-field "List-Post")) + (not (message-fetch-field "List-ID")) (or (message-fetch-field "cc") (message-fetch-field "bcc") (message-fetch-field "to")) @@ -4495,7 +4508,9 @@ This function could be useful in `message-setup-hook'." (string= "base64" (message-fetch-field "content-transfer-encoding"))))))) - (message-insert-courtesy-copy)) + (message-insert-courtesy-copy + (with-current-buffer mailbuf + message-courtesy-message))) ;; Let's make sure we encoded all the body. (assert (save-excursion (goto-char (point-min)) @@ -5936,7 +5951,7 @@ Headers already prepared in the buffer are not modified." ;; Check for IDNA (message-idna-to-ascii-rhs)))) -(defun message-insert-courtesy-copy () +(defun message-insert-courtesy-copy (message) "Insert a courtesy message in mail copies of combined messages." (let (newsgroups) (save-excursion @@ -5946,12 +5961,12 @@ Headers already prepared in the buffer are not modified." (goto-char (point-max)) (insert "Posted-To: " newsgroups "\n"))) (forward-line 1) - (when message-courtesy-message + (when message (cond - ((string-match "%s" message-courtesy-message) - (insert (format message-courtesy-message newsgroups))) + ((string-match "%s" message) + (insert (format message newsgroups))) (t - (insert message-courtesy-message))))))) + (insert message))))))) ;;; ;;; Setting up a message buffer @@ -6363,7 +6378,10 @@ are not included." headers) (delete-region (point) (progn (forward-line -1) (point))) (when message-default-headers - (insert message-default-headers) + (insert + (if (functionp message-default-headers) + (funcall message-default-headers) + message-default-headers)) (or (bolp) (insert ?\n))) (insert mail-header-separator "\n") (forward-line -1) @@ -6568,6 +6586,10 @@ The function is called with one parameter, a cons cell ..." (save-match-data ;; Build (textual) list of new recipient addresses. (cond + (to-address + (setq recipients (concat ", " to-address)) + ;; If the author explicitly asked for a copy, we don't deny it to them. + (if mct (setq recipients (concat recipients ", " mct)))) ((not wide) (setq recipients (concat ", " author))) (address-headers @@ -6603,10 +6625,6 @@ responses here are directed to other addresses. You may customize the variable `message-use-mail-followup-to', if you want to get rid of this query permanently."))) (setq recipients (concat ", " mft))) - (to-address - (setq recipients (concat ", " to-address)) - ;; If the author explicitly asked for a copy, we don't deny it to them. - (if mct (setq recipients (concat recipients ", " mct)))) (t (setq recipients (if never-mct "" (concat ", " author))) (if to (setq recipients (concat recipients ", " to))) @@ -7422,7 +7440,11 @@ is for the internal use." (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 @@ -7722,7 +7744,7 @@ When FORCE, rebuild the tool bar." :type '(alist :key-type regexp :value-type function)) (defcustom message-expand-name-databases - (list 'bbdb 'eudc) + '(bbdb eudc) "List of databases to try for name completion (`message-expand-name'). Each element is a symbol and can be `bbdb' or `eudc'." :group 'message @@ -7744,15 +7766,25 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed." Execute function specified by `message-tab-body-function' when not in those headers." (interactive) + (cond + ((if (and (boundp 'completion-fail-discreetly) + (fboundp 'completion-at-point)) + (let ((completion-fail-discreetly t)) (completion-at-point)) + (funcall (or (message-completion-function) #'ignore))) + ;; Completion was performed; nothing else to do. + nil) + (message-tab-body-function (funcall message-tab-body-function)) + (t (funcall (or (lookup-key text-mode-map "\t") + (lookup-key global-map "\t") + 'indent-relative))))) + +(defun message-completion-function () (let ((alist message-completion-alist)) (while (and alist (let ((mail-abbrev-mode-regexp (caar alist))) (not (mail-abbrev-in-expansion-header-p)))) (setq alist (cdr alist))) - (funcall (or (cdar alist) message-tab-body-function - (lookup-key text-mode-map "\t") - (lookup-key global-map "\t") - 'indent-relative)))) + (cdar alist))) (eval-and-compile (condition-case nil diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index d35319e151b..216ed6624d9 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1,7 +1,7 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -105,8 +105,8 @@ ,disposition ,description ,cache ,id)) (defcustom mm-text-html-renderer - (cond ((fboundp 'libxml-parse-html-region) 'mm-shr) - ((executable-find "w3m") 'gnus-article-html) + (cond ((fboundp 'libxml-parse-html-region) 'shr) + ((executable-find "w3m") 'gnus-w3m) ((executable-find "links") 'links) ((executable-find "lynx") 'lynx) ((locate-library "w3") 'w3) @@ -115,8 +115,8 @@ "Render of HTML contents. It is one of defined renderer types, or a rendering function. The defined renderer types are: -`mm-shr': use Gnus simple HTML renderer; -`gnus-article-html' : use Gnus renderer based on w3m; +`shr': use Gnus simple HTML renderer; +`gnus-w3m' : use Gnus renderer based on w3m; `w3m' : use emacs-w3m; `w3m-standalone': use w3m; `links': use links; @@ -125,8 +125,8 @@ The defined renderer types are: `html2text' : use html2text; nil : use external viewer (default web browser)." :version "24.1" - :type '(choice (const mm-shr) - (const gnus-article-html) + :type '(choice (const shr) + (const gnus-w3m) (const w3) (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) @@ -137,10 +137,6 @@ nil : use external viewer (default web browser)." (function)) :group 'mime-display) -(defvar mm-inline-text-html-renderer nil - "Function used for rendering inline HTML contents. -It is suggested to customize `mm-text-html-renderer' instead.") - (defcustom mm-inline-text-html-with-images nil "If non-nil, Gnus will allow retrieving images in HTML contents with the <img> tags. It has no effect on Emacs/w3. See also the @@ -245,8 +241,7 @@ before the external MIME handler is invoked." ("text/html" mm-inline-text-html (lambda (handle) - (or mm-inline-text-html-renderer - mm-text-html-renderer))) + mm-text-html-renderer)) ("text/x-vcard" mm-inline-text-vcard (lambda (handle) @@ -629,7 +624,7 @@ Postpone undisplaying of viewers for types in 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))) @@ -671,7 +666,7 @@ Postpone undisplaying of viewers for types in (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." @@ -701,13 +696,14 @@ Postpone undisplaying of viewers for types in (autoload 'mailcap-parse-mailcaps "mailcap") (autoload 'mailcap-mime-info "mailcap") -(defun mm-display-part (handle &optional no-default) +(defun mm-display-part (handle &optional no-default force) "Display the MIME part represented by HANDLE. Returns nil if the part is removed; inline if displayed inline; external if displayed external." (save-excursion (mailcap-parse-mailcaps) - (if (mm-handle-displayed-p handle) + (if (and (not force) + (mm-handle-displayed-p handle)) (mm-remove-part handle) (let* ((ehandle (if (equal (mm-handle-media-type handle) "message/external-body") @@ -1255,11 +1251,13 @@ PROMPT overrides the default one used to ask user for a file name." (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file - (read-file-name (or prompt - (format "Save MIME part to (default %s): " - (or filename ""))) - (or mm-default-directory default-directory) - (or filename ""))) + (read-file-name + (or prompt + (format "Save MIME part to (default %s): " + (or filename ""))) + (or mm-default-directory default-directory) + (expand-file-name (or filename "") + (or mm-default-directory default-directory)))) (if (file-directory-p file) (setq file (expand-file-name filename file)) (setq file (expand-file-name @@ -1328,6 +1326,8 @@ Use CMD as the process." (let ((coding-system-for-write 'binary)) (shell-command-on-region (point-min) (point-max) command nil))))) +(autoload 'gnus-completing-read "gnus-util") + (defun mm-interactively-view-part (handle) "Display HANDLE using METHOD." (let* ((type (mm-handle-media-type handle)) @@ -1569,7 +1569,7 @@ If RECURSIVE, search recursively." (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 @@ If RECURSIVE, search recursively." ((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 @@ -1687,22 +1687,26 @@ If RECURSIVE, search recursively." (start end &optional base-url)) (declare-function shr-insert-document "shr" (dom)) (defvar shr-blocked-images) +(defvar gnus-inhibit-images) +(autoload 'gnus-blocked-images "gnus-art") (defun mm-shr (handle) ;; Require since we bind its variables. (require 'shr) (let ((article-buffer (current-buffer)) - (shr-blocked-images (if (and (boundp 'gnus-summary-buffer) - (buffer-name gnus-summary-buffer)) - (with-current-buffer gnus-summary-buffer - gnus-blocked-images) - shr-blocked-images)) (shr-content-function (lambda (id) (let ((handle (mm-get-content-id id))) (when handle (mm-with-part handle (buffer-string)))))) - charset) + shr-inhibit-images shr-blocked-images charset char) + (if (and (boundp 'gnus-summary-buffer) + (buffer-name gnus-summary-buffer)) + (with-current-buffer gnus-summary-buffer + (setq shr-inhibit-images gnus-inhibit-images + shr-blocked-images (gnus-blocked-images))) + (setq shr-inhibit-images gnus-inhibit-images + shr-blocked-images (gnus-blocked-images))) (unless handle (setq handle (mm-dissect-buffer t))) (setq charset (mail-content-type-get (mm-handle-type handle) 'charset)) @@ -1710,14 +1714,32 @@ If RECURSIVE, search recursively." (narrow-to-region (point) (point)) (shr-insert-document (mm-with-part handle - (when (and charset - (setq charset (mm-charset-to-coding-system charset)) - (not (eq charset 'ascii))) - (insert (prog1 - (mm-decode-coding-string (buffer-string) charset) - (erase-buffer) - (mm-enable-multibyte)))) - (libxml-parse-html-region (point-min) (point-max))))))) + (insert (prog1 + (if (and charset + (setq charset + (mm-charset-to-coding-system charset)) + (not (eq charset 'ascii))) + (mm-decode-coding-string (buffer-string) charset) + (mm-string-as-multibyte (buffer-string))) + (erase-buffer) + (mm-enable-multibyte))) + (goto-char (point-min)) + (setq case-fold-search t) + (while (re-search-forward + "&#\\(?:x\\([89][0-9a-f]\\)\\|\\(1[2-5][0-9]\\)\\);" nil t) + (when (setq char + (cdr (assq (if (match-beginning 1) + (string-to-number (match-string 1) 16) + (string-to-number (match-string 2))) + mm-extra-numeric-entities))) + (replace-match (char-to-string char)))) + (libxml-parse-html-region (point-min) (point-max)))) + (mm-handle-set-undisplayer + handle + `(lambda () + (let ((inhibit-read-only t)) + (delete-region ,(point-min-marker) + ,(point-max-marker)))))))) (provide 'mm-decode) diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index 8363fe07c73..92de6117388 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -1,7 +1,7 @@ ;;; mm-extern.el --- showing message/external-body -;; 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. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: message external-body @@ -91,7 +91,7 @@ (let (mm-extern-anonymous) (mm-extern-anon-ftp handle))) -(declare-function message-goto-body "message" (&optional interactivep)) +(declare-function message-goto-body "message" ()) (defun mm-extern-mail-server (handle) (require 'message) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 0da136e1efc..0c2b80c9ca7 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -365,16 +365,19 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (defun mm-url-decode-entities () "Decode all HTML entities." (goto-char (point-min)) - (while (re-search-forward "&\\(#[0-9]+\\|#x[0-9a-f]+\\|[a-z]+[0-9]*\\);" nil t) + (while (re-search-forward "&\\(#[0-9]+\\|#x[0-9a-f]+\\|[a-z]+[0-9]*\\);" + nil t) (let* ((entity (match-string 1)) (elem (if (eq (aref entity 0) ?\#) - (let ((c (mm-ucs-to-char - ;; Hex number: ㈒ - (if (eq (aref entity 1) ?x) - (string-to-number (substring entity 2) - 16) - ;; Decimal number:  - (string-to-number (substring entity 1)))))) + (let ((c + ;; Hex number: ㈒ + (if (eq (aref entity 1) ?x) + (string-to-number (substring entity 2) + 16) + ;; Decimal number:  + (string-to-number (substring entity 1))))) + (setq c (or (cdr (assq c mm-extra-numeric-entities)) + (mm-ucs-to-char c))) (if (mm-char-or-char-int-p c) c ?#)) (or (cdr (assq (intern entity) mm-url-html-entities)) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index b16e1d9556b..c07d0bf6e87 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -39,6 +39,10 @@ (require 'timer))) (defvar mm-mime-mule-charset-alist ) +;; Note this is not presently used on Emacs >= 23, which is good, +;; since it means standalone message-mode (which requires mml and +;; hence mml-util) does not load gnus-util. +(autoload 'gnus-completing-read "gnus-util") ;; Emulate functions that are not available in every (X)Emacs version. ;; The name of a function is prefixed with mm-, like `mm-char-int' for @@ -202,19 +206,10 @@ to the contents of the accessible portion of the buffer." (defalias 'mm-decode-coding-region 'decode-coding-region) (defalias 'mm-encode-coding-region 'encode-coding-region))) -;; `string-to-multibyte' is available only in Emacs 22.1 or greater. -(defalias 'mm-string-to-multibyte - (cond - ((featurep 'xemacs) - 'identity) - ((fboundp 'string-to-multibyte) - 'string-to-multibyte) - (t - (lambda (string) - "Return a multibyte string with the same individual chars as STRING." - (mapconcat - (lambda (ch) (mm-string-as-multibyte (char-to-string ch))) - string ""))))) +;; `string-to-multibyte' is available only in Emacs. +(defalias 'mm-string-to-multibyte (if (featurep 'xemacs) + 'identity + 'string-to-multibyte)) ;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. (eval-and-compile @@ -225,42 +220,43 @@ to the contents of the accessible portion of the buffer." (t 'identity)))) ;; `ucs-to-char' is a function that Mule-UCS provides. -(if (featurep 'xemacs) - (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5. - (subrp (symbol-function 'unicode-to-char))) - (if (featurep 'mule) - (defalias 'mm-ucs-to-char 'unicode-to-char) +(eval-and-compile + (if (featurep 'xemacs) + (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5. + (subrp (symbol-function 'unicode-to-char))) + (if (featurep 'mule) + (defalias 'mm-ucs-to-char 'unicode-to-char) + (defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (or (unicode-to-char codepoint) ?#)))) + ((featurep 'mule) + (defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded. + (progn + (defalias 'mm-ucs-to-char + (lambda (codepoint) + "Convert Unicode codepoint to character." + (condition-case nil + (or (ucs-to-char codepoint) ?#) + (error ?#)))) + (mm-ucs-to-char codepoint)) + (condition-case nil + (or (int-to-char codepoint) ?#) + (error ?#))))) + (t (defun mm-ucs-to-char (codepoint) "Convert Unicode codepoint to character." - (or (unicode-to-char codepoint) ?#)))) - ((featurep 'mule) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded. - (progn - (defalias 'mm-ucs-to-char - (lambda (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (ucs-to-char codepoint) ?#) - (error ?#)))) - (mm-ucs-to-char codepoint)) (condition-case nil (or (int-to-char codepoint) ?#) (error ?#))))) - (t - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (if (let ((char (make-char 'japanese-jisx0208 36 34))) - (eq char (decode-char 'ucs char))) - ;; Emacs 23. - (defalias 'mm-ucs-to-char 'identity) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (decode-char 'ucs codepoint) ?#)))) + (if (let ((char (make-char 'japanese-jisx0208 36 34))) + (eq char (decode-char 'ucs char))) + ;; Emacs 23. + (defalias 'mm-ucs-to-char 'identity) + (defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (or (decode-char 'ucs codepoint) ?#))))) ;; Fixme: This seems always to be used to read a MIME charset, so it ;; should be re-named and fixed (in Emacs) to offer completion only on @@ -272,18 +268,19 @@ to the contents of the accessible portion of the buffer." ;; Actually, there should be an `mm-coding-system-mime-charset'. (eval-and-compile (defalias 'mm-read-coding-system - (cond - ((fboundp 'read-coding-system) - (if (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - (t (lambda (prompt &optional default-coding-system) - "Prompt the user for a coding system." - (gnus-completing-read - prompt (mapcar (lambda (s) (symbol-name (car s))) - mm-mime-mule-charset-alist))))))) + (if (featurep 'emacs) 'read-coding-system + (cond + ((fboundp 'read-coding-system) + (if (and (featurep 'xemacs) + (<= (string-to-number emacs-version) 21.1)) + (lambda (prompt &optional default-coding-system) + (read-coding-system prompt)) + 'read-coding-system)) + (t (lambda (prompt &optional default-coding-system) + "Prompt the user for a coding system." + (gnus-completing-read + prompt (mapcar (lambda (s) (symbol-name (car s))) + mm-mime-mule-charset-alist)))))))) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () @@ -870,6 +867,21 @@ variable is set, it overrides the default priority." Setting it to nil is useful on Emacsen supporting Unicode if sending mail with multiple parts is preferred to sending a Unicode one.") +(defvar mm-extra-numeric-entities + (mapcar + (lambda (item) + (cons (car item) (mm-ucs-to-char (cdr item)))) + '((#x80 . #x20AC) (#x82 . #x201A) (#x83 . #x0192) (#x84 . #x201E) + (#x85 . #x2026) (#x86 . #x2020) (#x87 . #x2021) (#x88 . #x02C6) + (#x89 . #x2030) (#x8A . #x0160) (#x8B . #x2039) (#x8C . #x0152) + (#x8E . #x017D) (#x91 . #x2018) (#x92 . #x2019) (#x93 . #x201C) + (#x94 . #x201D) (#x95 . #x2022) (#x96 . #x2013) (#x97 . #x2014) + (#x98 . #x02DC) (#x99 . #x2122) (#x9A . #x0161) (#x9B . #x203A) + (#x9C . #x0153) (#x9E . #x017E) (#x9F . #x0178))) + "*Alist of extra numeric entities and characters other than ISO 10646. +This table is used for decoding extra numeric entities to characters, +like \"€\" to the euro sign, mainly in html messages.") + ;;; Internal variables: ;;; Functions: @@ -907,7 +919,7 @@ mail with multiple parts is preferred to sending a Unicode one.") "Set the multibyte flag of the current buffer. Only do this if the default value of `enable-multibyte-characters' is non-nil. This is a no-op in XEmacs." - (set-buffer-multibyte t))) + (set-buffer-multibyte 'to))) (if (featurep 'xemacs) (defalias 'mm-disable-multibyte 'ignore) @@ -978,6 +990,7 @@ If the charset is `composition', return the actual one." ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) +;; `delete-dups' is not available in XEmacs 21.4. (if (fboundp 'delete-dups) (defalias 'mm-delete-duplicates 'delete-dups) (defun mm-delete-duplicates (list) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 83b38c8ae1e..a10700ee3d9 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -165,7 +165,7 @@ This can be either \"inline\" or \"attachment\".") ;; dependency on `message.el'. "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" - (lambda () (mm-uu-verbatim-marks-extract -1 0 1 -1)) + (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1)) nil) ;; Omitting [a-z8<] leads to false positives (bogus signature separators ;; and mailing list banners). diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 11e475d21ec..083781b0f9d 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -50,29 +50,19 @@ (defvar w3m-minor-mode-map) (defvar mm-text-html-renderer-alist - '((w3 . mm-inline-text-html-render-with-w3) + '((shr . mm-shr) + (w3 . mm-inline-text-html-render-with-w3) (w3m . mm-inline-text-html-render-with-w3m) (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) + (gnus-w3m . gnus-article-html) (links mm-inline-render-with-file mm-links-remove-leading-blank "links" "-dump" file) - (lynx mm-inline-render-with-stdin nil - "lynx" "-dump" "-force_html" "-stdin" "-nolist") - (html2text mm-inline-render-with-function html2text)) + (lynx mm-inline-render-with-stdin nil + "lynx" "-dump" "-force_html" "-stdin" "-nolist") + (html2text mm-inline-render-with-function html2text)) "The attributes of renderer types for text/html.") -(defvar mm-text-html-washer-alist - '((w3 . gnus-article-wash-html-with-w3) - (w3m . gnus-article-wash-html-with-w3m) - (w3m-standalone . gnus-article-wash-html-with-w3m-standalone) - (links mm-inline-wash-with-file - mm-links-remove-leading-blank - "links" "-dump" file) - (lynx mm-inline-wash-with-stdin nil - "lynx" "-dump" "-force_html" "-stdin" "-nolist") - (html2text html2text)) - "The attributes of washer types for text/html.") - (defcustom mm-fill-flowed t "If non-nil a format=flowed article will be displayed flowed." :type 'boolean @@ -92,6 +82,8 @@ ;;; Functions for displaying various formats inline ;;; +(autoload 'gnus-rescale-image "gnus-util") + (defun mm-inline-image-emacs (handle) (let ((b (point-marker)) (inhibit-read-only t)) @@ -426,7 +418,7 @@ (buffer-string))))) (defun mm-inline-text-html (handle) - (let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer)) + (let* ((func mm-text-html-renderer) (entry (assq func mm-text-html-renderer-alist)) (inhibit-read-only t)) (if entry @@ -661,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")))) @@ -688,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") @@ -700,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")) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 43e86cb6c34..7dc6b76afae 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -128,6 +128,14 @@ It is necessary to work against a bug in certain clients." :type 'boolean :group 'message) +(defcustom mml-enable-flowed t + "If non-nil, enable format=flowed usage when encoding a message. +This is only performed when filling on text/plain with hard +newlines in the text." + :version "24.1" + :type 'boolean + :group 'message) + (defvar mml-tweak-type-alist nil "A list of (TYPE . FUNCTION) for tweaking MML parts. TYPE is a string containing a regexp to match the MIME type. FUNCTION @@ -546,7 +554,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." ;; in the mml tag or it says "flowed" and there ;; actually are hard newlines in the text. (let (use-hard-newlines) - (when (and (string= type "text/plain") + (when (and mml-enable-flowed + (string= type "text/plain") (not (string= (cdr (assq 'sign cont)) "pgp")) (or (null (assq 'format cont)) (string= (cdr (assq 'format cont)) @@ -1457,6 +1466,7 @@ or the `pop-to-buffer' function." (require 'gnus-msg) ; for gnus-setup-posting-charset (save-excursion (let* ((buf (current-buffer)) + (article-editing (eq major-mode 'gnus-article-edit-mode)) (message-options message-options) (message-this-is-mail (message-mail-p)) (message-this-is-news (message-news-p)) @@ -1476,15 +1486,19 @@ or the `pop-to-buffer' function." (mml-preview-insert-mail-followup-to) (let ((message-deletable-headers (if (message-news-p) nil - message-deletable-headers))) + message-deletable-headers)) + (mail-header-separator (if article-editing + "" + mail-header-separator))) (message-generate-headers (copy-sequence (if (message-news-p) message-required-news-headers - message-required-mail-headers)))) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (replace-match "\n")) - (let ((mail-header-separator ""));; mail-header-separator is removed. + message-required-mail-headers))) + (unless article-editing + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) + (replace-match "\n")) + (setq mail-header-separator "")) (message-sort-headers) (mml-to-mime)) (if raw @@ -1495,7 +1509,8 @@ or the `pop-to-buffer' function." (mm-disable-multibyte) (insert s))) (let ((gnus-newsgroup-charset (car message-posting-charset)) - gnus-article-prepare-hook gnus-original-article-buffer) + gnus-article-prepare-hook gnus-original-article-buffer + gnus-displaying-mime) (run-hooks 'gnus-article-decode-hook) (let ((gnus-newsgroup-name "dummy") (gnus-newsrc-hashtb (or gnus-newsrc-hashtb diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 55ebf8cbf0d..e247abbb476 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -941,6 +941,7 @@ Whether the passphrase is cached at all is controlled by (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 @@ Whether the passphrase is cached at all is controlled by (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 @@ If no one is selected, default secret key is used. " 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 @@ If no one is selected, default secret key is used. " (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 @@ If no one is selected, default secret key is used. " (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 @@ If no one is selected, symmetric encryption will be performed. " (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) @@ -1075,7 +1077,7 @@ If no one is selected, default secret key is used. " signer))) (error "No secret key for %s" signer)) signer-key) - mml2015-signers))))))) + (cons sender mml2015-signers)))))))) (epg-context-set-signers context signers)) (epg-context-set-armor context t) (epg-context-set-textmode context t) diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 8f1f6ec7bc3..6e91517baab 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -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))) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 7235e4b0332..e634b9cada3 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -1061,9 +1061,9 @@ all. This may very well take some time.") (file-directory-p dir)) (nndiary-generate-nov-databases-1 dir seen)))) ;; Do this directory. - (let ((files (sort (nnheader-article-to-file-alist dir) + (let ((nndiary-files (sort (nnheader-article-to-file-alist dir) 'car-less-than-car))) - (if (not files) + (if (not nndiary-files) (let* ((group (nnheader-file-to-group (directory-file-name dir) nndiary-directory)) (info (cadr (assoc group nndiary-group-alist)))) @@ -1071,11 +1071,11 @@ all. This may very well take some time.") (setcar info (1+ (cdr info))))) (funcall nndiary-generate-active-function dir) ;; Generate the nov file. - (nndiary-generate-nov-file dir files) + (nndiary-generate-nov-file dir nndiary-files) (unless no-active (nnmail-save-active nndiary-group-alist nndiary-active-file)))))) -(defvar files) +(defvar nndiary-files) ; dynamically bound in nndiary-generate-nov-databases-1 (defun nndiary-generate-active-info (dir) ;; Update the active info for this group. (let* ((group (nnheader-file-to-group @@ -1084,9 +1084,9 @@ all. This may very well take some time.") (last (or (caadr entry) 0))) (setq nndiary-group-alist (delq entry nndiary-group-alist)) (push (list group - (cons (or (caar files) (1+ last)) + (cons (or (caar nndiary-files) (1+ last)) (max last - (or (caar (last files)) + (or (caar (last nndiary-files)) 0)))) nndiary-group-alist))) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 6c9ef1cef87..0dee06d2937 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -138,6 +138,14 @@ from the document.") (generate-head-function . nndoc-generate-lanl-gov-head) (article-transform-function . nndoc-transform-lanl-gov-announce) (subtype preprints guess)) + (git + (file-begin . "\n- Log ---.*") + (article-begin . "^commit ") + (head-begin . "^Author: ") + (body-begin . "^$") + (file-end . "\n-----------------------------------------------------------------------") + (article-transform-function . nndoc-transform-git-article) + (header-transform-function . nndoc-transform-git-headers)) (rfc822-forward (article-begin . "^\n+") (body-end-function . nndoc-rfc822-forward-body-end-function) @@ -193,6 +201,7 @@ from the document.") (defvoo nndoc-prepare-body-function nil) (defvoo nndoc-generate-head-function nil) (defvoo nndoc-article-transform-function nil) +(defvoo nndoc-header-transform-function nil) (defvoo nndoc-article-begin-function nil) (defvoo nndoc-generate-article-function nil) (defvoo nndoc-dissection-function nil) @@ -223,17 +232,22 @@ from the document.") (while articles (when (setq entry (cdr (assq (setq article (pop articles)) nndoc-dissection-alist))) - (insert (format "221 %d Article retrieved.\n" article)) - (if nndoc-generate-head-function - (funcall nndoc-generate-head-function article) - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry))) - (goto-char (point-max)) - (unless (eq (char-after (1- (point))) ?\n) - (insert "\n")) - (insert (format "Lines: %d\n" (nth 4 entry))) - (insert ".\n"))) - + (let ((start (point))) + (insert (format "221 %d Article retrieved.\n" article)) + (if nndoc-generate-head-function + (funcall nndoc-generate-head-function article) + (insert-buffer-substring + nndoc-current-buffer (car entry) (nth 1 entry))) + (goto-char (point-max)) + (unless (eq (char-after (1- (point))) ?\n) + (insert "\n")) + (insert (format "Lines: %d\n" (nth 4 entry))) + (insert ".\n") + (when nndoc-header-transform-function + (save-excursion + (save-restriction + (narrow-to-region start (point)) + (funcall nndoc-header-transform-function entry))))))) (nnheader-fold-continuation-lines) 'headers))))) @@ -373,6 +387,7 @@ from the document.") nndoc-file-end nndoc-article-begin nndoc-body-begin nndoc-body-end-function nndoc-body-end nndoc-prepare-body-function nndoc-article-transform-function + nndoc-header-transform-function nndoc-generate-head-function nndoc-body-begin-function nndoc-head-begin-function nndoc-generate-article-function @@ -649,6 +664,30 @@ from the document.") (defun nndoc-slack-digest-type-p () 0) +(defun nndoc-git-type-p () + (and (search-forward "\n- Log ---" nil t) + (search-forward "\ncommit " nil t) + (search-forward "\nAuthor: " nil t))) + +(defun nndoc-transform-git-article (article) + (goto-char (point-min)) + (when (re-search-forward "^Author: " nil t) + (replace-match "From: " t t))) + +(defun nndoc-transform-git-headers (entry) + (goto-char (point-min)) + (when (re-search-forward "^Author: " nil t) + (replace-match "From: " t t)) + (let (subject) + (with-current-buffer nndoc-current-buffer + (goto-char (car entry)) + (when (search-forward "\n\n" nil t) + (setq subject (buffer-substring (point) (line-end-position))))) + (when subject + (goto-char (point-min)) + (forward-line 1) + (insert (format "Subject: %s\n" subject))))) + (defun nndoc-lanl-gov-announce-type-p () (when (let ((case-fold-search nil)) (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+\\|arXiv:\\)" nil t)) @@ -879,7 +918,8 @@ from the document.") (setq body-end (point)) (push (list (incf i) head-begin head-end body-begin body-end (count-lines body-begin body-end)) - nndoc-dissection-alist))))))) + nndoc-dissection-alist))))) + (setq nndoc-dissection-alist (nreverse nndoc-dissection-alist)))) (defun nndoc-article-begin () (if nndoc-article-begin-function diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 668b75a7838..5de8653948f 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -1186,19 +1186,7 @@ This command does not work if you use short group names." (nnfolder-open-server server)) (unless nnfolder-marks-is-evil (nnfolder-open-marks group server) - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) nil - "Unknown request-set-mark action: %s" what) - (dolist (mark marks) - (setq nnfolder-marks (gnus-update-alist-soft - mark - (funcall (if (eq what 'add) 'gnus-range-add - 'gnus-remove-from-range) - (cdr (assoc mark nnfolder-marks)) range) - nnfolder-marks))))) + (setq nnfolder-marks (nnheader-update-marks-actions nnfolder-marks actions)) (nnfolder-save-marks group server)) nil) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 4bf4588687e..cc2706eaf2a 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -366,15 +366,13 @@ on your system, you could say something like: (setq num 0 beg (point-min) end (point-max)) - (goto-char (point-min)) ;; Search to the beginning of the next header. Error ;; messages do not begin with 2 or 3. (when (re-search-forward "^[23][0-9]+ " nil t) - (end-of-line) (setq num (read cur) beg (point) end (if (search-forward "\n.\n" nil t) - (- (point) 2) + (goto-char (- (point) 2)) (point))))) (with-temp-buffer (insert-buffer-substring cur beg end) @@ -1080,6 +1078,26 @@ See `find-file-noselect' for the arguments." (truncate nnheader-read-timeout)) 1000)))) +(defun nnheader-update-marks-actions (backend-marks actions) + (dolist (action actions) + (let ((range (nth 0 action)) + (what (nth 1 action)) + (marks (nth 2 action))) + (dolist (mark marks) + (setq backend-marks + (gnus-update-alist-soft + mark + (cond + ((eq what 'add) + (gnus-range-add (cdr (assoc mark backend-marks)) range)) + ((eq what 'del) + (gnus-remove-from-range + (cdr (assoc mark backend-marks)) range)) + ((eq what 'set) + range)) + backend-marks))))) + backend-marks) + (when (featurep 'xemacs) (require 'nnheaderxm)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index bb9f5691984..0462cf946eb 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -44,6 +44,8 @@ (require 'utf7) (require 'tls) (require 'parse-time) +(require 'nnmail) +(require 'proto-stream) (autoload 'auth-source-forget-user-or-password "auth-source") (autoload 'auth-source-user-or-password "auth-source") @@ -58,9 +60,10 @@ If nnimap-stream is `ssl', this will default to `imaps'. If not, it will default to `imap'.") -(defvoo nnimap-stream 'ssl +(defvoo nnimap-stream 'undecided "How nnimap will talk to the IMAP server. -Values are `ssl', `network', `starttls' or `shell'.") +Values are `ssl', `network', `starttls' or `shell'. +The default is to try `ssl' first, and then `network'.") (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) (if (listp imap-shell-program) @@ -78,6 +81,9 @@ Uses the same syntax as nnmail-split-methods") (defvoo nnimap-split-fancy nil "Uses the same syntax as nnmail-split-fancy.") +(defvoo nnimap-unsplittable-articles '(%Deleted %Seen) + "Articles with the flags in the list will not be considered when splitting.") + (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'" "Emacs 24.1") @@ -118,7 +124,7 @@ textual parts.") (defstruct nnimap group process commands capabilities select-result newlinep server - last-command-time greeting) + last-command-time greeting examined) (defvar nnimap-object nil) @@ -136,6 +142,16 @@ textual parts.") (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) +(defun nnimap-header-parameters () + (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" + (format + (if (nnimap-ver4-p) + "BODY.PEEK[HEADER.FIELDS %s]" + "RFC822.HEADER.LINES %s") + (append '(Subject From Date Message-Id + References In-Reply-To Xref) + nnmail-extra-headers)))) + (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old) (with-current-buffer nntp-server-buffer (erase-buffer) @@ -146,14 +162,7 @@ textual parts.") (nnimap-send-command "UID FETCH %s %s" (nnimap-article-ranges (gnus-compress-sequence articles)) - (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" - (format - (if (nnimap-ver4-p) - "BODY.PEEK[HEADER.FIELDS %s]" - "RFC822.HEADER.LINES %s") - (append '(Subject From Date Message-Id - References In-Reply-To Xref) - nnmail-extra-headers)))) + (nnimap-header-parameters)) t) (nnimap-transform-headers)) (insert-buffer-substring @@ -171,11 +180,12 @@ textual parts.") (return))) (setq article (match-string 1)) ;; Unfold quoted {number} strings. - (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n" + (while (re-search-forward "[^]][ (]{\\([0-9]+\\)}\r?\n" (1+ (line-end-position)) t) (setq size (string-to-number (match-string 1))) (delete-region (+ (match-beginning 0) 2) (point)) - (setq string (delete-region (point) (+ (point) size))) + (setq string (buffer-substring (point) (+ (point) size))) + (delete-region (point) (+ (point) size)) (insert (format "%S" string))) (setq bytes (nnimap-get-length) lines nil) @@ -200,11 +210,22 @@ textual parts.") (insert (format "Chars: %s\n" size))) (when lines (insert (format "Lines: %s\n" lines))) - (re-search-forward "^\r$") + (unless (re-search-forward "^\r$" nil t) + (goto-char (point-max))) (delete-region (line-beginning-position) (line-end-position)) (insert ".") (forward-line 1))))) +(defun nnimap-unfold-quoted-lines () + ;; Unfold quoted {number} strings. + (let (size string) + (while (re-search-forward " {\\([0-9]+\\)}\r?\n" nil t) + (setq size (string-to-number (match-string 1))) + (delete-region (1+ (match-beginning 0)) (point)) + (setq string (buffer-substring (point) (+ (point) size))) + (delete-region (point) (+ (point) size)) + (insert (format "%S" string))))) + (defun nnimap-get-length () (and (re-search-forward "{\\([0-9]+\\)}" (line-end-position) t) (string-to-number (match-string 1)))) @@ -249,16 +270,6 @@ textual parts.") (push (current-buffer) nnimap-process-buffers) (current-buffer))) -(defun nnimap-open-shell-stream (name buffer host port) - (let ((process-connection-type nil)) - (start-process name buffer shell-file-name - shell-command-switch - (format-spec - nnimap-shell-program - (format-spec-make - ?s host - ?p port))))) - (defun nnimap-credentials (address ports &optional inhibit-create) (let (port credentials) ;; Request the credentials from all ports, but only query on the @@ -280,7 +291,7 @@ textual parts.") (with-current-buffer buffer (when (and nnimap-object (nnimap-last-command-time nnimap-object) - (> (time-to-seconds + (> (gnus-float-time (time-subtract now (nnimap-last-command-time nnimap-object))) @@ -288,110 +299,79 @@ textual parts.") (* 5 60))) (nnimap-send-command "NOOP"))))))) -(declare-function gnutls-negotiate "subr" (fn file &optional arglist fileonly)) - (defun nnimap-open-connection (buffer) + ;; Be backwards-compatible -- the earlier value of nnimap-stream was + ;; `ssl' when nnimap-server-port was nil. Sort of. + (when (and nnimap-server-port + (eq nnimap-stream 'undecided)) + (setq nnimap-stream 'ssl)) + (let ((stream + (if (eq nnimap-stream 'undecided) + (loop for type in '(ssl network) + for stream = (let ((nnimap-stream type)) + (nnimap-open-connection-1 buffer)) + while (eq stream 'no-connect) + finally (return stream)) + (nnimap-open-connection-1 buffer)))) + (if (eq stream 'no-connect) + nil + stream))) + +(defun nnimap-open-connection-1 (buffer) (unless nnimap-keepalive-timer (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) 'nnimap-keepalive))) - (block nil - (with-current-buffer (nnimap-make-process-buffer buffer) - (let* ((coding-system-for-read 'binary) - (coding-system-for-write 'binary) - (port nil) - (ports - (cond - ((or (eq nnimap-stream 'network) - (and (eq nnimap-stream 'starttls) - (fboundp 'open-gnutls-stream))) - (message "Opening connection to %s..." nnimap-address) - (open-network-stream - "*nnimap*" (current-buffer) nnimap-address - (setq port - (or nnimap-server-port - (if (netrc-find-service-number "imap") - "imap" - "143")))) - '("143" "imap")) - ((eq nnimap-stream 'shell) - (message "Opening connection to %s via shell..." nnimap-address) - (nnimap-open-shell-stream - "*nnimap*" (current-buffer) nnimap-address - (setq port (or nnimap-server-port "imap"))) - '("imap")) - ((eq nnimap-stream 'starttls) - (message "Opening connection to %s via starttls..." - nnimap-address) - (let ((tls-program - '("openssl s_client -connect %h:%p -no_ssl2 -ign_eof -starttls imap"))) - (open-tls-stream - "*nnimap*" (current-buffer) nnimap-address - (setq port (or nnimap-server-port "imap")))) - '("imap")) - ((memq nnimap-stream '(ssl tls)) - (message "Opening connection to %s via tls..." nnimap-address) - (funcall (if (fboundp 'open-gnutls-stream) - 'open-gnutls-stream - 'open-tls-stream) - "*nnimap*" (current-buffer) nnimap-address - (setq port - (or nnimap-server-port - (if (netrc-find-service-number "imaps") - "imaps" - "993")))) - '("143" "993" "imap" "imaps")) - (t - (error "Unknown stream type: %s" nnimap-stream)))) - connection-result login-result credentials) - (setf (nnimap-process nnimap-object) - (get-buffer-process (current-buffer))) - (if (not (and (nnimap-process nnimap-object) - (memq (process-status (nnimap-process nnimap-object)) - '(open run)))) - (nnheader-report 'nnimap "Unable to contact %s:%s via %s" - nnimap-address port nnimap-stream) - (gnus-set-process-query-on-exit-flag - (nnimap-process nnimap-object) nil) - (if (not (setq connection-result (nnimap-wait-for-connection))) - (nnheader-report 'nnimap - "%s" (buffer-substring - (point) (line-end-position))) + (with-current-buffer (nnimap-make-process-buffer buffer) + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (port nil) + (ports + (cond + ((or (eq nnimap-stream 'network) + (eq nnimap-stream 'starttls)) + (nnheader-message 7 "Opening connection to %s..." + nnimap-address) + '("143" "imap")) + ((eq nnimap-stream 'shell) + (nnheader-message 7 "Opening connection to %s via shell..." + nnimap-address) + '("imap")) + ((memq nnimap-stream '(ssl tls)) + (nnheader-message 7 "Opening connection to %s via tls..." + nnimap-address) + '("143" "993" "imap" "imaps")) + (t + (error "Unknown stream type: %s" nnimap-stream)))) + (proto-stream-always-use-starttls t) + login-result credentials) + (when nnimap-server-port + (setq ports (append ports (list nnimap-server-port)))) + (destructuring-bind (stream greeting capabilities) + (open-protocol-stream + "*nnimap*" (current-buffer) nnimap-address (car (last ports)) + :type nnimap-stream + :shell-command nnimap-shell-program + :capability-command "1 CAPABILITY\r\n" + :success " OK " + :starttls-function + (lambda (capabilities) + (when (gnus-string-match-p "STARTTLS" capabilities) + "1 STARTTLS\r\n"))) + (setf (nnimap-process nnimap-object) stream) + (if (not stream) + (progn + (nnheader-report 'nnimap "Unable to contact %s:%s via %s" + nnimap-address port nnimap-stream) + 'no-connect) + (gnus-set-process-query-on-exit-flag stream nil) + (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting)) + (nnheader-report 'nnimap "%s" greeting) ;; Store the greeting (for debugging purposes). - (setf (nnimap-greeting nnimap-object) - (buffer-substring (line-beginning-position) - (line-end-position))) - ;; Store the capabilities. + (setf (nnimap-greeting nnimap-object) greeting) (setf (nnimap-capabilities nnimap-object) - (mapcar - #'upcase - (nnimap-find-parameter - "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))) - (when nnimap-server-port - (push (format "%s" nnimap-server-port) ports)) - ;; If this is a STARTTLS-capable server, then sever the - ;; connection and start a STARTTLS connection instead. - (cond - ((and (or (and (eq nnimap-stream 'network) - (member "STARTTLS" - (nnimap-capabilities nnimap-object))) - (eq nnimap-stream 'starttls)) - (fboundp 'open-gnutls-stream)) - (nnimap-command "STARTTLS") - (gnutls-negotiate (nnimap-process nnimap-object) nil)) - ((and (eq nnimap-stream 'network) - (member "STARTTLS" (nnimap-capabilities nnimap-object))) - (let ((nnimap-stream 'starttls)) - (let ((tls-process - (nnimap-open-connection buffer))) - ;; If the STARTTLS connection was successful, we - ;; kill our first non-encrypted connection. If it - ;; wasn't successful, we just use our unencrypted - ;; connection. - (when (memq (process-status tls-process) '(open run)) - (delete-process (nnimap-process nnimap-object)) - (kill-buffer (current-buffer)) - (return tls-process)))))) - (unless (equal connection-result "PREAUTH") + (mapcar #'upcase + (split-string capabilities))) + (unless (gnus-string-match-p "[*.] PREAUTH" greeting) (if (not (setq credentials (if (eq nnimap-authenticator 'anonymous) (list "anonymous" @@ -405,9 +385,18 @@ textual parts.") ;; physical address. (nnimap-credentials nnimap-address ports))))) (setq nnimap-object nil) - (setq login-result (nnimap-command "LOGIN %S %S" - (car credentials) - (cadr credentials))) + (setq login-result + (if (and (nnimap-capability "AUTH=PLAIN") + (nnimap-capability "LOGINDISABLED")) + (nnimap-command + "AUTHENTICATE PLAIN %s" + (base64-encode-string + (format "\000%s\000%s" + (nnimap-quote-specials (car credentials)) + (nnimap-quote-specials (cadr credentials))))) + (nnimap-command "LOGIN %S %S" + (car credentials) + (cadr credentials)))) (unless (car login-result) ;; If the login failed, then forget the credentials ;; that are now possibly cached. @@ -420,10 +409,20 @@ textual parts.") (delete-process (nnimap-process nnimap-object)) (setq nnimap-object nil)))) (when nnimap-object - (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) + (when (nnimap-capability "QRESYNC") (nnimap-command "ENABLE QRESYNC")) (nnimap-process nnimap-object)))))))) +(defun nnimap-quote-specials (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward "[\\\"]" nil t) + (forward-char -1) + (insert "\\") + (forward-char 1)) + (buffer-string))) + (defun nnimap-find-parameter (parameter elems) (let (result) (dolist (elem elems) @@ -474,7 +473,7 @@ textual parts.") (let ((start (point))) (forward-sexp 1) (downcase-region start (point)) - (goto-char (point)) + (goto-char start) (read (current-buffer)))) parts (nnimap-find-wanted-parts structure)))) (when (if parts @@ -487,12 +486,28 @@ textual parts.") (nnheader-ms-strip-cr) (cons group article))))))))) -(defun nnimap-get-whole-article (article) +(deffoo nnimap-request-head (article &optional group server to-buffer) + (when (nnimap-possibly-change-group group server) + (with-current-buffer (nnimap-buffer) + (when (stringp article) + (setq article (nnimap-find-article-by-message-id group article))) + (nnimap-get-whole-article + article (format "UID FETCH %%d %s" + (nnimap-header-parameters))) + (let ((buffer (current-buffer))) + (with-current-buffer (or to-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring buffer) + (nnheader-ms-strip-cr) + (cons group article)))))) + +(defun nnimap-get-whole-article (article &optional command) (let ((result (nnimap-command - (if (nnimap-ver4-p) - "UID FETCH %d BODY.PEEK[]" - "UID FETCH %d RFC822.PEEK") + (or command + (if (nnimap-ver4-p) + "UID FETCH %d BODY.PEEK[]" + "UID FETCH %d RFC822.PEEK")) article))) ;; Check that we really got an article. (goto-char (point-min)) @@ -510,8 +525,11 @@ textual parts.") (delete-region (point) (point-max))) t))) +(defun nnimap-capability (capability) + (member capability (nnimap-capabilities nnimap-object))) + (defun nnimap-ver4-p () - (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) + (nnimap-capability "IMAP4REV1")) (defun nnimap-get-partial-article (article parts structure) (let ((result @@ -562,9 +580,9 @@ textual parts.") (pop bstruc)) (setq type (car bstruc)) (setq bstruc (car (cdr bstruc))) - (when (and (stringp (car bstruc)) - (string= (downcase (car bstruc)) "boundary")) - (setq boundary (cadr bstruc)))) + (let ((has-boundary (member "boundary" bstruc))) + (when has-boundary + (setq boundary (cadr has-boundary))))) (when subp (insert (format "Content-type: multipart/%s; boundary=%S\n\n" (downcase type) boundary))) @@ -614,7 +632,14 @@ textual parts.") (nreverse parts))) (deffoo nnimap-request-group (group &optional server dont-check info) - (let ((result (nnimap-possibly-change-group group server)) + (let ((result (nnimap-possibly-change-group + ;; Don't SELECT the group if we're going to select it + ;; later, anyway. + (if (and dont-check + (assoc group nnimap-current-infos)) + nil + group) + server)) articles active marks high low) (with-current-buffer nntp-server-buffer (when result @@ -631,6 +656,7 @@ textual parts.") (nnimap-send-command "SELECT %S" (utf7-encode group t))) (flag-sequence (nnimap-send-command "UID FETCH 1:* FLAGS"))) + (setf (nnimap-group nnimap-object) group) (nnimap-wait-for-response flag-sequence) (setq marks (nnimap-flags-to-marks @@ -639,7 +665,8 @@ textual parts.") 1 group "SELECT"))))) (when (and info marks) - (nnimap-update-infos marks (list info))) + (nnimap-update-infos marks (list info)) + (nnimap-store-info info (gnus-active (gnus-info-group info)))) (goto-char (point-max)) (let ((uidnext (nth 5 (car marks)))) (setq high (or (if uidnext @@ -666,15 +693,17 @@ textual parts.") (deffoo nnimap-request-rename-group (group new-name &optional server) (when (nnimap-possibly-change-group nil server) (with-current-buffer (nnimap-buffer) - ;; Make sure we don't have this group open read/write by asking - ;; to examine a mailbox that doesn't exist. This seems to be - ;; the only way that allows us to reliably go back to unselected - ;; state on Courier. - (nnimap-command "EXAMINE DOES.NOT.EXIST") - (setf (nnimap-group nnimap-object) nil) + (nnimap-unselect-group) (car (nnimap-command "RENAME %S %S" (utf7-encode group t) (utf7-encode new-name t)))))) +(defun nnimap-unselect-group () + ;; Make sure we don't have this group open read/write by asking + ;; to examine a mailbox that doesn't exist. This seems to be + ;; the only way that allows us to reliably go back to unselected + ;; state on Courier. + (nnimap-command "EXAMINE DOES.NOT.EXIST")) + (deffoo nnimap-request-expunge-group (group &optional server) (when (nnimap-possibly-change-group group server) (with-current-buffer (nnimap-buffer) @@ -704,7 +733,11 @@ textual parts.") (deffoo nnimap-request-move-article (article group server accept-form &optional last internal-move-group) (with-temp-buffer - (when (nnimap-request-article article group server (current-buffer)) + (mm-disable-multibyte) + (when (funcall (if internal-move-group + 'nnimap-request-head + 'nnimap-request-article) + article group server (current-buffer)) ;; If the move is internal (on the same server), just do it the easy ;; way. (let ((message-id (message-field-value "message-id"))) @@ -717,8 +750,9 @@ textual parts.") (when (car result) (nnimap-delete-article article) (cons internal-move-group - (nnimap-find-article-by-message-id - internal-move-group message-id)))) + (or (nnimap-find-uid-response "COPYUID" (cadr result)) + (nnimap-find-article-by-message-id + internal-move-group message-id))))) ;; Move the article to a different method. (let ((result (eval accept-form))) (when result @@ -734,7 +768,7 @@ textual parts.") ((and force (eq nnmail-expiry-target 'delete)) (unless (nnimap-delete-article (gnus-compress-sequence articles)) - (message "Article marked for deletion, but not expunged.")) + (nnheader-message 7 "Article marked for deletion, but not expunged.")) nil) (t (let ((deletable-articles @@ -756,21 +790,42 @@ textual parts.") (defun nnimap-process-expiry-targets (articles group server) (let ((deleted-articles nil)) - (dolist (article articles) - (let ((target nnmail-expiry-target)) - (with-temp-buffer - (when (nnimap-request-article article group server (current-buffer)) - (message "Expiring article %s:%d" group article) - (when (functionp target) - (setq target (funcall target group))) - (when (and target - (not (eq target 'delete))) - (if (or (gnus-request-group target t) - (gnus-request-create-group target)) - (nnmail-expiry-target-group target group) - (setq target nil))) - (when target - (push article deleted-articles)))))) + (cond + ;; shortcut further processing if we're going to delete the articles + ((eq nnmail-expiry-target 'delete) + (setq deleted-articles articles) + t) + ;; or just move them to another folder on the same IMAP server + ((and (not (functionp nnmail-expiry-target)) + (gnus-server-equal (gnus-group-method nnmail-expiry-target) + (gnus-server-to-method + (format "nnimap:%s" server)))) + (and (nnimap-possibly-change-group group server) + (with-current-buffer (nnimap-buffer) + (nnheader-message 7 "Expiring articles from %s: %s" group articles) + (nnimap-command + "UID COPY %s %S" + (nnimap-article-ranges (gnus-compress-sequence articles)) + (utf7-encode (gnus-group-real-name nnmail-expiry-target) t)) + (setq deleted-articles articles))) + t) + (t + (dolist (article articles) + (let ((target nnmail-expiry-target)) + (with-temp-buffer + (mm-disable-multibyte) + (when (nnimap-request-article article group server (current-buffer)) + (nnheader-message 7 "Expiring article %s:%d" group article) + (when (functionp target) + (setq target (funcall target group))) + (when (and target + (not (eq target 'delete))) + (if (or (gnus-request-group target t) + (gnus-request-create-group target)) + (nnmail-expiry-target-group target group) + (setq target nil))) + (when target + (push article deleted-articles)))))))) ;; Change back to the current group again. (nnimap-possibly-change-group group server) (setq deleted-articles (nreverse deleted-articles)) @@ -797,8 +852,10 @@ textual parts.") (defun nnimap-find-article-by-message-id (group message-id) (with-current-buffer (nnimap-buffer) (erase-buffer) - (setf (nnimap-group nnimap-object) nil) - (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) + (unless (equal group (nnimap-group nnimap-object)) + (setf (nnimap-group nnimap-object) nil) + (setf (nnimap-examined nnimap-object) group) + (nnimap-send-command "EXAMINE %S" (utf7-encode group t))) (let ((sequence (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id)) article result) @@ -815,7 +872,7 @@ textual parts.") (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" (nnimap-article-ranges articles)) (cond - ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + ((nnimap-capability "UIDPLUS") (nnimap-command "UID EXPUNGE %s" (nnimap-article-ranges articles)) t) @@ -830,7 +887,7 @@ textual parts.") (when (and (nnimap-possibly-change-group nil server) nnimap-inbox nnimap-split-methods) - (message "nnimap %s splitting mail..." server) + (nnheader-message 7 "nnimap %s splitting mail..." server) (nnimap-split-incoming-mail))) (defun nnimap-marks-to-flags (marks) @@ -854,9 +911,10 @@ textual parts.") (setq sequence (nnimap-send-command "UID STORE %s %sFLAGS.SILENT (%s)" (nnimap-article-ranges range) - (if (eq action 'del) - "-" - "+") + (cond + ((eq action 'del) "-") + ((eq action 'add) "+") + ((eq action 'set) "")) (mapconcat #'identity flags " "))))))) ;; Wait for the last command to complete to avoid later ;; syncronisation problems with the stream. @@ -869,11 +927,18 @@ textual parts.") (let ((message-id (message-field-value "message-id")) sequence message) (nnimap-add-cr) - (setq message (buffer-string)) + (setq message (buffer-substring-no-properties (point-min) (point-max))) (with-current-buffer (nnimap-buffer) + ;; If we have this group open read-only, then unselect it + ;; before appending to it. + (when (equal (nnimap-examined nnimap-object) group) + (nnimap-unselect-group)) + (erase-buffer) (setq sequence (nnimap-send-command "APPEND %S {%d}" (utf7-encode group t) (length message))) + (unless nnimap-streaming + (nnimap-wait-for-connection "^[+]")) (process-send-string (get-buffer-process (current-buffer)) message) (process-send-string (get-buffer-process (current-buffer)) (if (nnimap-newlinep nnimap-object) @@ -882,10 +947,36 @@ textual parts.") (let ((result (nnimap-get-response sequence))) (if (not (car result)) (progn - (message "%s" (nnheader-get-report-string 'nnimap)) + (nnheader-message 7 "%s" (nnheader-get-report-string 'nnimap)) nil) (cons group - (nnimap-find-article-by-message-id group message-id)))))))) + (or (nnimap-find-uid-response "APPENDUID" (car result)) + (nnimap-find-article-by-message-id + group message-id))))))))) + +(defun nnimap-find-uid-response (name list) + (let ((result (car (last (nnimap-find-response-element name list))))) + (and result + (string-to-number result)))) + +(defun nnimap-find-response-element (name list) + (let (result) + (dolist (elem list) + (when (and (consp elem) + (equal name (car elem))) + (setq result elem))) + result)) + +(deffoo nnimap-request-replace-article (article group buffer) + (let (group-art) + (when (and (nnimap-possibly-change-group group nil) + ;; Put the article into the group. + (with-current-buffer buffer + (setq group-art + (nnimap-request-accept-article group nil t)))) + (nnimap-delete-article (list article)) + ;; Return the new article number. + (cdr group-art)))) (defun nnimap-add-cr () (goto-char (point-min)) @@ -893,15 +984,25 @@ textual parts.") (replace-match "\r\n" t t))) (defun nnimap-get-groups () - (let ((result (nnimap-command "LIST \"\" \"*\"")) + (erase-buffer) + (let ((sequence (nnimap-send-command "LIST \"\" \"*\"")) groups) - (when (car result) - (dolist (line (cdr result)) - (when (and (equal (car line) "LIST") - (not (and (caadr line) - (string-match "noselect" (caadr line))))) - (push (car (last line)) groups))) - (nreverse groups)))) + (nnimap-wait-for-response sequence) + (subst-char-in-region (point-min) (point-max) + ?\\ ?% t) + (goto-char (point-min)) + (nnimap-unfold-quoted-lines) + (goto-char (point-min)) + (while (search-forward "* LIST " nil t) + (let ((flags (read (current-buffer))) + (separator (read (current-buffer))) + (group (read (current-buffer)))) + (unless (member '%NoSelect flags) + (push (if (stringp group) + group + (format "%s" group)) + groups)))) + (nreverse groups))) (deffoo nnimap-request-list (&optional server) (nnimap-possibly-change-group nil server) @@ -915,6 +1016,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (setf (nnimap-group nnimap-object) nil) (dolist (group groups) + (setf (nnimap-examined nnimap-object) group) (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) group) sequences)) @@ -963,8 +1065,7 @@ textual parts.") (with-current-buffer (nnimap-buffer) (erase-buffer) (setf (nnimap-group nnimap-object) nil) - ;; QRESYNC handling isn't implemented. - (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object))) + (let ((qresyncp (nnimap-capability "QRESYNC")) params groups sequences active uidvalidity modseq group) ;; Go through the infos and gather the data needed to know ;; what and how to request the data. @@ -974,11 +1075,12 @@ textual parts.") active (cdr (assq 'active params)) uidvalidity (cdr (assq 'uidvalidity params)) modseq (cdr (assq 'modseq params))) + (setf (nnimap-examined nnimap-object) group) (if (and qresyncp uidvalidity modseq) (push - (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" + (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" (utf7-encode group t) uidvalidity modseq) 'qresync @@ -1002,12 +1104,7 @@ textual parts.") (utf7-encode group t)) (nnimap-send-command "UID FETCH %d:* FLAGS" start) start group command) - sequences))) - ;; Some servers apparently can't have many outstanding - ;; commands, so throttle them. - (when (and (not nnimap-streaming) - (car sequences)) - (nnimap-wait-for-response (caar sequences)))) + sequences)))) sequences)))) (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) @@ -1082,13 +1179,16 @@ textual parts.") (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 @@ -1102,12 +1202,13 @@ textual parts.") (unless (eq permanent-flags 'not-scanned) (gnus-group-set-parameter info 'permanent-flags - (if (memq '%* permanent-flags) - t - nil))) + (and (or (memq '%* permanent-flags) + (memq '%Seen permanent-flags)) + permanent-flags))) ;; Update marks and read articles if this isn't a ;; read-only IMAP group. - (when (cdr (assq 'permanent-flags (gnus-info-params info))) + (when (setq permanent-flags + (cdr (assq 'permanent-flags (gnus-info-params info)))) (if (and highestmodseq (not start-article)) ;; We've gotten the data by QRESYNCing. @@ -1133,27 +1234,33 @@ textual parts.") (gnus-info-read info)) (gnus-info-read info)) read))) - (gnus-info-set-read info read) + (when (or (not (listp permanent-flags)) + (memq '%Seen permanent-flags)) + (gnus-info-set-read info read)) ;; Update the marks. (setq marks (gnus-info-marks info)) (dolist (type (cdr nnimap-mark-alist)) - (let ((old-marks (assoc (car type) marks)) - (new-marks - (gnus-compress-sequence - (cdr (or (assoc (caddr type) flags) ; %Flagged - (assoc (intern (cadr type) obarray) flags) - (assoc (cadr type) flags)))))) ; "\Flagged" - (setq marks (delq old-marks marks)) - (pop old-marks) - (when (and old-marks - (> start-article 1)) - (setq old-marks (gnus-range-difference - old-marks - (cons start-article high))) - (setq new-marks (gnus-range-nconcat old-marks new-marks))) - (when new-marks - (push (cons (car type) new-marks) marks))) - (gnus-info-set-marks info marks t))))) + (when (or (not (listp permanent-flags)) + (memq (car (assoc (caddr type) flags)) + permanent-flags) + (memq '%* permanent-flags)) + (let ((old-marks (assoc (car type) marks)) + (new-marks + (gnus-compress-sequence + (cdr (or (assoc (caddr type) flags) ; %Flagged + (assoc (intern (cadr type) obarray) flags) + (assoc (cadr type) flags)))))) ; "\Flagged" + (setq marks (delq old-marks marks)) + (pop old-marks) + (when (and old-marks + (> start-article 1)) + (setq old-marks (gnus-range-difference + old-marks + (cons start-article high))) + (setq new-marks (gnus-range-nconcat old-marks new-marks))) + (when new-marks + (push (cons (car type) new-marks) marks))))) + (gnus-info-set-marks info marks t)))) ;; Note the active level for the next run-through. (gnus-group-set-parameter info 'active (gnus-active group)) (gnus-group-set-parameter info 'uidvalidity uidvalidity) @@ -1277,7 +1384,7 @@ textual parts.") (goto-char start) (setq vanished (and (eq flag-sequence 'qresync) - (re-search-forward "VANISHED.* \\([0-9:,]+\\)" + (re-search-forward "^\\* VANISHED .* \\([0-9:,]+\\)" (or end (point-min)) t) (match-string 1))) (goto-char start) @@ -1316,24 +1423,25 @@ textual parts.") (setq nnimap-status-string "Read-only server") nil) -(deffoo nnimap-request-thread (id) - (let* ((refs (split-string - (or (mail-header-references (gnus-summary-article-header)) - ""))) - (cmd (let ((value - (format - "(OR HEADER REFERENCES %s HEADER Message-Id %s)" - id id))) - (dolist (refid refs value) - (setq value (format - "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" - refid refid value))))) - (result - (with-current-buffer (nnimap-buffer) - (nnimap-command "UID SEARCH %s" cmd)))) - (gnus-fetch-headers (and (car result) - (delete 0 (mapcar #'string-to-number - (cdr (assoc "SEARCH" (cdr result))))))))) +(deffoo nnimap-request-thread (header) + (let* ((id (mail-header-id header)) + (refs (split-string + (or (mail-header-references header) + ""))) + (cmd (let ((value + (format + "(OR HEADER REFERENCES %s HEADER Message-Id %s)" + id id))) + (dolist (refid refs value) + (setq value (format + "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" + refid refid value))))) + (result (with-current-buffer (nnimap-buffer) + (nnimap-command "UID SEARCH %s" cmd)))) + (gnus-fetch-headers + (and (car result) (delete 0 (mapcar #'string-to-number + (cdr (assoc "SEARCH" (cdr result)))))) + nil t))) (defun nnimap-possibly-change-group (group server) (let ((open-result t)) @@ -1379,6 +1487,10 @@ textual parts.") (if (nnimap-newlinep nnimap-object) "" "\r")))) + ;; Some servers apparently can't have many outstanding + ;; commands, so throttle them. + (unless nnimap-streaming + (nnimap-wait-for-response nnimap-sequence)) nnimap-sequence) (defun nnimap-log-command (command) @@ -1404,12 +1516,14 @@ textual parts.") (nnimap-wait-for-response sequence) (nnimap-parse-response)) -(defun nnimap-wait-for-connection () +(defun nnimap-wait-for-connection (&optional regexp) + (unless regexp + (setq regexp "^[*.] .*\n")) (let ((process (get-buffer-process (current-buffer)))) (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) - (not (re-search-forward "^[*.] .*\n" nil t))) + (not (re-search-forward regexp nil t))) (nnheader-accept-process-output process) (goto-char (point-min))) (forward-line -1) @@ -1431,7 +1545,7 @@ textual parts.") (point-min)) t))) (when messagep - (message "nnimap read %dk" (/ (buffer-size) 1000))) + (nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000))) (nnheader-accept-process-output process) (goto-char (point-max))) openp) @@ -1458,6 +1572,7 @@ textual parts.") (defun nnimap-parse-line (line) (let (char result) (with-temp-buffer + (mm-disable-multibyte) (insert line) (goto-char (point-min)) (while (not (eobp)) @@ -1469,12 +1584,16 @@ textual parts.") (split-string (buffer-substring (1+ (point)) - (1- (search-forward "]" (line-end-position) 'move))))) + (if (search-forward "]" (line-end-position) 'move) + (1- (point)) + (point))))) ((eql char ?\() (split-string (buffer-substring (1+ (point)) - (1- (search-forward ")" (line-end-position) 'move))))) + (if (search-forward ")" (line-end-position) 'move) + (1- (point)) + (point))))) ((eql char ?\") (forward-char 1) (buffer-substring @@ -1542,6 +1661,7 @@ textual parts.") new-articles) (erase-buffer) (nnimap-command "SELECT %S" nnimap-inbox) + (setf (nnimap-group nnimap-object) nnimap-inbox) (setq new-articles (nnimap-new-articles (nnimap-get-flags "1:*"))) (when new-articles (nnimap-fetch-inbox new-articles) @@ -1594,7 +1714,7 @@ textual parts.") (cond ;; If the server supports it, we now delete the message we have ;; just copied over. - ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + ((nnimap-capability "UIDPLUS") (setq sequence (nnimap-send-command "UID EXPUNGE %s" range))) ;; If it doesn't support UID EXPUNGE, then we only expunge if the ;; user has configured it. @@ -1614,9 +1734,8 @@ textual parts.") (defun nnimap-new-articles (flags) (let (new) (dolist (elem flags) - (when (or (null (cdr elem)) - (and (not (memq '%Deleted (cdr elem))) - (not (memq '%Seen (cdr elem))))) + (unless (gnus-list-memq-of-list nnimap-unsplittable-articles + (cdr elem)) (push (car elem) new))) (gnus-compress-sequence (nreverse new)))) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 2a264d1fa32..726b01564e7 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -32,163 +32,41 @@ ;; TODO: Documentation in the Gnus manual -;; From: Reiner Steib -;; Subject: Re: Including nnir.el -;; Newsgroups: gmane.emacs.gnus.general -;; Message-ID: <v9d5dnp6aq.fsf@marauder.physik.uni-ulm.de> -;; Date: 2006-06-05 22:49:01 GMT -;; -;; On Sun, Jun 04 2006, Sascha Wilde wrote: -;; -;; > The one thing most hackers like to forget: Documentation. By now the -;; > documentation is only in the comments at the head of the source, I -;; > would use it as basis to cook up some minimal texinfo docs. -;; > -;; > Where in the existing gnus manual would this fit best? - -;; Maybe (info "(gnus)Combined Groups") for a general description. -;; `gnus-group-make-nnir-group' might be described in (info -;; "(gnus)Foreign Groups") as well. - +;; Where in the existing gnus manual would this fit best? -;; The most recent version of this can always be fetched from the Gnus -;; repository. See http://www.gnus.org/ for more information. - -;; This code is still in the development stage but I'd like other -;; people to have a look at it. Please do not hesitate to contact me -;; with your ideas. - -;; What does it do? Well, it allows you to index your mail using some -;; search engine (freeWAIS-sf, swish-e and others -- see later), -;; then type `G G' in the Group buffer and issue a query to the search -;; engine. You will then get a buffer which shows all articles -;; matching the query, sorted by Retrieval Status Value (score). +;; What does it do? Well, it allows you to search your mail using +;; some search engine (imap, namazu, swish-e, gmane and others -- see +;; later) by typing `G G' in the Group buffer. You will then get a +;; buffer which shows all articles matching the query, sorted by +;; Retrieval Status Value (score). ;; When looking at the retrieval result (in the Summary buffer) you -;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an -;; article. You will be teleported into the group this article came -;; from, showing the thread this article is part of. (See below for -;; restrictions.) - -;; The Lisp installation is simple: just put this file on your -;; load-path, byte-compile it, and load it from ~/.gnus or something. -;; This will install a new command `G G' in your Group buffer for -;; searching your mail. Note that you also need to configure a number -;; of variables, as described below. - -;; Restrictions: -;; -;; * If you don't use HyREX as your search engine, this expects that -;; you use nnml or another one-file-per-message backend, because the -;; others doesn't support nnfolder. -;; * It can only search the mail backend's which are supported by one -;; search engine, because of different query languages. -;; * There are restrictions to the Wais setup. -;; * There are restrictions to the imap setup. -;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before -;; limiting to the right articles. This is much too slow, of -;; course. May issue a query for number of articles to fetch; you -;; must accept the default of all articles at this point or things -;; may break. - -;; The Lisp setup involves setting a few variables and setting up the +;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article. You +;; will be warped into the group this article came from. Typing `A T' +;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and +;; also show the thread this article is part of. + +;; The Lisp setup may involve setting a few variables and setting up the ;; search engine. You can define the variables in the server definition ;; like this : ;; (setq gnus-secondary-select-methods '( ;; (nnimap "" (nnimap-address "localhost") -;; (nnir-search-engine hyrex) -;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml")) +;; (nnir-search-engine namazu) ;; ))) -;; Or you can define the global ones. The variables set in the mailer- -;; definition will be used first. -;; The variable to set is `nnir-search-engine'. Choose one of the engines -;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist, -;; type `C-h v nnir-engines RET' for more information; this includes -;; examples for setting `nnir-search-engine', too.) -;; -;; The variable nnir-mail-backend isn't used anymore. -;; +;; The main variable to set is `nnir-search-engine'. Choose one of +;; the engines listed in `nnir-engines'. (Actually `nnir-engines' is +;; an alist, type `C-h v nnir-engines RET' for more information; this +;; includes examples for setting `nnir-search-engine', too.) -;; You must also set up a search engine. I'll tell you about the two -;; search engines currently supported: +;; If you use one of the local indices (namazu, find-grep, swish) you +;; must also set up a search engine backend. -;; 1. freeWAIS-sf -;; -;; As always with freeWAIS-sf, you need a so-called `format file'. I -;; use the following file: -;; -;; ,----- -;; | # Kai's format file for freeWAIS-sf for indexing mails. -;; | # Each mail is in a file, much like the MH format. -;; | -;; | # Document separator should never match -- each file is a document. -;; | record-sep: /^@this regex should never match@$/ -;; | -;; | # Searchable fields specification. -;; | -;; | region: /^[sS]ubject:/ /^[sS]ubject: */ -;; | subject "Subject header" stemming TEXT BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */ -;; | to "To and Cc headers" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */ -;; | from "From header" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^$/ -;; | stemming TEXT GLOBAL -;; | end: /^@this regex should never match@$/ -;; `----- -;; -;; 1998-07-22: waisindex would dump core on me for large articles with -;; the above settings. I used /^$/ as the end regex for the global -;; field. That seemed to work okay. - -;; There is a Perl module called `WAIS.pm' which is available from -;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This -;; module comes with a nifty tool called `makedb', which I use for -;; indexing. Here's my `makedb.conf': -;; -;; ,----- -;; | # Config file for makedb -;; | -;; | # Global options -;; | waisindex = /usr/local/bin/waisindex -;; | wais_opt = -stem -t fields -;; | # `-stem' option necessary when `stemming' is specified for the -;; | # global field in the *.fmt file -;; | -;; | # Own variables -;; | homedir = /home/kai -;; | -;; | # The mail database. -;; | database = mail -;; | files = `find $homedir/Mail -name \*[0-9] -print` -;; | dbdir = $homedir/.wais -;; | limit = 100 -;; `----- -;; -;; The Lisp setup involves the `nnir-wais-*' variables. The most -;; difficult to understand variable is probably -;; `nnir-wais-remove-prefix'. Here's what it does: the output of -;; `waissearch' basically contains the file name and the (full) -;; directory name. As Gnus works with group names rather than -;; directory names, the directory name is transformed into a group -;; name as follows: first, a prefix is removed from the (full) -;; directory name, then all `/' are replaced with `.'. The variable -;; `nnir-wais-remove-prefix' should contain a regex matching exactly -;; this prefix. It defaults to `$HOME/Mail/' (note the trailing -;; slash). - -;; 2. Namazu +;; 1. Namazu ;; ;; The Namazu backend requires you to have one directory containing all ;; index files, this is controlled by the `nnir-namazu-index-directory' ;; variable. To function the `nnir-namazu-remove-prefix' variable must -;; also be correct, see the documentation for `nnir-wais-remove-prefix' +;; also be correct, see the documentation for `nnir-namazu-remove-prefix' ;; above. ;; ;; It is particularly important not to pass any any switches to namazu @@ -227,18 +105,7 @@ ;; For maximum searching efficiency I have a cron job set to run this ;; command every four hours. -;; 3. HyREX -;; -;; The HyREX backend requires you to have one directory from where all -;; your relative paths are to, if you use them. This directory must be -;; set in the `nnir-hyrex-index-directory' variable, which defaults to -;; your home directory. You must also pass the base, class and -;; directory options or simply your dll to the `nnir-hyrex-programm' by -;; setting the `nnir-hyrex-additional-switches' variable accordently. -;; To function the `nnir-hyrex-remove-prefix' variable must also be -;; correct, see the documentation for `nnir-wais-remove-prefix' above. - -;; 4. find-grep +;; 2. find-grep ;; ;; The find-grep engine simply runs find(1) to locate eligible ;; articles and searches them with grep(1). This, of course, is much @@ -294,66 +161,47 @@ ;; function should return the list of articles as a vector, as ;; described above. Then, you need to register this backend in ;; `nnir-engines'. Then, users can choose the backend by setting -;; `nnir-search-engine'. +;; `nnir-search-engine' as a server variable. -;; Todo, or future ideas: - -;; * It should be possible to restrict search to certain groups. -;; -;; * There is currently no error checking. -;; -;; * The summary buffer display is currently really ugly, with all the -;; added information in the subjects. How could I make this -;; prettier? -;; -;; * A function which can be called from an nnir summary buffer which -;; teleports you into the group the current article came from and -;; shows you the whole thread this article is part of. -;; Implementation suggestions? -;; (1998-07-24: There is now a preliminary implementation, but -;; it is much too slow and quite fragile.) -;; -;; * Support other mail backends. In particular, probably quite a few -;; people use nnfolder. How would one go about searching nnfolders -;; and producing the right data needed? The group name and the RSV -;; are simple, but what about the article number? -;; - The article number is encoded in the `X-Gnus-Article-Number' -;; header of each mail. -;; - The HyREX engine supports nnfolder. -;; -;; * Support compressed mail files. Probably, just stripping off the -;; `.gz' or `.Z' file name extension is sufficient. -;; -;; * At least for imap, the query is performed twice. -;; +;;; Code: -;; Have you got other ideas? +;;; Setup: -;;; Setup Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (require 'nnoo) (require 'gnus-group) -(require 'gnus-sum) (require 'message) (require 'gnus-util) (eval-when-compile (require 'cl)) +;;; Internal Variables: -(eval-when-compile - (autoload 'nnimap-buffer "nnimap") - (autoload 'nnimap-command "nnimap") - (autoload 'nnimap-possibly-change-group "nnimap")) +(defvar nnir-current-query nil + "Internal: stores current query (= group name).") -(nnoo-declare nnir) -(nnoo-define-basics nnir) +(defvar nnir-current-server nil + "Internal: stores current server (does it ever change?).") -(gnus-declare-backend "nnir" 'mail) +(defvar nnir-current-group-marked nil + "Internal: stores current list of process-marked groups.") -(defvar nnir-imap-default-search-key "Whole message" - "The default IMAP search key for an nnir search. Must be one of - the keys in nnir-imap-search-arguments. To use raw imap queries - by default set this to \"Imap\"") +(defvar nnir-artlist nil + "Internal: stores search result.") + +(defvar nnir-tmp-buffer " *nnir*" + "Internal: temporary buffer.") + +(defvar nnir-search-history () + "Internal: the history for querying search options in nnir") + +(defvar nnir-extra-parms nil + "Internal: stores request for extra search parms") + +;; Imap variables (defvar nnir-imap-search-arguments '(("Whole message" . "TEXT") @@ -365,126 +213,139 @@ (defvar nnir-imap-search-other "HEADER %S" "The IMAP search item to use for anything other than - nnir-imap-search-arguments. By default this is the name of an + `nnir-imap-search-arguments'. By default this is the name of an email header field") (defvar nnir-imap-search-argument-history () "The history for querying search options in nnir") -(defvar nnir-get-article-nov-override-function nil - "If non-nil, a function that will be passed each search result. This -should return a message's headers in NOV format. +;;; Helper macros -If this variable is nil, or if the provided function returns nil for a search -result, `gnus-retrieve-headers' will be called instead.") +;; Data type article list. +(defmacro nnir-artlist-length (artlist) + "Returns number of articles in artlist." + `(length ,artlist)) -;;; Developer Extension Variable: +(defmacro nnir-artlist-article (artlist n) + "Returns from ARTLIST the Nth artitem (counting starting at 1)." + `(when (> ,n 0) + (elt ,artlist (1- ,n)))) -(defvar nnir-engines - `((wais nnir-run-waissearch - ()) - (imap nnir-run-imap - ((criteria - "Search in" ; Prompt - ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing - nil ; allow any user input - nil ; initial value - nnir-imap-search-argument-history ; the history to use - ,nnir-imap-default-search-key ; default - ))) - (swish++ nnir-run-swish++ - ((group . "Group spec: "))) - (swish-e nnir-run-swish-e - ((group . "Group spec: "))) - (namazu nnir-run-namazu - ()) - (hyrex nnir-run-hyrex - ((group . "Group spec: "))) - (find-grep nnir-run-find-grep - ((grep-options . "Grep options: ")))) - "Alist of supported search engines. -Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). -ENGINE is a symbol designating the searching engine. FUNCTION is also -a symbol, giving the function that does the search. The third element -ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, -the FUNCTION will issue a query for each of the PARAMs, using PROMPT. +(defmacro nnir-artitem-group (artitem) + "Returns the group from the ARTITEM." + `(elt ,artitem 0)) -The value of `nnir-search-engine' must be one of the ENGINE symbols. -For example, use the following line for searching using freeWAIS-sf: - (setq nnir-search-engine 'wais) -Use the following line if you read your mail via IMAP and your IMAP -server supports searching: - (setq nnir-search-engine 'imap) -Note that you have to set additional variables for most backends. For -example, the `wais' backend needs the variables `nnir-wais-program', -`nnir-wais-database' and `nnir-wais-remove-prefix'. +(defmacro nnir-artitem-number (artitem) + "Returns the number from the ARTITEM." + `(elt ,artitem 1)) + +(defmacro nnir-artitem-rsv (artitem) + "Returns the Retrieval Status Value (RSV, score) from the ARTITEM." + `(elt ,artitem 2)) + +(defmacro nnir-article-group (article) + "Returns the group for ARTICLE" + `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article))) + +(defmacro nnir-article-number (article) + "Returns the number for ARTICLE" + `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article))) + +(defmacro nnir-article-rsv (article) + "Returns the rsv for ARTICLE" + `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article))) + +(defsubst nnir-article-ids (article) + "Returns the pair `(nnir id . real id)' of ARTICLE" + (cons article (nnir-article-number article))) + +(defmacro nnir-categorize (sequence keyfunc &optional valuefunc) + "Sorts a sequence into categories and returns a list of the form +`((key1 (element11 element12)) (key2 (element21 element22))'. +The category key for a member of the sequence is obtained +as `(keyfunc member)' and the corresponding element is just +`member'. If `valuefunc' is non-nil, the element of the list +is `(valuefunc member)'." + `(unless (null ,sequence) + (let (value) + (mapc + (lambda (member) + (let ((y (,keyfunc member)) + (x ,(if valuefunc + `(,valuefunc member) + 'member))) + (if (assoc y value) + (push x (cadr (assoc y value))) + (push (list y (list x)) value)))) + ,sequence) + value))) + +;;; Finish setup: + +(require 'gnus-sum) + +(eval-when-compile + (autoload 'nnimap-buffer "nnimap") + (autoload 'nnimap-command "nnimap") + (autoload 'nnimap-possibly-change-group "nnimap") + (autoload 'gnus-registry-action "gnus-registry")) + +(nnoo-declare nnir) +(nnoo-define-basics nnir) + +(gnus-declare-backend "nnir" 'mail) -Add an entry here when adding a new search engine.") ;;; User Customizable Variables: (defgroup nnir nil - "Search nnmh and nnml groups in Gnus with swish-e, freeWAIS-sf, or EWS." + "Search groups in Gnus with assorted seach engines." :group 'gnus) -;; Mail backend. +(defcustom nnir-method-default-engines + '((nnimap . imap) + (nntp . gmane)) + "*Alist of default search engines keyed by server method." + :type '(alist) + :group 'nnir) -;; TODO: -;; If `nil', use server parameters to find out which server to search. CCC -;; -(defcustom nnir-mail-backend '(nnml "") - "*Specifies which backend should be searched. -More precisely, this is used to determine from which backend to fetch the -messages found. - -This must be equal to an existing server, so maybe it is best to use -something like the following: - (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods)) -The above line works fine if the mail backend you want to search is -the first element of gnus-secondary-select-methods (`nth' starts counting -at zero)." - :type '(sexp) +(defcustom nnir-ignored-newsgroups "" + "*A regexp to match newsgroups in the active file that should + be skipped when searching." + :type '(regexp) :group 'nnir) -;; Search engine to use. +(defcustom nnir-summary-line-format nil + "*The format specification of the lines in an nnir summary buffer. -(defcustom nnir-search-engine 'wais - "*The search engine to use. Must be a symbol. -See `nnir-engines' for a list of supported engines, and for example -settings of `nnir-search-engine'." - :type '(sexp) - :group 'nnir) +All the items from `gnus-summary-line-format' are available, along +with three items unique to nnir summary buffers: -;; freeWAIS-sf. +%Z Search retrieval score value (integer) +%G Article original full group name (string) +%g Article original short group name (string) -(defcustom nnir-wais-program "waissearch" - "*Name of waissearch executable." - :type '(string) +If nil this will use `gnus-summary-line-format'." + :type '(regexp) :group 'nnir) -(defcustom nnir-wais-database (expand-file-name "~/.wais/mail") - "*Name of Wais database containing the mail. +(defcustom nnir-retrieve-headers-override-function nil + "*If non-nil, a function that accepts an article list and group +and populates the `nntp-server-buffer' with the retrieved +headers. Must return either 'nov or 'headers indicating the +retrieved header format. -Note that this should be a file name without extension. For example, -if you have a file /home/john/.wais/mail.fmt, use this: - (setq nnir-wais-database \"/home/john/.wais/mail\") -The string given here is passed to `waissearch -d' as-is." - :type '(file) +If this variable is nil, or if the provided function returns nil for a search +result, `gnus-retrieve-headers' will be called instead." + :type '(function) :group 'nnir) -(defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each directory name returned by waissearch -in order to get a group name (albeit with / instead of .). This is a -regular expression. - -For example, suppose that Wais returns file names such as -\"/home/john/Mail/mail/misc/42\". For this example, use the following -setting: (setq nnir-wais-remove-prefix \"/home/john/Mail/\") -Note the trailing slash. Removing this prefix gives \"mail/misc/42\". -`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to -arrive at the correct group name, \"mail.misc\"." - :type '(regexp) +(defcustom nnir-imap-default-search-key "Whole message" + "*The default IMAP search key for an nnir search. Must be one of + the keys in `nnir-imap-search-arguments'. To use raw imap queries + by default set this to \"Imap\"." + :type '(string) :group 'nnir) (defcustom nnir-swish++-configuration-file @@ -513,8 +374,8 @@ Instead, use this: in order to get a group name (albeit with / instead of .). This is a regular expression. -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for swish++, not Wais." +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish++, not Namazu." :type '(regexp) :group 'nnir) @@ -564,8 +425,8 @@ This could be a server parameter." in order to get a group name (albeit with / instead of .). This is a regular expression. -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for swish-e, not Wais. +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish-e, not Namazu. This could be a server parameter." :type '(regexp) @@ -633,126 +494,82 @@ Instead, use this: "*The prefix to remove from each file name returned by Namazu in order to get a group name (albeit with / instead of .). -This variable is very similar to `nnir-wais-remove-prefix', except -that it is for Namazu, not Wais." +For example, suppose that Namazu returns file names such as +\"/home/john/Mail/mail/misc/42\". For this example, use the following +setting: (setq nnir-namazu-remove-prefix \"/home/john/Mail/\") +Note the trailing slash. Removing this prefix gives \"mail/misc/42\". +`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to +arrive at the correct group name, \"mail.misc\"." :type '(directory) :group 'nnir) -;;; Internal Variables: - -(defvar nnir-current-query nil - "Internal: stores current query (= group name).") - -(defvar nnir-current-server nil - "Internal: stores current server (does it ever change?).") +;;; Developer Extension Variable: -(defvar nnir-current-group-marked nil - "Internal: stores current list of process-marked groups.") +(defvar nnir-engines + `((imap nnir-run-imap + ((criteria + "Imap Search in" ; Prompt + ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing + nil ; allow any user input + nil ; initial value + nnir-imap-search-argument-history ; the history to use + ,nnir-imap-default-search-key ; default + ))) + (gmane nnir-run-gmane + ((author . "Gmane Author: "))) + (swish++ nnir-run-swish++ + ((group . "Swish++ Group spec: "))) + (swish-e nnir-run-swish-e + ((group . "Swish-e Group spec: "))) + (namazu nnir-run-namazu + ()) + (hyrex nnir-run-hyrex + ((group . "Hyrex Group spec: "))) + (find-grep nnir-run-find-grep + ((grep-options . "Grep options: ")))) + "Alist of supported search engines. +Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). +ENGINE is a symbol designating the searching engine. FUNCTION is also +a symbol, giving the function that does the search. The third element +ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, +the FUNCTION will issue a query for each of the PARAMs, using PROMPT. -(defvar nnir-artlist nil - "Internal: stores search result.") +The value of `nnir-search-engine' must be one of the ENGINE symbols. +For example, for searching a server using namazu include + (nnir-search-engine namazu) +in the server definition. Note that you have to set additional +variables for most backends. For example, the `namazu' backend +needs the variables `nnir-namazu-program', +`nnir-namazu-index-directory' and `nnir-namazu-remove-prefix'. -(defvar nnir-tmp-buffer " *nnir*" - "Internal: temporary buffer.") +Add an entry here when adding a new search engine.") -;;; Code: ;; Gnus glue. -(defun gnus-group-make-nnir-group (extra-parms query) +(defun gnus-group-make-nnir-group (nnir-extra-parms) "Create an nnir group. Asks for query." - (interactive "P\nsQuery: ") + (interactive "P") (setq nnir-current-query nil nnir-current-server nil nnir-current-group-marked nil nnir-artlist nil) - (let ((parms nil)) - (if extra-parms - (setq parms (nnir-read-parms query)) - (setq parms (list (cons 'query query)))) + (let* ((query (read-string "Query: " nil 'nnir-search-history)) + (parms (list (cons 'query query))) + (srv (if (gnus-server-server-name) + "all" ""))) (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) '(nnir "") t - (cons (current-buffer) - gnus-current-window-configuration) + (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t + (cons (current-buffer) gnus-current-window-configuration) nil))) -(eval-when-compile - (when (featurep 'xemacs) - ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. - (require 'edmacro))) - -(defun nnir-group-mode-hook () - (define-key gnus-group-mode-map (kbd "G G") - 'gnus-group-make-nnir-group)) -(add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook) - -;; Why is this needed? Is this for compatibility with old/new gnusae? Using -;; gnus-group-server instead works for me. -- Justus Piater -(defmacro nnir-group-server (group) - "Return the server for a newsgroup GROUP. -The returned format is as `gnus-server-to-method' needs it. See -`gnus-group-real-prefix' and `gnus-group-real-name'." - `(let ((gname ,group)) - (if (string-match "^\\([^:]+\\):" gname) - (progn - (setq gname (match-string 1 gname)) - (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname) - (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) - (concat gname ":"))) - (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) - -;; Summary mode commands. - -(defun gnus-summary-nnir-goto-thread () - "Only applies to nnir groups. Go to group this article came from -and show thread that contains this article." - (interactive) - (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name))) - (error "Can't execute this command unless in nnir group")) - (let* ((cur (gnus-summary-article-number)) - (group (nnir-artlist-artitem-group nnir-artlist cur)) - (backend-number (nnir-artlist-artitem-number nnir-artlist cur)) - (id (mail-header-id (gnus-summary-article-header))) - (refs (split-string - (mail-header-references (gnus-summary-article-header))))) - (if (string= (car (gnus-group-method group)) "nnimap") - (with-current-buffer (nnimap-buffer) - (let* ((cmd (let ((value - (format - "(OR HEADER REFERENCES %s HEADER Message-Id %s)" - id id))) - (dolist (refid refs value) - (setq value (format - "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" - refid refid value))))) - (result (nnimap-command - "UID SEARCH %s" cmd))) - (gnus-summary-read-group-1 group t t gnus-summary-buffer nil - (and (car result) - (delete 0 (mapcar #'string-to-number - (cdr (assoc "SEARCH" (cdr result))))))))) - (gnus-summary-read-group-1 group t t gnus-summary-buffer - nil (list backend-number)) - (gnus-summary-limit (list backend-number)) - (gnus-summary-refer-thread)))) - - -(if (fboundp 'eval-after-load) - (eval-after-load "gnus-sum" - '(define-key gnus-summary-goto-map - "T" 'gnus-summary-nnir-goto-thread)) - (add-hook 'gnus-summary-mode-hook - (function (lambda () - (define-key gnus-summary-goto-map - "T" 'gnus-summary-nnir-goto-thread))))) - - ;; Gnus backend interface functions. (deffoo nnir-open-server (server &optional definitions) ;; Just set the server variables appropriately. + (add-hook 'gnus-summary-mode-hook 'nnir-mode) (nnoo-change-server 'nnir server definitions)) (deffoo nnir-request-group (group &optional server fast info) @@ -765,106 +582,138 @@ and show thread that contains this article." (equal server nnir-current-server))) nnir-artlist ;; Cache miss. - (setq nnir-artlist (nnir-run-query group))) + (setq nnir-artlist (nnir-run-query group server))) (with-current-buffer nntp-server-buffer + (setq nnir-current-query group) + (when server (setq nnir-current-server server)) + (setq nnir-current-group-marked gnus-group-marked) (if (zerop (length nnir-artlist)) - (progn - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (nnheader-report 'nnir "Search produced empty results.")) + (nnheader-report 'nnir "Search produced empty results.") ;; Remember data for cache. - (setq nnir-current-query group) - (when server (setq nnir-current-server server)) - (setq nnir-current-group-marked gnus-group-marked) (nnheader-insert "211 %d %d %d %s\n" (nnir-artlist-length nnir-artlist) ; total # 1 ; first # (nnir-artlist-length nnir-artlist) ; last # - group)))) ; group name + group)))) ; group name (deffoo nnir-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (let ((artlist (copy-sequence articles)) - art artitem artgroup artno artrsv artfullgroup - novitem novdata foo server) - (while (not (null artlist)) - (setq art (car artlist)) - (or (numberp art) - (nnheader-report - 'nnir - "nnir-retrieve-headers doesn't grok message ids: %s" - art)) - (setq artitem (nnir-artlist-article nnir-artlist art)) - (setq artrsv (nnir-artitem-rsv artitem)) - (setq artfullgroup (nnir-artitem-group artitem)) - (setq artno (nnir-artitem-number artitem)) - (setq artgroup (gnus-group-real-name artfullgroup)) - (setq server (nnir-group-server artfullgroup)) - ;; retrieve NOV or HEAD data for this article, transform into - ;; NOV data and prepend to `novdata' - (set-buffer nntp-server-buffer) - (nnir-possibly-change-server server) - (let ((gnus-override-method - (gnus-server-to-method server))) - ;; if nnir-get-article-nov-override-function is set, use it - (if nnir-get-article-nov-override-function - (setq novitem (funcall nnir-get-article-nov-override-function - artitem)) - ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head - (case (setq foo (gnus-retrieve-headers (list artno) - artfullgroup nil)) - (nov - (goto-char (point-min)) - (setq novitem (nnheader-parse-nov))) - (headers - (goto-char (point-min)) - (setq novitem (nnheader-parse-head))) - (t (error "Unknown header type %s while requesting article %s of group %s" - foo artno artfullgroup))))) - ;; replace article number in original group with article number - ;; 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" - artrsv artgroup artno - (mail-header-subject novitem))) - (push novitem novdata) - (setq artlist (cdr artlist)))) - (setq novdata (nreverse novdata)) - (set-buffer nntp-server-buffer) (erase-buffer) - (mapc 'nnheader-insert-nov novdata) + (with-current-buffer nntp-server-buffer + (let ((gnus-inhibit-demon t) + (articles-by-group (nnir-categorize + articles nnir-article-group nnir-article-ids)) + headers) + (while (not (null articles-by-group)) + (let* ((group-articles (pop articles-by-group)) + (artgroup (car group-articles)) + (articleids (cadr group-articles)) + (artlist (sort (mapcar 'cdr articleids) '<)) + (server (gnus-group-server artgroup)) + (gnus-override-method (gnus-server-to-method server)) + parsefunc) + ;; (or (numberp art) + ;; (nnheader-report + ;; 'nnir + ;; "nnir-retrieve-headers doesn't grok message ids: %s" + ;; art)) + (nnir-possibly-change-server server) + ;; is this needed? + (erase-buffer) + (case (setq gnus-headers-retrieved-by + (or + (and + nnir-retrieve-headers-override-function + (funcall nnir-retrieve-headers-override-function + artlist artgroup)) + (gnus-retrieve-headers artlist artgroup nil))) + (nov + (setq parsefunc 'nnheader-parse-nov)) + (headers + (setq parsefunc 'nnheader-parse-head)) + (t (error "Unknown header type %s while requesting articles \ + of group %s" gnus-headers-retrieved-by artgroup))) + (goto-char (point-min)) + (while (not (eobp)) + (let* ((novitem (funcall parsefunc)) + (artno (mail-header-number novitem)) + (art (car (rassq artno articleids)))) + (when art + (mail-header-set-number novitem art) + (push novitem headers)) + (forward-line 1))))) + (setq headers + (sort headers + (lambda (x y) + (< (mail-header-number x) (mail-header-number y))))) + (erase-buffer) + (mapc 'nnheader-insert-nov headers) 'nov))) -(deffoo nnir-request-article (article - &optional group server to-buffer) +(deffoo nnir-request-article (article &optional group server to-buffer) (if (stringp article) (nnheader-report 'nnir "nnir-retrieve-headers doesn't grok message ids: %s" article) (save-excursion - (let* ((artitem (nnir-artlist-article nnir-artlist - article)) - (artfullgroup (nnir-artitem-group artitem)) - (artno (nnir-artitem-number artitem)) - ;; Bug? - ;; Why must we bind nntp-server-buffer here? It won't - ;; work if `buf' is used, say. (Of course, the set-buffer - ;; line below must then be updated, too.) - (nntp-server-buffer (or to-buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) + (let ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article))) (message "Requesting article %d from group %s" artno artfullgroup) - (gnus-request-article artno artfullgroup nntp-server-buffer) + (if to-buffer + (with-current-buffer to-buffer + (let ((gnus-article-decode-hook nil)) + (gnus-request-article-this-buffer artno artfullgroup))) + (gnus-request-article artno artfullgroup)) (cons artfullgroup artno))))) +(deffoo nnir-request-move-article (article group server accept-form + &optional last internal-move-group) + (let* ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article)) + (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))) + (unless (gnus-check-backend-function + 'request-move-article artfullgroup) + (error "The group %s does not support article moving" artfullgroup)) + (gnus-request-move-article + artno + artfullgroup + (nth 1 from-method) + accept-form + last + (and move-is-internal + to-newsgroup ; Not respooling + (gnus-group-real-name to-newsgroup))))) + +(deffoo nnir-request-expire-articles (articles group &optional server force) + (let ((articles-by-group (nnir-categorize + articles nnir-article-group nnir-article-ids)) + not-deleted) + (while (not (null articles-by-group)) + (let* ((group-articles (pop articles-by-group)) + (artgroup (car group-articles)) + (articleids (cadr group-articles)) + (artlist (sort (mapcar 'cdr articleids) '<))) + (unless (gnus-check-backend-function 'request-expire-articles + artgroup) + (error "The group %s does not support article deletion" artgroup)) + (unless (gnus-check-server (gnus-find-method-for-group artgroup)) + (error "Couldn't open server for group %s" artgroup)) + (push (gnus-request-expire-articles + artlist artgroup force) + not-deleted))) + (sort (delq nil not-deleted) '<))) + +(deffoo nnir-warp-to-article () + (let* ((cur (if (> (gnus-summary-article-number) 0) + (gnus-summary-article-number) + (error "This is not a real article."))) + (gnus-newsgroup-name (nnir-article-group cur)) + (backend-number (nnir-article-number cur))) + (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer + nil (list backend-number)))) (nnoo-define-skeleton nnir) @@ -901,7 +750,7 @@ ready to be added to the list of search results." (gnus-replace-in-string dirnam "^[./\\]" "" t) "[/\\]" "." t))) - (vector (nnir-group-full-name group server) + (vector (gnus-group-full-name group server) (if (string= (gnus-group-server server) "nnmaildir") (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) @@ -911,94 +760,49 @@ ready to be added to the list of search results." ;;; Search Engine Interfaces: -;; freeWAIS-sf interface. -(defun nnir-run-waissearch (query server &optional group) - "Run given query agains waissearch. Returns vector of (group name, file name) -pairs (also vectors, actually)." - (when group - (error "The freeWAIS-sf backend cannot search specific groups")) - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) - artlist score artno dirnam) - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (message "Doing WAIS query %s..." query) - (call-process nnir-wais-program - nil ; input from /dev/null - t ; output to current buffer - nil ; don't redisplay - "-d" (nnir-read-server-parm 'nnir-wais-database server) ; database to search - qstring) - (message "Massaging waissearch output...") - ;; remove superfluous lines - (keep-lines "Score:") - ;; extract data from result lines - (goto-char (point-min)) - (while (re-search-forward - "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t) - (setq score (match-string 1) - artno (match-string 2) - dirnam (match-string 3)) - (unless (string-match prefix dirnam) - (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" - dirnam prefix)) - (setq group (gnus-replace-in-string - (replace-match "" t t dirnam) "/" ".")) - (push (vector (nnir-group-full-name group server) - (string-to-number artno) - (string-to-number score)) - artlist)) - (message "Massaging waissearch output...done") - (apply 'vector - (sort artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;; IMAP interface. -;; todo: -;; send queries as literals -;; handle errors - - -(defun nnir-run-imap (query srv &optional group-option) +;; imap interface +(defun nnir-run-imap (query srv &optional groups) "Run a search against an IMAP back-end server. This uses a custom query language parser; see `nnir-imap-make-query' for details on the language and supported extensions" (save-excursion (let ((qstring (cdr (assq 'query query))) - (server (cadr (gnus-server-to-method srv))) - (group (or group-option (gnus-group-group-name))) - (defs (caddr (gnus-server-to-method srv))) - (criteria (or (cdr (assq 'criteria query)) - (cdr (assoc nnir-imap-default-search-key - nnir-imap-search-arguments)))) - (gnus-inhibit-demon t) - artlist) + (server (cadr (gnus-server-to-method srv))) + (defs (caddr (gnus-server-to-method srv))) + (criteria (or (cdr (assq 'criteria query)) + (cdr (assoc nnir-imap-default-search-key + nnir-imap-search-arguments)))) + (gnus-inhibit-demon t) + (groups (or groups (nnir-get-active srv)))) (message "Opening server %s" server) - (condition-case () - (when (nnimap-possibly-change-group (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) - (let ((arts 0) - (result - (nnimap-command "UID SEARCH %s" - (if (string= criteria "") - qstring - (nnir-imap-make-query criteria qstring) - )))) - (mapc - (lambda (artnum) - (push (vector group artnum 1) artlist) - (setq arts (1+ arts))) - (and (car result) - (delete 0 (mapcar #'string-to-number - (cdr (assoc "SEARCH" (cdr result))))))) - (message "Searching %s... %d matches" group arts))) - (message "Searching %s...done" group)) - (quit nil)) - (reverse artlist)))) + (apply + 'vconcat + (mapcar + (lambda (group) + (let (artlist) + (condition-case () + (when (nnimap-possibly-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result (nnimap-command "UID SEARCH %s" + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring))))) + (mapc + (lambda (artnum) (push (vector group artnum 100) artlist) + (setq arts (1+ arts))) + (and (car result) + (delete 0 (mapcar #'string-to-number + (cdr (assoc "SEARCH" + (cdr result))))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + artlist)) + groups))))) (defun nnir-imap-make-query (criteria qstring) "Parse the query string and criteria into an appropriate IMAP search @@ -1188,8 +992,8 @@ actually). Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on Windows NT 4.0." - (when group - (error "The swish++ backend cannot search specific groups")) + ;; (when group + ;; (error "The swish++ backend cannot search specific groups")) (save-excursion (let ( (qstring (cdr (assq 'query query))) @@ -1277,8 +1081,8 @@ actually). Tested with swish-e-2.0.1 on Windows NT 4.0." ;; swish-e crashes with empty parameter to "-w" on commandline... - (when group - (error "The swish-e backend cannot search specific groups")) + ;; (when group + ;; (error "The swish-e backend cannot search specific groups")) (save-excursion (let ((qstring (cdr (assq 'query query))) @@ -1348,7 +1152,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; Windows "\\" -> "." (setq group (gnus-replace-in-string group "\\\\" ".")) - (push (vector (nnir-group-full-name group server) + (push (vector (gnus-group-full-name group server) (string-to-number artno) (string-to-number score)) artlist)))) @@ -1370,19 +1174,13 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (qstring (cdr (assq 'query query))) (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) score artno dirnam) - (when (and group groupspec) - (error (concat "It does not make sense to use a group spec" - " with process-marked groups."))) - (when group - (setq groupspec (gnus-group-real-name group))) - (when (and group (not (equal group (nnir-group-full-name groupspec server)))) - (message "%s vs. %s" group (nnir-group-full-name groupspec server)) - (error "Server with groupspec doesn't match group !")) + (when (and (not groupspec) group) + (setq groupspec + (regexp-opt + (mapcar (lambda (x) (gnus-group-real-name x)) group)))) (set-buffer (get-buffer-create nnir-tmp-buffer)) (erase-buffer) - (if groupspec - (message "Doing hyrex-search query %s on %s..." query groupspec) - (message "Doing hyrex-search query %s..." query)) + (message "Doing hyrex-search query %s..." query) (let* ((cp-list `( ,nnir-hyrex-program nil ; input from /dev/null @@ -1404,16 +1202,14 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; the user wants it. (when (> gnus-verbose 6) (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! - (if groupspec - (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec) - (message "Doing hyrex-search query \"%s\"...done" qstring)) + (message "Doing hyrex-search query \"%s\"...done" qstring) (sit-for 0) ;; nnir-search returns: ;; for nnml/nnfolder: "filename mailid weigth" ;; for nnimap: "group mailid weigth" (goto-char (point-min)) (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") - ;; HyREX couldn't search directly in groups -- so filter out here. + ;; HyREX doesn't search directly in groups -- so filter out here. (when groupspec (keep-lines groupspec)) ;; extract data from result lines @@ -1425,7 +1221,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." score (match-string 3)) (when (string-match prefix dirnam) (setq dirnam (replace-match "" t t dirnam))) - (push (vector (nnir-group-full-name + (push (vector (gnus-group-full-name (gnus-replace-in-string dirnam "/" ".") server) (string-to-number artno) (string-to-number score)) @@ -1447,8 +1243,8 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." pairs (also vectors, actually). Tested with Namazu 2.0.6 on a GNU/Linux system." - (when group - (error "The Namazu backend cannot search specific groups")) + ;; (when group + ;; (error "The Namazu backend cannot search specific groups")) (save-excursion (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir") ":[0-9]+" @@ -1510,7 +1306,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (> (nnir-artitem-rsv x) (nnir-artitem-rsv y))))))))) -(defun nnir-run-find-grep (query server &optional group) +(defun nnir-run-find-grep (query server &optional grouplist) "Run find and grep to obtain matching articles." (let* ((method (gnus-server-to-method server)) (sym (intern @@ -1518,69 +1314,139 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (directory (cadr (assoc sym (cddr method)))) (regexp (cdr (assoc 'query query))) (grep-options (cdr (assoc 'grep-options query))) + (grouplist (or grouplist (nnir-get-active server))) artlist) (unless directory (error "No directory found in method specification of server %s" server)) - (message "Searching %s using find-grep..." (or group server)) - (save-window-excursion - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (if (> gnus-verbose 6) - (pop-to-buffer (current-buffer))) - (cd directory) ; Using relative paths simplifies postprocessing. - (let ((group - (if (not group) - "." - ;; Try accessing the group literally as well as - ;; interpreting dots as directory separators so the - ;; engine works with plain nnml as well as the Gnus Cache. - (let ((group (gnus-group-real-name group))) - ;; Replace cl-func find-if. - (if (file-directory-p group) - group - (if (file-directory-p - (setq group (gnus-replace-in-string group "\\." "/" t))) - group)))))) - (unless group - (error "Cannot locate directory for group")) - (save-excursion - (apply - 'call-process "find" nil t - "find" group "-type" "f" "-name" "[0-9]*" "-exec" - "grep" - `("-l" ,@(and grep-options - (split-string grep-options "\\s-" t)) - "-e" ,regexp "{}" "+")))) - - ;; Translate relative paths to group names. - (while (not (eobp)) - (let* ((path (split-string - (buffer-substring (point) (line-end-position)) "/" t)) - (art (string-to-number (car (last path))))) - (while (string= "." (car path)) - (setq path (cdr path))) - (let ((group (mapconcat 'identity - ;; Replace cl-func: (subseq path 0 -1) - (let ((end (1- (length path))) - res) - (while (>= (setq end (1- end)) 0) - (push (pop path) res)) - (nreverse res)) - "."))) - (push (vector (nnir-group-full-name group server) art 0) - artlist)) - (forward-line 1))) - (message "Searching %s using find-grep...done" (or group server)) - artlist))) + (apply + 'vconcat + (mapcar (lambda (x) + (let ((group x)) + (message "Searching %s using find-grep..." + (or group server)) + (save-window-excursion + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (if (> gnus-verbose 6) + (pop-to-buffer (current-buffer))) + (cd directory) ; Using relative paths simplifies + ; postprocessing. + (let ((group + (if (not group) + "." + ;; Try accessing the group literally as + ;; well as interpreting dots as directory + ;; separators so the engine works with + ;; plain nnml as well as the Gnus Cache. + (let ((group (gnus-group-real-name group))) + ;; Replace cl-func find-if. + (if (file-directory-p group) + group + (if (file-directory-p + (setq group + (gnus-replace-in-string + group + "\\." "/" t))) + group)))))) + (unless group + (error "Cannot locate directory for group")) + (save-excursion + (apply + 'call-process "find" nil t + "find" group "-type" "f" "-name" "[0-9]*" "-exec" + "grep" + `("-l" ,@(and grep-options + (split-string grep-options "\\s-" t)) + "-e" ,regexp "{}" "+")))) + + ;; Translate relative paths to group names. + (while (not (eobp)) + (let* ((path (split-string + (buffer-substring + (point) + (line-end-position)) "/" t)) + (art (string-to-number (car (last path))))) + (while (string= "." (car path)) + (setq path (cdr path))) + (let ((group (mapconcat 'identity + ;; Replace cl-func: + ;; (subseq path 0 -1) + (let ((end (1- (length path))) + res) + (while + (>= (setq end (1- end)) 0) + (push (pop path) res)) + (nreverse res)) + "."))) + (push + (vector (gnus-group-full-name group server) art 0) + artlist)) + (forward-line 1))) + (message "Searching %s using find-grep...done" + (or group server)) + artlist))) + grouplist)))) + +(declare-function mm-url-insert "mm-url" (url &optional follow-refresh)) +(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs)) + +;; gmane interface +(defun nnir-run-gmane (query srv &optional groups) + "Run a search against a gmane back-end server." + (if (gnus-string-match-p "gmane" srv) + (let* ((case-fold-search t) + (qstring (cdr (assq 'query query))) + (server (cadr (gnus-server-to-method srv))) + (groupspec (mapconcat + (lambda (x) + (format "group:%s" (gnus-group-short-name x))) + groups " ")) + (authorspec + (if (assq 'author query) + (format "author:%s" (cdr (assq 'author query))) "")) + (search (format "%s %s %s" + qstring groupspec authorspec)) + (gnus-inhibit-demon t) + artlist) + (require 'mm-url) + (with-current-buffer (get-buffer-create nnir-tmp-buffer) + (erase-buffer) + (mm-url-insert + (concat + "http://search.gmane.org/nov.php" + "?" + (mm-url-encode-www-form-urlencoded + `(("query" . ,search) + ("HITSPERPAGE" . "999"))))) + (unless (featurep 'xemacs) (set-buffer-multibyte t)) + (mm-decode-coding-region (point-min) (point-max) 'utf-8) + (goto-char (point-min)) + (forward-line 1) + (while (not (eobp)) + (unless (or (eolp) (looking-at "\x0d")) + (let ((header (nnheader-parse-nov))) + (let ((xref (mail-header-xref header)) + (xscore (string-to-number (cdr (assoc 'X-Score + (mail-header-extra header)))))) + (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) + (push + (vector + (gnus-group-prefixed-name (match-string 1 xref) srv) + (string-to-number (match-string 2 xref)) xscore) + artlist))))) + (forward-line 1))) + (apply 'vector (nreverse (mm-delete-duplicates artlist)))) + (message "Can't search non-gmane nntp groups") + nil)) ;;; Util Code: -(defun nnir-read-parms (query) +(defun nnir-read-parms (query nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (cons (cons 'query query) - (mapcar 'nnir-read-parm parmspec)))) + (append query + (mapcar 'nnir-read-parm parmspec)))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1594,101 +1460,58 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) -(defun nnir-run-query (query) +(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 -and concat the results." - (let ((q (car (read-from-string query)))) - (if gnus-group-marked - (apply 'vconcat - (mapcar (lambda (x) - (let ((server (nnir-group-server x)) - search-func) - (setq search-func (cadr - (assoc - (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) - (if search-func - (funcall search-func q server x) - nil))) - gnus-group-marked) - ) - (apply 'vconcat - (mapcar (lambda (x) - (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) - (let ((server (format "%s:%s" (caar x) (cadar x))) - search-func) - (setq search-func (cadr - (assoc - (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) - (if search-func - (funcall search-func q server nil) - nil)) - nil)) - gnus-opened-servers) - )) - )) + If some groups were process-marked, run the query for each of the groups + and concat the results." + (let ((q (car (read-from-string query))) + (groups (if (string= "all-ephemeral" nserver) + (with-current-buffer gnus-server-buffer + (list (list (gnus-server-server-name)))) + (nnir-categorize + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr (assoc (gnus-group-topic-name) + gnus-topic-alist)))) + gnus-group-server)))) + (apply 'vconcat + (mapcar + (lambda (x) + (let* ((server (car x)) + (nnir-search-engine + (or (nnir-read-server-parm 'nnir-search-engine + server) + (cdr (assoc (car + (gnus-server-to-method server)) + nnir-method-default-engines)))) + search-func) + (setq search-func (cadr (assoc nnir-search-engine + nnir-engines))) + (if search-func + (funcall search-func + (if nnir-extra-parms + (nnir-read-parms q nnir-search-engine) + q) + server (cadr x)) + nil))) + groups)))) (defun nnir-read-server-parm (key server) - "Returns the parameter value of for the given server, where server is of -form 'backend:name'." + "Returns the parameter value of key for the given server, where +server is of form 'backend:name'." (let ((method (gnus-server-to-method server))) (cond ((and method (assq key (cddr method))) - (nth 1 (assq key (cddr method)))) - ((and nnir-mail-backend - (gnus-server-equal method nnir-mail-backend)) - (symbol-value key)) - (t nil)))) -;; (if method -;; (if (assq key (cddr method)) -;; (nth 1 (assq key (cddr method))) -;; (symbol-value key)) -;; (symbol-value key)) -;; )) - -(defun nnir-group-full-name (shortname server) - "For the given group name, return a full Gnus group name. -The Gnus backend/server information is added." - (gnus-group-prefixed-name shortname (gnus-server-to-method server))) + (nth 1 (assq key (cddr method)))) + (t nil)))) (defun nnir-possibly-change-server (server) (unless (and server (nnir-server-opened server)) (nnir-open-server server))) -;; Data type article list. - -(defun nnir-artlist-length (artlist) - "Returns number of articles in artlist." - (length artlist)) - -(defun nnir-artlist-article (artlist n) - "Returns from ARTLIST the Nth artitem (counting starting at 1)." - (elt artlist (1- n))) - -(defun nnir-artitem-group (artitem) - "Returns the group from the ARTITEM." - (elt artitem 0)) - -(defun nnir-artlist-artitem-group (artlist n) - "Returns from ARTLIST the group of the Nth artitem (counting from 1)." - (nnir-artitem-group (nnir-artlist-article artlist n))) - -(defun nnir-artitem-number (artitem) - "Returns the number from the ARTITEM." - (elt artitem 1)) - -(defun nnir-artlist-artitem-number (artlist n) - "Returns from ARTLIST the number of the Nth artitem (counting from 1)." - (nnir-artitem-number (nnir-artlist-article artlist n))) - -(defun nnir-artitem-rsv (artitem) - "Returns the Retrieval Status Value (RSV, score) from the ARTITEM." - (elt artitem 2)) - -(defun nnir-artlist-artitem-rsv (artlist n) - "Returns from ARTLIST the Retrieval Status Value of the Nth artitem -\(counting from 1)." - (nnir-artitem-rsv (nnir-artlist-article artlist n))) ;; unused? (defun nnir-artlist-groups (artlist) @@ -1702,6 +1525,66 @@ The Gnus backend/server information is added." with-dups) res)) +(defun nnir-get-active (srv) + (let ((method (gnus-server-to-method srv)) + groups) + (gnus-request-list method) + (with-current-buffer nntp-server-buffer + (let ((cur (current-buffer)) + name) + (goto-char (point-min)) + (unless (string= nnir-ignored-newsgroups "") + (delete-matching-lines nnir-ignored-newsgroups)) + (if (eq (car method) 'nntp) + (while (not (eobp)) + (ignore-errors + (push (mm-string-as-unibyte + (gnus-group-full-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) method)) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (mm-string-as-unibyte + (if (eq (char-after) ?\") + (gnus-group-full-name (read cur) method) + (let ((p (point)) (name "")) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + (gnus-group-full-name name method)))) + groups)) + (forward-line))))) + groups)) + +(defun nnir-registry-action (action data-header from &optional to method) + "Call `gnus-registry-action' with the original article group." + (gnus-registry-action + action + data-header + (nnir-article-group (mail-header-number data-header)) + to + method)) + +(defun nnir-mode () + (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir) + (setq gnus-summary-line-format + (or nnir-summary-line-format gnus-summary-line-format)) + (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) + (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) + (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t) + (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t))) + + ;; The end. (provide 'nnir) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 8ccd7b02a16..06b464c0b29 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1,7 +1,8 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 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> ;; Keywords: news, mail @@ -1347,7 +1348,7 @@ Eudora has a broken References line, but an OK In-Reply-To." ;;; Utility functions (declare-function gnus-activate-group "gnus-start" - (group &optional scan dont-check method)) + (group &optional scan dont-check method dont-sub-check)) (defun nnmail-do-request-post (accept-func &optional server) "Utility function to directly post a message to an nnmail-derived group. @@ -1915,7 +1916,8 @@ If TIME is nil, then return the cutoff time for oldness instead." (when (or (gnus-request-group target) (gnus-request-create-group target)) (let ((group-art (gnus-request-accept-article target nil t t))) - (when (consp group-art) + (when (and (consp group-art) + (cdr group-art)) (gnus-group-mark-article-read target (cdr group-art)))))))) (defun nnmail-fancy-expiry-target (group) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 97531f87666..8e2cd4bdde3 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1559,7 +1559,7 @@ by nnmaildir-request-article.") (t (signal (car err) (cdr err)))))) todo-marks)) set-action (lambda (article) - (funcall add-action) + (funcall add-action article) (mapcar (lambda (mark) (unless (memq mark todo-marks) (funcall del-mark mark))) @@ -1590,7 +1590,7 @@ by nnmaildir-request-article.") (nnmaildir--nlist-iterate nlist ranges (cond ((eq 'del (cadr action)) del-action) ((eq 'add (cadr action)) add-action) - (t set-action)))) + ((eq 'set (cadr action)) set-action)))) nil))) (defun nnmaildir-close-group (gname &optional server) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 0b7f0a40bd3..7ea2437b956 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -188,17 +188,17 @@ (defun nnmairix-summary-mode-hook () "Nnmairix summary mode keymap." (define-key gnus-summary-mode-map - (kbd "$ t") 'nnmairix-search-thread-this-article) + (kbd "G G t") 'nnmairix-search-thread-this-article) (define-key gnus-summary-mode-map - (kbd "$ f") 'nnmairix-search-from-this-article) + (kbd "G G f") 'nnmairix-search-from-this-article) (define-key gnus-summary-mode-map - (kbd "$ m") 'nnmairix-widget-search-from-this-article) + (kbd "G G m") 'nnmairix-widget-search-from-this-article) (define-key gnus-summary-mode-map - (kbd "$ g") 'nnmairix-create-search-group-from-message) + (kbd "G G g") 'nnmairix-create-search-group-from-message) (define-key gnus-summary-mode-map - (kbd "$ o") 'nnmairix-goto-original-article) + (kbd "G G o") 'nnmairix-goto-original-article) (define-key gnus-summary-mode-map - (kbd "$ u") 'nnmairix-remove-tick-mark-original-article)) + (kbd "G G u") 'nnmairix-remove-tick-mark-original-article)) (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook) (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook) @@ -1357,7 +1357,7 @@ If ALL is t, return also the unopened/failed ones." (not (member (car server) gnus-ephemeral-servers)) (not (member (gnus-method-to-server (car server)) occ))) (push - (list mserver) + mserver openedserver))) openedserver)) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index b84ce518a28..46a6d903f7e 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -1033,19 +1033,7 @@ Use the nov database for the current group if available." (nnml-possibly-change-directory group server) (unless nnml-marks-is-evil (nnml-open-marks group server) - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) nil - "Unknown request-set-mark action: %s" what) - (dolist (mark marks) - (setq nnml-marks (gnus-update-alist-soft - mark - (funcall (if (eq what 'add) 'gnus-range-add - 'gnus-remove-from-range) - (cdr (assoc mark nnml-marks)) range) - nnml-marks))))) + (setq nnml-marks (nnheader-update-marks-actions nnml-marks actions)) (nnml-save-marks group server)) nil) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index ebe8c514cb3..9a02c26073d 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -114,11 +114,6 @@ The cdr of each element is used to decode data if it is available when the car is what the data specify as the encoding. Or, the car is used for decoding when the cdr that the data specify is not available.") -(defvar nnrss-wash-html-in-text-plain-parts nil - "*Non-nil means render text in text/plain parts as HTML. -The function specified by the `mm-text-html-renderer' variable will be -used to render text. If it is nil, text will simply be folded.") - (nnoo-define-basics nnrss) ;;; Interface functions @@ -197,9 +192,6 @@ used to render text. If it is nil, text will simply be folded.") (deffoo nnrss-close-group (group &optional server) t) -(defvar mm-text-html-renderer) -(defvar mm-text-html-washer-alist) - (deffoo nnrss-request-article (article &optional group server buffer) (setq group (nnrss-decode-group-name group)) (when (stringp article) @@ -240,46 +232,25 @@ used to render text. If it is nil, text will simply be folded.") (when text (insert text) (goto-char body) - (if (and nnrss-wash-html-in-text-plain-parts - (progn - (require 'mm-view) - (setq fn (or (cdr (assq mm-text-html-renderer - mm-text-html-washer-alist)) - mm-text-html-renderer)))) - (progn - (narrow-to-region body (point-max)) - (if (functionp fn) - (funcall fn) - (apply (car fn) (cdr fn))) - (widen) - (goto-char body) - (re-search-forward "[^\t\n ]" nil t) - (beginning-of-line) - (delete-region body (point)) - (goto-char (point-max)) - (skip-chars-backward "\t\n ") - (end-of-line) - (delete-region (point) (point-max)) - (insert "\n")) - (while (re-search-forward "\n+" nil t) - (replace-match " ")) - (goto-char body) - ;; See `nnrss-check-group', which inserts "<br /><br />". - (when (search-forward "<br /><br />" nil t) - (if (eobp) - (replace-match "\n") - (replace-match "\n\n"))) - (unless (eobp) - (let ((fill-column (default-value 'fill-column)) - (window (get-buffer-window nntp-server-buffer))) - (when window - (setq fill-column - (max 1 (/ (* (window-width window) 7) 8)))) - (fill-region (point) (point-max)) - (goto-char (point-max)) - ;; XEmacs version of `fill-region' inserts newline. - (unless (bolp) - (insert "\n"))))) + (while (re-search-forward "\n+" nil t) + (replace-match " ")) + (goto-char body) + ;; See `nnrss-check-group', which inserts "<br /><br />". + (when (search-forward "<br /><br />" nil t) + (if (eobp) + (replace-match "\n") + (replace-match "\n\n"))) + (unless (eobp) + (let ((fill-column (default-value 'fill-column)) + (window (get-buffer-window nntp-server-buffer))) + (when window + (setq fill-column + (max 1 (/ (* (window-width window) 7) 8)))) + (fill-region (point) (point-max)) + (goto-char (point-max)) + ;; XEmacs version of `fill-region' inserts newline. + (unless (bolp) + (insert "\n")))) (when (or link enclosure) (insert "\n"))) (when link diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 35987277b3d..1916c1ac9ad 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -399,15 +399,16 @@ there.") "Read the head of ARTICLE, convert to NOV headers, and insert." (save-excursion (let ((cur (current-buffer)) - buf) + buf) (setq buf (nnheader-set-temp-buffer " *nnspool head*")) (when (nnheader-insert-head - (nnspool-article-pathname nnspool-current-group article)) - (nnheader-insert-article-line article) - (let ((headers (nnheader-parse-head))) - (set-buffer cur) - (goto-char (point-max)) - (nnheader-insert-nov headers))) + (nnspool-article-pathname nnspool-current-group article)) + (nnheader-insert-article-line article) + (goto-char (point-min)) + (let ((headers (nnheader-parse-head))) + (set-buffer cur) + (goto-char (point-max)) + (nnheader-insert-nov headers))) (kill-buffer buf)))) (defun nnspool-sift-nov-with-sed (articles file) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 946025a0af2..9c9054a49c7 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1,8 +1,8 @@ ;;; nntp.el --- nntp access for Gnus -;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, -;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -34,6 +34,7 @@ (require 'nnoo) (require 'gnus-util) (require 'gnus) +(require 'proto-stream) (require 'gnus-group) ;; gnus-group-name-charset (nnoo-declare nntp) @@ -305,13 +306,6 @@ update their active files often, this can help.") (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) -(defvar nntp-ssl-program - "openssl s_client -quiet -ssl3 -connect %s:%p" -"A string containing commands for SSL connections. -Within a string, %s is replaced with the server address and %p with -port number on server. The program should accept IMAP commands on -stdin and return responses to stdout.") - (defvar nntp-authinfo-rejected nil "A custom error condition used to report 'Authentication Rejected' errors. Condition handlers that match just this condition ensure that the nntp @@ -404,7 +398,8 @@ be restored and the command retried." (cond ((looking-at "480") (nntp-handle-authinfo process)) ((looking-at "482") - (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message)) + (nnheader-report 'nntp "%s" + (get 'nntp-authinfo-rejected 'error-message)) (signal 'nntp-authinfo-rejected nil)) ((looking-at "^.*\n") (delete-region (point) (progn (forward-line 1) (point))))) @@ -1118,19 +1113,7 @@ command whose response triggered the error." nntp-marks-file-name) (nntp-possibly-create-directory group server) (nntp-open-marks group server) - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) nil - "Unknown request-set-mark action: %s" what) - (dolist (mark marks) - (setq nntp-marks (gnus-update-alist-soft - mark - (funcall (if (eq what 'add) 'gnus-range-add - 'gnus-remove-from-range) - (cdr (assoc mark nntp-marks)) range) - nntp-marks))))) + (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions)) (nntp-save-marks group server)) nil) @@ -1172,7 +1155,7 @@ It will make innd servers spawn an nnrpd process to allow actual article reading." (nntp-send-command "^.*\n" "MODE READER")) -(declare-function netrc-parse "netrc" (file)) +(declare-function netrc-parse "netrc" (&optional file)) (declare-function netrc-machine "netrc" (list machine &optional port defaultport)) (declare-function netrc-get "netrc" (alist type)) @@ -1280,11 +1263,28 @@ password contained in '~/.nntp-authinfo'." `(lambda () (nntp-kill-buffer ,pbuffer))))) (process - (condition-case () + (condition-case err (let ((coding-system-for-read nntp-coding-system-for-read) - (coding-system-for-write nntp-coding-system-for-write)) - (funcall nntp-open-connection-function pbuffer)) - (error nil) + (coding-system-for-write nntp-coding-system-for-write) + (map '((nntp-open-network-stream network) + (nntp-open-ssl-stream tls) + (nntp-open-tls-stream tls)))) + (if (assoc nntp-open-connection-function map) + (car (open-protocol-stream + "nntpd" pbuffer nntp-address nntp-port-number + :type (cadr + (assoc nntp-open-connection-function map)) + :end-of-command "^\\([2345]\\|[.]\\).*\n" + :capability-command "CAPABILITIES\r\n" + :success "^3" + :starttls-function + (lambda (capabilities) + (if (not (string-match "STARTTLS" capabilities)) + nil + "STARTTLS\r\n")))) + (funcall nntp-open-connection-function pbuffer))) + (error + (nnheader-report 'nntp "%s" err)) (quit (message "Quit opening connection to %s" nntp-address) (nntp-kill-buffer pbuffer) @@ -1312,40 +1312,6 @@ password contained in '~/.nntp-authinfo'." (nntp-kill-buffer (process-buffer process)) nil)))) -(defun nntp-open-network-stream (buffer) - (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) - -(autoload 'format-spec "format-spec") -(autoload 'format-spec-make "format-spec") -(autoload 'open-tls-stream "tls") - -(defun nntp-open-ssl-stream (buffer) - (let* ((process-connection-type nil) - (proc (start-process "nntpd" buffer - shell-file-name - shell-command-switch - (format-spec nntp-ssl-program - (format-spec-make - ?s nntp-address - ?p nntp-port-number))))) - (gnus-set-process-query-on-exit-flag proc nil) - (with-current-buffer buffer - (let ((nntp-connection-alist (list proc buffer nil))) - (nntp-wait-for-string "^\r*20[01]")) - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - -(defun nntp-open-tls-stream (buffer) - (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number))) - (gnus-set-process-query-on-exit-flag proc nil) - (with-current-buffer buffer - (let ((nntp-connection-alist (list proc buffer nil))) - (nntp-wait-for-string "^\r*20[01]")) - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - (defun nntp-read-server-type () "Find out what the name of the server we have connected to is." ;; Wait for the status string to arrive. @@ -1446,7 +1412,7 @@ password contained in '~/.nntp-authinfo'." (let ((message (buffer-string))) (while (string-match "[\r\n]+" message) (setq message (replace-match " " t t message))) - (nnheader-report 'nntp message) + (nnheader-report 'nntp "%s" message) message)) (defun nntp-accept-process-output (process) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 327c5297492..eef53c2797d 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -327,21 +327,22 @@ Returns the process associated with the connection." ;; gnutls-cli, openssl don't accept service names (if (equal port "pop3") (setq port 110)) - (let ((process (starttls-open-stream "POP" (current-buffer) - mailhost (or port 110)))) - (pop3-send-command process "STLS") - (let ((response (pop3-read-response process t))) - (if (and response (string-match "+OK" response)) - (starttls-negotiate process) - (pop3-quit process) - (error "POP server doesn't support starttls"))) - process)) + ;; Delay STLS until server greeting is read (Bug#7438). + (starttls-open-stream "POP" (current-buffer) + mailhost (or port 110))) (t (open-network-stream "POP" (current-buffer) mailhost port)))) (let ((response (pop3-read-response process t))) (setq pop3-timestamp (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) + (when (eq pop3-stream-type 'starttls) + (pop3-send-command process "STLS") + (let ((response (pop3-read-response process t))) + (if (and response (string-match "+OK" response)) + (starttls-negotiate process) + (pop3-quit process) + (error "POP server doesn't support starttls")))) (pop3-set-process-query-on-exit-flag process nil) process))) diff --git a/lisp/gnus/proto-stream.el b/lisp/gnus/proto-stream.el new file mode 100644 index 00000000000..6c90f3a112d --- /dev/null +++ b/lisp/gnus/proto-stream.el @@ -0,0 +1,263 @@ +;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: network + +;; 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 library is meant to provide the glue between modules that want +;; to establish a network connection to a server for protocols such as +;; IMAP, NNTP, SMTP and POP3. + +;; The main problem is that there's more than a couple of interfaces +;; towards doing this. You have normal, plain connections, which are +;; no trouble at all, but you also have TLS/SSL connections, and you +;; have STARTTLS. Negotiating this for each protocol can be rather +;; tedious, so this library provides a single entry point, and hides +;; much of the ugliness. + +;; Usage example: + +;; (open-protocol-stream +;; "*nnimap*" buffer address port +;; :type 'network +;; :capability-command "1 CAPABILITY\r\n" +;; :success " OK " +;; :starttls-function +;; (lambda (capabilities) +;; (if (not (string-match "STARTTLS" capabilities)) +;; nil +;; "1 STARTTLS\r\n"))) + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'tls) +(require 'starttls) +(require 'format-spec) + +(defcustom proto-stream-always-use-starttls (fboundp 'open-gnutls-stream) + "If non-nil, always try to upgrade network connections with STARTTLS." + :version "24.1" + :type 'boolean + :group 'comm) + +(declare-function gnutls-negotiate "gnutls" + (proc type &optional priority-string trustfiles keyfiles)) + +;;;###autoload +(defun open-protocol-stream (name buffer host service &rest parameters) + "Open a network stream to HOST, upgrading to STARTTLS if possible. +The first four parameters have the same meaning as in +`open-network-stream'. The function returns a list where the +first element is the stream, the second element is the greeting +the server replied with after connecting, and the third element +is a string representing the capabilities of the server (if any). + +The PARAMETERS is a keyword list that can have the following +values: + +:type -- either `network', `tls', `shell' or `starttls'. If +omitted, the default is `network'. `network' will be +opportunistically upgraded to STARTTLS if both the server and +Emacs supports it. + +:end-of-command -- a regexp saying what the end of a command is. +This defaults to \"\\n\". + +:success -- a regexp saying whether the STARTTLS command was +successful or not. For instance, for NNTP this is \"^3\". + +:capability-command -- a string representing the command used to +query server for capabilities. For instance, for IMAP this is +\"1 CAPABILITY\\r\\n\". + +:starttls-function -- a function that takes one parameter, which +is the response to the capaibility command. It should return nil +if it turns out that the server doesn't support STARTTLS, or the +command to switch on STARTTLS otherwise." + (let ((type (or (cadr (memq :type parameters)) 'network))) + (cond + ((eq type 'starttls) + (setq type 'network)) + ((eq type 'ssl) + (setq type 'tls))) + (destructuring-bind (stream greeting capabilities) + (funcall (intern (format "proto-stream-open-%s" type) obarray) + name buffer host service parameters) + (list (and stream + (memq (process-status stream) + '(open run)) + stream) + greeting capabilities)))) + +(defun proto-stream-open-network (name buffer host service parameters) + (let* ((start (with-current-buffer buffer (point))) + (stream (open-network-stream name buffer host service)) + (capability-command (cadr (memq :capability-command parameters))) + (eoc (proto-stream-eoc parameters)) + (type (cadr (memq :type parameters))) + (greeting (proto-stream-get-response stream start eoc)) + success) + (if (not capability-command) + (list stream greeting nil) + (let* ((capabilities + (proto-stream-command stream capability-command eoc)) + (starttls-command + (funcall (cadr (memq :starttls-function parameters)) + capabilities))) + (cond + ;; If this server doesn't support STARTTLS, but we have + ;; requested it explicitly, then close the connection and + ;; return nil. + ((or (not starttls-command) + (and (not (eq type 'starttls)) + (not proto-stream-always-use-starttls))) + (if (eq type 'starttls) + (progn + (delete-process stream) + nil) + ;; Otherwise, just return this plain network connection. + (list stream greeting capabilities))) + ;; We have some kind of STARTTLS support, so we try to + ;; upgrade the connection opportunistically. + ((or (fboundp 'open-gnutls-stream) + (executable-find "gnutls-cli")) + (unless (fboundp 'open-gnutls-stream) + (delete-process stream) + (setq start (with-current-buffer buffer (point-max))) + (let* ((starttls-use-gnutls t) + (starttls-extra-arguments + (if (not (eq type 'starttls)) + ;; When doing opportunistic TLS upgrades we + ;; don't really care about the identity of the + ;; peer. + (cons "--insecure" starttls-extra-arguments) + starttls-extra-arguments))) + (setq stream (starttls-open-stream name buffer host service))) + (proto-stream-get-response stream start eoc)) + (if (not + (string-match + (cadr (memq :success parameters)) + (proto-stream-command stream starttls-command eoc))) + ;; We got an error back from the STARTTLS command. + (progn + (if (eq type 'starttls) + (progn + (delete-process stream) + nil) + (list stream greeting capabilities))) + ;; The server said it was OK to start doing STARTTLS negotiations. + (if (fboundp 'open-gnutls-stream) + (gnutls-negotiate stream nil) + (unless (starttls-negotiate stream) + (delete-process stream) + (setq stream nil))) + (when (or (null stream) + (not (memq (process-status stream) + '(open run)))) + ;; It didn't successfully negotiate STARTTLS, so we reopen + ;; the connection. + (setq stream (open-network-stream name buffer host service)) + (proto-stream-get-response stream start eoc)) + ;; Re-get the capabilities, since they may have changed + ;; after switching to TLS. + (list stream greeting + (proto-stream-command stream capability-command eoc)))) + ;; We don't have STARTTLS support available, but the caller + ;; requested a STARTTLS connection, so we give up. + ((eq (cadr (memq :type parameters)) 'starttls) + (delete-process stream) + nil) + ;; Fall back on using a plain network stream. + (t + (list stream greeting capabilities))))))) + +(defun proto-stream-command (stream command eoc) + (let ((start (with-current-buffer (process-buffer stream) (point-max)))) + (process-send-string stream command) + (proto-stream-get-response stream start eoc))) + +(defun proto-stream-get-response (stream start end-of-command) + (with-current-buffer (process-buffer stream) + (save-excursion + (goto-char start) + (while (and (memq (process-status stream) + '(open run)) + (not (re-search-forward end-of-command nil t))) + (accept-process-output stream 0 50) + (goto-char start)) + (if (= start (point)) + ;; The process died; return nil. + nil + ;; Return the data we got back. + (buffer-substring start (point)))))) + +(defun proto-stream-open-tls (name buffer host service parameters) + (with-current-buffer buffer + (let ((start (point-max)) + (stream + (funcall (if (fboundp 'open-gnutls-stream) + 'open-gnutls-stream + 'open-tls-stream) + name buffer host service))) + (if (null stream) + nil + ;; If we're using tls.el, we have to delete the output from + ;; openssl/gnutls-cli. + (unless (fboundp 'open-gnutls-stream) + (proto-stream-get-response + stream start (proto-stream-eoc parameters)) + (goto-char (point-min)) + (when (re-search-forward (proto-stream-eoc parameters) nil t) + (goto-char (match-beginning 0)) + (delete-region (point-min) (line-beginning-position)))) + (proto-stream-capability-open start stream parameters))))) + +(defun proto-stream-open-shell (name buffer host service parameters) + (proto-stream-capability-open + (with-current-buffer buffer (point)) + (let ((process-connection-type nil)) + (start-process name buffer shell-file-name + shell-command-switch + (format-spec + (cadr (memq :shell-command parameters)) + (format-spec-make + ?s host + ?p service)))) + parameters)) + +(defun proto-stream-capability-open (start stream parameters) + (let ((capability-command (cadr (memq :capability-command parameters))) + (greeting (proto-stream-get-response + stream start (proto-stream-eoc parameters)))) + (list stream greeting + (and capability-command + (proto-stream-command + stream capability-command (proto-stream-eoc parameters)))))) + +(defun proto-stream-eoc (parameters) + (or (cadr (memq :end-of-command parameters)) + "\r\n")) + +(provide 'proto-stream) + +;;; proto-stream.el ends here diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 8a7153969a5..51eef88dadc 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -346,13 +346,9 @@ The buffer may be narrowed." ;; 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) diff --git a/lisp/gnus/rtree.el b/lisp/gnus/rtree.el new file mode 100644 index 00000000000..04079b1ba8b --- /dev/null +++ b/lisp/gnus/rtree.el @@ -0,0 +1,278 @@ +;;; rtree.el --- functions for manipulating range trees + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> + +;; 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: + +;; A "range tree" is a binary tree that stores ranges. They are +;; similar to interval trees, but do not allow overlapping intervals. + +;; A range is an ordered list of number intervals, like this: + +;; ((10 . 25) 56 78 (98 . 201)) + +;; Common operations, like lookup, deletion and insertion are O(n) in +;; a range, but an rtree is O(log n) in all these operations. +;; Transformation between a range and an rtree is O(n). + +;; The rtrees are quite simple. The structure of each node is + +;; (cons (cons low high) (cons left right)) + +;; That is, they are three cons cells, where the car of the top cell +;; is the actual range, and the cdr has the left and right child. The +;; rtrees aren't automatically balanced, but are balanced when +;; created, and can be rebalanced when deemed necessary. + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defmacro rtree-make-node () + `(list (list nil) nil)) + +(defmacro rtree-set-left (node left) + `(setcar (cdr ,node) ,left)) + +(defmacro rtree-set-right (node right) + `(setcdr (cdr ,node) ,right)) + +(defmacro rtree-set-range (node range) + `(setcar ,node ,range)) + +(defmacro rtree-low (node) + `(caar ,node)) + +(defmacro rtree-high (node) + `(cdar ,node)) + +(defmacro rtree-set-low (node number) + `(setcar (car ,node) ,number)) + +(defmacro rtree-set-high (node number) + `(setcdr (car ,node) ,number)) + +(defmacro rtree-left (node) + `(cadr ,node)) + +(defmacro rtree-right (node) + `(cddr ,node)) + +(defmacro rtree-range (node) + `(car ,node)) + +(defsubst rtree-normalise-range (range) + (when (numberp range) + (setq range (cons range range))) + range) + +(defun rtree-make (range) + "Make an rtree from RANGE." + ;; Normalize the range. + (unless (listp (cdr-safe range)) + (setq range (list range))) + (rtree-make-1 (cons nil range) (length range))) + +(defun rtree-make-1 (range length) + (let ((mid (/ length 2)) + (node (rtree-make-node))) + (when (> mid 0) + (rtree-set-left node (rtree-make-1 range mid))) + (rtree-set-range node (rtree-normalise-range (cadr range))) + (setcdr range (cddr range)) + (when (> (- length mid 1) 0) + (rtree-set-right node (rtree-make-1 range (- length mid 1)))) + node)) + +(defun rtree-memq (tree number) + "Return non-nil if NUMBER is present in TREE." + (while (and tree + (not (and (>= number (rtree-low tree)) + (<= number (rtree-high tree))))) + (setq tree + (if (< number (rtree-low tree)) + (rtree-left tree) + (rtree-right tree)))) + tree) + +(defun rtree-add (tree number) + "Add NUMBER to TREE." + (while tree + (cond + ;; It's already present, so we don't have to do anything. + ((and (>= number (rtree-low tree)) + (<= number (rtree-high tree))) + (setq tree nil)) + ((< number (rtree-low tree)) + (cond + ;; Extend the low range. + ((= number (1- (rtree-low tree))) + (rtree-set-low tree number) + ;; Check whether we need to merge this node with the child. + (when (and (rtree-left tree) + (= (rtree-high (rtree-left tree)) (1- number))) + ;; Extend the range to the low from the child. + (rtree-set-low tree (rtree-low (rtree-left tree))) + ;; The child can't have a right child, so just transplant the + ;; child's left tree to our left tree. + (rtree-set-left tree (rtree-left (rtree-left tree)))) + (setq tree nil)) + ;; Descend further to the left. + ((rtree-left tree) + (setq tree (rtree-left tree))) + ;; Add a new node. + (t + (let ((new-node (rtree-make-node))) + (rtree-set-low new-node number) + (rtree-set-high new-node number) + (rtree-set-left tree new-node) + (setq tree nil))))) + (t + (cond + ;; Extend the high range. + ((= number (1+ (rtree-high tree))) + (rtree-set-high tree number) + ;; Check whether we need to merge this node with the child. + (when (and (rtree-right tree) + (= (rtree-low (rtree-right tree)) (1+ number))) + ;; Extend the range to the high from the child. + (rtree-set-high tree (rtree-high (rtree-right tree))) + ;; The child can't have a left child, so just transplant the + ;; child's left right to our right tree. + (rtree-set-right tree (rtree-right (rtree-right tree)))) + (setq tree nil)) + ;; Descend further to the right. + ((rtree-right tree) + (setq tree (rtree-right tree))) + ;; Add a new node. + (t + (let ((new-node (rtree-make-node))) + (rtree-set-low new-node number) + (rtree-set-high new-node number) + (rtree-set-right tree new-node) + (setq tree nil)))))))) + +(defun rtree-delq (tree number) + "Remove NUMBER from TREE destructively. Returns the new tree." + (let ((result tree) + prev) + (while tree + (cond + ((< number (rtree-low tree)) + (setq prev tree + tree (rtree-left tree))) + ((> number (rtree-high tree)) + (setq prev tree + tree (rtree-right tree))) + ;; The number is in this node. + (t + (cond + ;; The only entry; delete the node. + ((= (rtree-low tree) (rtree-high tree)) + (cond + ;; Two children. Replace with successor value. + ((and (rtree-left tree) (rtree-right tree)) + (let ((parent tree) + (successor (rtree-right tree))) + (while (rtree-left successor) + (setq parent successor + successor (rtree-left successor))) + ;; We now have the leftmost child of our right child. + (rtree-set-range tree (rtree-range successor)) + ;; Transplant the child (if any) to the parent. + (rtree-set-left parent (rtree-right successor)))) + (t + (let ((rest (or (rtree-left tree) + (rtree-right tree)))) + ;; One or zero children. Remove the node. + (cond + ((null prev) + (setq result rest)) + ((eq (rtree-left prev) tree) + (rtree-set-left prev rest)) + (t + (rtree-set-right prev rest))))))) + ;; The lowest in the range; just adjust. + ((= number (rtree-low tree)) + (rtree-set-low tree (1+ number))) + ;; The highest in the range; just adjust. + ((= number (rtree-high tree)) + (rtree-set-high tree (1- number))) + ;; We have to split this range. + (t + (let ((new-node (rtree-make-node))) + (rtree-set-low new-node (rtree-low tree)) + (rtree-set-high new-node (1- number)) + (rtree-set-low tree (1+ number)) + (cond + ;; Two children; insert the new node as the predecessor + ;; node. + ((and (rtree-left tree) (rtree-right tree)) + (let ((predecessor (rtree-left tree))) + (while (rtree-right predecessor) + (setq predecessor (rtree-right predecessor))) + (rtree-set-right predecessor new-node))) + ((rtree-left tree) + (rtree-set-right new-node tree) + (rtree-set-left new-node (rtree-left tree)) + (rtree-set-left tree nil) + (cond + ((null prev) + (setq result new-node)) + ((eq (rtree-left prev) tree) + (rtree-set-left prev new-node)) + (t + (rtree-set-right prev new-node)))) + (t + (rtree-set-left tree new-node)))))) + (setq tree nil)))) + result)) + +(defun rtree-extract (tree) + "Convert TREE to range form." + (let (stack result) + (while (or stack + tree) + (if tree + (progn + (push tree stack) + (setq tree (rtree-right tree))) + (setq tree (pop stack)) + (push (if (= (rtree-low tree) + (rtree-high tree)) + (rtree-low tree) + (rtree-range tree)) + result) + (setq tree (rtree-left tree)))) + result)) + +(defun rtree-length (tree) + "Return the number of numbers stored in TREE." + (if (null tree) + 0 + (+ (rtree-length (rtree-left tree)) + (1+ (- (rtree-high tree) + (rtree-low tree))) + (rtree-length (rtree-right tree))))) + +(provide 'rtree) + +;;; rtree.el ends here diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el new file mode 100644 index 00000000000..afb56ae38a7 --- /dev/null +++ b/lisp/gnus/shr-color.el @@ -0,0 +1,361 @@ +;;; shr-color.el --- Simple HTML Renderer color management + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Julien Danjou <julien@danjou.info> +;; Keywords: html + +;; 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 package handles colors display for shr. + +;;; Code: + +(require 'color) +(eval-when-compile (require 'cl)) + +(defgroup shr-color nil + "Simple HTML Renderer colors" + :group 'shr) + +(defcustom shr-color-visible-luminance-min 40 + "Minimum luminance distance between two colors to be considered visible. +Must be between 0 and 100." + :group 'shr + :type 'float) + +(defcustom shr-color-visible-distance-min 5 + "Minimum color distance between two colors to be considered visible. +This value is used to compare result for `ciede2000'. Its an +absolute value without any unit." + :group 'shr + :type 'integer) + +(defconst shr-color-html-colors-alist + '(("AliceBlue" . "#F0F8FF") + ("AntiqueWhite" . "#FAEBD7") + ("Aqua" . "#00FFFF") + ("Aquamarine" . "#7FFFD4") + ("Azure" . "#F0FFFF") + ("Beige" . "#F5F5DC") + ("Bisque" . "#FFE4C4") + ("Black" . "#000000") + ("BlanchedAlmond" . "#FFEBCD") + ("Blue" . "#0000FF") + ("BlueViolet" . "#8A2BE2") + ("Brown" . "#A52A2A") + ("BurlyWood" . "#DEB887") + ("CadetBlue" . "#5F9EA0") + ("Chartreuse" . "#7FFF00") + ("Chocolate" . "#D2691E") + ("Coral" . "#FF7F50") + ("CornflowerBlue" . "#6495ED") + ("Cornsilk" . "#FFF8DC") + ("Crimson" . "#DC143C") + ("Cyan" . "#00FFFF") + ("DarkBlue" . "#00008B") + ("DarkCyan" . "#008B8B") + ("DarkGoldenRod" . "#B8860B") + ("DarkGray" . "#A9A9A9") + ("DarkGrey" . "#A9A9A9") + ("DarkGreen" . "#006400") + ("DarkKhaki" . "#BDB76B") + ("DarkMagenta" . "#8B008B") + ("DarkOliveGreen" . "#556B2F") + ("Darkorange" . "#FF8C00") + ("DarkOrchid" . "#9932CC") + ("DarkRed" . "#8B0000") + ("DarkSalmon" . "#E9967A") + ("DarkSeaGreen" . "#8FBC8F") + ("DarkSlateBlue" . "#483D8B") + ("DarkSlateGray" . "#2F4F4F") + ("DarkSlateGrey" . "#2F4F4F") + ("DarkTurquoise" . "#00CED1") + ("DarkViolet" . "#9400D3") + ("DeepPink" . "#FF1493") + ("DeepSkyBlue" . "#00BFFF") + ("DimGray" . "#696969") + ("DimGrey" . "#696969") + ("DodgerBlue" . "#1E90FF") + ("FireBrick" . "#B22222") + ("FloralWhite" . "#FFFAF0") + ("ForestGreen" . "#228B22") + ("Fuchsia" . "#FF00FF") + ("Gainsboro" . "#DCDCDC") + ("GhostWhite" . "#F8F8FF") + ("Gold" . "#FFD700") + ("GoldenRod" . "#DAA520") + ("Gray" . "#808080") + ("Grey" . "#808080") + ("Green" . "#008000") + ("GreenYellow" . "#ADFF2F") + ("HoneyDew" . "#F0FFF0") + ("HotPink" . "#FF69B4") + ("IndianRed" . "#CD5C5C") + ("Indigo" . "#4B0082") + ("Ivory" . "#FFFFF0") + ("Khaki" . "#F0E68C") + ("Lavender" . "#E6E6FA") + ("LavenderBlush" . "#FFF0F5") + ("LawnGreen" . "#7CFC00") + ("LemonChiffon" . "#FFFACD") + ("LightBlue" . "#ADD8E6") + ("LightCoral" . "#F08080") + ("LightCyan" . "#E0FFFF") + ("LightGoldenRodYellow" . "#FAFAD2") + ("LightGray" . "#D3D3D3") + ("LightGrey" . "#D3D3D3") + ("LightGreen" . "#90EE90") + ("LightPink" . "#FFB6C1") + ("LightSalmon" . "#FFA07A") + ("LightSeaGreen" . "#20B2AA") + ("LightSkyBlue" . "#87CEFA") + ("LightSlateGray" . "#778899") + ("LightSlateGrey" . "#778899") + ("LightSteelBlue" . "#B0C4DE") + ("LightYellow" . "#FFFFE0") + ("Lime" . "#00FF00") + ("LimeGreen" . "#32CD32") + ("Linen" . "#FAF0E6") + ("Magenta" . "#FF00FF") + ("Maroon" . "#800000") + ("MediumAquaMarine" . "#66CDAA") + ("MediumBlue" . "#0000CD") + ("MediumOrchid" . "#BA55D3") + ("MediumPurple" . "#9370D8") + ("MediumSeaGreen" . "#3CB371") + ("MediumSlateBlue" . "#7B68EE") + ("MediumSpringGreen" . "#00FA9A") + ("MediumTurquoise" . "#48D1CC") + ("MediumVioletRed" . "#C71585") + ("MidnightBlue" . "#191970") + ("MintCream" . "#F5FFFA") + ("MistyRose" . "#FFE4E1") + ("Moccasin" . "#FFE4B5") + ("NavajoWhite" . "#FFDEAD") + ("Navy" . "#000080") + ("OldLace" . "#FDF5E6") + ("Olive" . "#808000") + ("OliveDrab" . "#6B8E23") + ("Orange" . "#FFA500") + ("OrangeRed" . "#FF4500") + ("Orchid" . "#DA70D6") + ("PaleGoldenRod" . "#EEE8AA") + ("PaleGreen" . "#98FB98") + ("PaleTurquoise" . "#AFEEEE") + ("PaleVioletRed" . "#D87093") + ("PapayaWhip" . "#FFEFD5") + ("PeachPuff" . "#FFDAB9") + ("Peru" . "#CD853F") + ("Pink" . "#FFC0CB") + ("Plum" . "#DDA0DD") + ("PowderBlue" . "#B0E0E6") + ("Purple" . "#800080") + ("Red" . "#FF0000") + ("RosyBrown" . "#BC8F8F") + ("RoyalBlue" . "#4169E1") + ("SaddleBrown" . "#8B4513") + ("Salmon" . "#FA8072") + ("SandyBrown" . "#F4A460") + ("SeaGreen" . "#2E8B57") + ("SeaShell" . "#FFF5EE") + ("Sienna" . "#A0522D") + ("Silver" . "#C0C0C0") + ("SkyBlue" . "#87CEEB") + ("SlateBlue" . "#6A5ACD") + ("SlateGray" . "#708090") + ("SlateGrey" . "#708090") + ("Snow" . "#FFFAFA") + ("SpringGreen" . "#00FF7F") + ("SteelBlue" . "#4682B4") + ("Tan" . "#D2B48C") + ("Teal" . "#008080") + ("Thistle" . "#D8BFD8") + ("Tomato" . "#FF6347") + ("Turquoise" . "#40E0D0") + ("Violet" . "#EE82EE") + ("Wheat" . "#F5DEB3") + ("White" . "#FFFFFF") + ("WhiteSmoke" . "#F5F5F5") + ("Yellow" . "#FFFF00") + ("YellowGreen" . "#9ACD32")) + "Alist of HTML colors. +Each entry should have the form (COLOR-NAME . HEXADECIMAL-COLOR).") + +(defun shr-color-relative-to-absolute (number) + "Convert a relative NUMBER to absolute. If NUMBER is absolute, return NUMBER. +This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"." + (let ((string-length (- (length number) 1))) + ;; Is this a number with %? + (if (eq (elt number string-length) ?%) + (/ (* (string-to-number (substring number 0 string-length)) 255) 100) + (string-to-number number)))) + +(defun shr-color-hue-to-rgb (x y h) + "Convert X Y H to RGB value." + (when (< h 0) (incf h)) + (when (> h 1) (decf h)) + (cond ((< h (/ 1 6.0)) (+ x (* (- y x) h 6))) + ((< h 0.5) y) + ((< h (/ 2.0 3.0)) (+ x (* (- y x) (- (/ 2.0 3.0) h) 6))) + (t x))) + +(defun shr-color-hsl-to-rgb-fractions (h s l) + "Convert H S L to fractional RGB values." + (let (m1 m2) + (if (<= l 0.5) + (setq m2 (* l (+ s 1))) + (setq m2 (- (+ l s) (* l s)))) + (setq m1 (- (* l 2) m2)) + (list (shr-color-hue-to-rgb m1 m2 (+ h (/ 1 3.0))) + (shr-color-hue-to-rgb m1 m2 h) + (shr-color-hue-to-rgb m1 m2 (- h (/ 1 3.0)))))) + +(defun shr-color->hexadecimal (color) + "Convert any color format to hexadecimal representation. +Like rgb() or hsl()." + (when color + (cond + ;; Hexadecimal color: #abc or #aabbcc + ((string-match + "\\(#[0-9a-fA-F]\\{3\\}[0-9a-fA-F]\\{3\\}?\\)" + color) + (match-string 1 color)) + ;; rgb() or rgba() colors + ((or (string-match + "rgb(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*)" + color) + (string-match + "rgba(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*[0-9]*\.?[0-9]+\s*%?\s*)" + color)) + (format "#%02X%02X%02X" + (shr-color-relative-to-absolute (match-string-no-properties 1 color)) + (shr-color-relative-to-absolute (match-string-no-properties 2 color)) + (shr-color-relative-to-absolute (match-string-no-properties 3 color)))) + ;; hsl() or hsla() colors + ((or (string-match + "hsl(\s*\\([0-9]\\{1,3\\}\\)\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*)" + color) + (string-match + "hsla(\s*\\([0-9]\\{1,3\\}\\)\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*[0-9]*\.?[0-9]+\s*%?\s*)" + color)) + (let ((h (/ (string-to-number (match-string-no-properties 1 color)) 360.0)) + (s (/ (string-to-number (match-string-no-properties 2 color)) 100.0)) + (l (/ (string-to-number (match-string-no-properties 3 color)) 100.0))) + (destructuring-bind (r g b) + (shr-color-hsl-to-rgb-fractions h s l) + (color-rgb->hex r g b)))) + ;; Color names + ((cdr (assoc-string color shr-color-html-colors-alist t))) + ;; Unrecognized color :( + (t + nil)))) + +(defun set-minimum-interval (val1 val2 min max interval &optional fixed) + "Set minimum interval between VAL1 and VAL2 to INTERVAL. +The values are bound by MIN and MAX. +If FIXED is t, then val1 will not be touched." + (let ((diff (abs (- val1 val2)))) + (unless (>= diff interval) + (if fixed + (let* ((missing (- interval diff)) + ;; If val2 > val1, try to increase val2 + ;; That's the "good direction" + (val2-good-direction + (if (> val2 val1) + (min max (+ val2 missing)) + (max min (- val2 missing)))) + (diff-val2-good-direction-val1 (abs (- val2-good-direction val1)))) + (if (>= diff-val2-good-direction-val1 interval) + (setq val2 val2-good-direction) + ;; Good-direction is not so good, compute bad-direction + (let* ((val2-bad-direction + (if (> val2 val1) + (max min (- val1 interval)) + (min max (+ val1 interval)))) + (diff-val2-bad-direction-val1 (abs (- val2-bad-direction val1)))) + (if (>= diff-val2-bad-direction-val1 interval) + (setq val2 val2-bad-direction) + ;; Still not good, pick the best and prefer good direction + (setq val2 + (if (>= diff-val2-good-direction-val1 diff-val2-bad-direction-val1) + val2-good-direction + val2-bad-direction)))))) + ;; No fixed, move val1 and val2 + (let ((missing (/ (- interval diff) 2.0))) + (if (< val1 val2) + (setq val1 (max min (- val1 missing)) + val2 (min max (+ val2 missing))) + (setq val2 (max min (- val2 missing)) + val1 (min max (+ val1 missing)))) + (setq diff (abs (- val1 val2))) ; Recompute diff + (unless (>= diff interval) + ;; Not ok, we hit a boundary + (let ((missing (- interval diff))) + (cond ((= val1 min) + (setq val2 (+ val2 missing))) + ((= val2 min) + (setq val1 (+ val1 missing))) + ((= val1 max) + (setq val2 (- val2 missing))) + ((= val2 max) + (setq val1 (- val1 missing))))))))) + (list val1 val2))) + +(defun shr-color-visible (bg fg &optional fixed-background) + "Check that BG and FG colors are visible if they are drawn on each other. +Return (bg fg) if they are. If they are too similar, two new +colors are returned instead. +If FIXED-BACKGROUND is set, and if the color are not visible, a +new background color will not be computed. Only the foreground +color will be adapted to be visible on BG." + ;; Convert fg and bg to CIE Lab + (let ((fg-norm (color-rgb->normalize fg)) + (bg-norm (color-rgb->normalize bg))) + (if (or (null fg-norm) + (null bg-norm)) + (list bg fg) + (let* ((fg-lab (apply 'color-srgb->lab fg-norm)) + (bg-lab (apply 'color-srgb->lab bg-norm)) + ;; Compute color distance using CIE DE 2000 + (fg-bg-distance (color-cie-de2000 fg-lab bg-lab)) + ;; Compute luminance distance (substract L component) + (luminance-distance (abs (- (car fg-lab) (car bg-lab))))) + (if (and (>= fg-bg-distance shr-color-visible-distance-min) + (>= luminance-distance shr-color-visible-luminance-min)) + (list bg fg) + ;; Not visible, try to change luminance to make them visible + (let ((Ls (set-minimum-interval (car bg-lab) (car fg-lab) 0 100 + shr-color-visible-luminance-min + fixed-background))) + (unless fixed-background + (setcar bg-lab (car Ls))) + (setcar fg-lab (cadr Ls)) + (list + (if fixed-background + bg + (apply 'format "#%02x%02x%02x" + (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) + (apply 'color-lab->srgb bg-lab)))) + (apply 'format "#%02x%02x%02x" + (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) + (apply 'color-lab->srgb fg-lab)))))))))) + +(provide 'shr-color) + +;;; shr-color.el ends here diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 6499b35d072..692d1262348 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -53,18 +53,23 @@ fit these criteria." :group 'shr :type 'regexp) -(defcustom shr-table-line ?- - "Character used to draw table line." +(defcustom shr-table-horizontal-line ?- + "Character used to draw horizontal table lines." + :group 'shr + :type 'character) + +(defcustom shr-table-vertical-line ?| + "Character used to draw vertical table lines." :group 'shr :type 'character) (defcustom shr-table-corner ?+ - "Character used to draw table corner." + "Character used to draw table corners." :group 'shr :type 'character) (defcustom shr-hr-line ?- - "Character used to draw hr line." + "Character used to draw hr lines." :group 'shr :type 'character) @@ -87,6 +92,9 @@ cid: URL as the argument.") (defvar shr-inhibit-images nil) (defvar shr-list-mode nil) (defvar shr-content-cache nil) +(defvar shr-kinsoku-shorten nil) +(defvar shr-table-depth 0) +(defvar shr-stylesheet nil) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -95,6 +103,7 @@ cid: URL as the argument.") (define-key map "I" 'shr-insert-image) (define-key map "u" 'shr-copy-url) (define-key map "v" 'shr-browse-url) + (define-key map "o" 'shr-save-contents) (define-key map "\r" 'shr-browse-url) map)) @@ -149,7 +158,7 @@ redirects somewhere else." (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) @@ -158,7 +167,7 @@ redirects somewhere else." (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) @@ -176,24 +185,57 @@ redirects somewhere else." result)) (dolist (sub dom) (if (stringp sub) - (push (cons :text sub) result) + (push (cons 'text sub) result) (push (shr-transform-dom sub) result))) (nreverse result))) (defun shr-descend (dom) - (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray))) + (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)) + (style (cdr (assq :style (cdr dom)))) + (shr-stylesheet shr-stylesheet) + (start (point))) + (when style + (if (string-match "color" style) + (setq shr-stylesheet (nconc (shr-parse-style style) + shr-stylesheet)) + (setq style nil))) (if (fboundp function) (funcall function (cdr dom)) - (shr-generic (cdr dom))))) + (shr-generic (cdr dom))) + ;; If style is set, then this node has set the color. + (when style + (shr-colorize-region start (point) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet)))))) (defun shr-generic (cont) (dolist (sub cont) (cond - ((eq (car sub) :text) + ((eq (car sub) 'text) (shr-insert (cdr sub))) ((listp (cdr sub)) (shr-descend sub))))) +(defmacro shr-char-breakable-p (char) + "Return non-nil if a line can be broken before and after CHAR." + `(aref fill-find-break-point-function-table ,char)) +(defmacro shr-char-nospace-p (char) + "Return non-nil if no space is required before and after CHAR." + `(aref fill-nospace-between-words-table ,char)) + +;; KINSOKU is a Japanese word meaning a rule that should not be violated. +;; In Emacs, it is a term used for characters, e.g. punctuation marks, +;; parentheses, and so on, that should not be placed in the beginning +;; of a line or the end of a line. +(defmacro shr-char-kinsoku-bol-p (char) + "Return non-nil if a line ought not to begin with CHAR." + `(aref (char-category-set ,char) ?>)) +(defmacro shr-char-kinsoku-eol-p (char) + "Return non-nil if a line ought not to end with CHAR." + `(aref (char-category-set ,char) ?<)) +(unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35)) + (load "kinsoku" nil t)) + (defun shr-insert (text) (when (and (eq shr-state 'image) (not (string-match "\\`[ \t\n]+\\'" text))) @@ -203,78 +245,137 @@ redirects somewhere else." ((eq shr-folding-mode 'none) (insert text)) (t - (let ((first t) - column) - (when (and (string-match "\\`[ \t\n]" text) - (not (bolp)) - (not (eq (char-after (1- (point))) ? ))) - (insert " ")) - (dolist (elem (split-string text)) - (when (and (bolp) - (> shr-indentation 0)) - (shr-indent)) - ;; The shr-start is a special variable that is used to pass - ;; upwards the first point in the buffer where the text really - ;; starts. - (unless shr-start - (setq shr-start (point))) - ;; No space is needed before or after a breakable character or - ;; at the beginning of a line. + (when (and (string-match "\\`[ \t\n]" text) + (not (bolp)) + (not (eq (char-after (1- (point))) ? ))) + (insert " ")) + (dolist (elem (split-string text)) + (when (and (bolp) + (> shr-indentation 0)) + (shr-indent)) + ;; The shr-start is a special variable that is used to pass + ;; upwards the first point in the buffer where the text really + ;; starts. + (unless shr-start + (setq shr-start (point))) + ;; No space is needed behind a wide character categorized as + ;; kinsoku-bol, between characters both categorized as nospace, + ;; or at the beginning of a line. + (let (prev) (when (and (eq (preceding-char) ? ) (or (= (line-beginning-position) (1- (point))) - (aref fill-find-break-point-function-table - (char-after (- (point) 2))) - (aref fill-find-break-point-function-table - (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")) + (and (shr-char-breakable-p + (setq prev (char-after (- (point) 2)))) + (shr-char-kinsoku-bol-p prev)) + (and (shr-char-nospace-p prev) + (shr-char-nospace-p (aref elem 0))))) + (delete-char -1))) + (insert elem) + (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. - (if (eq (following-char) ? ) - (delete-char 1))) + (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)))))) - -(eval-and-compile (autoload 'kinsoku-longer "kinsoku")) + (insert " "))) + (unless (string-match "[ \t\n]\\'" text) + (delete-char -1))))) (defun shr-find-fill-point () - (let ((found nil)) - (while (and (not found) - (> (current-column) shr-indentation)) - (when (and (or (eq (preceding-char) ? ) - (aref fill-find-break-point-function-table - (preceding-char))) - (<= (current-column) shr-width)) - (setq found t)) - (backward-char 1) - (when (bolp) + (when (> (move-to-column shr-width) shr-width) + (backward-char 1)) + (let ((bp (point)) + failed) + (while (not (or (setq failed (= (current-column) shr-indentation)) + (eq (preceding-char) ? ) + (eq (following-char) ? ) + (shr-char-breakable-p (preceding-char)) + (shr-char-breakable-p (following-char)) + (if (eq (preceding-char) ?') + (not (memq (char-after (- (point) 2)) + (list nil ?\n ? ))) + (and (shr-char-kinsoku-bol-p (preceding-char)) + (shr-char-breakable-p (following-char)) + (not (shr-char-kinsoku-bol-p (following-char))))) + (shr-char-kinsoku-eol-p (following-char)))) + (backward-char 1)) + (if (and (not (or failed (eolp))) + (eq (preceding-char) ?')) + (while (not (or (setq failed (eolp)) + (eq (following-char) ? ) + (shr-char-breakable-p (following-char)) + (shr-char-kinsoku-eol-p (following-char)))) + (forward-char 1))) + (if failed ;; There's no breakable point, so we give it up. - (end-of-line) - (while (aref fill-find-break-point-function-table - (preceding-char)) - (backward-char 1)) - (setq found 'failed))) - (cond ((eq found t) - ;; Don't put kinsoku-bol characters at the beginning of a line. - (or (eobp) - (kinsoku-longer) - (not (aref fill-find-break-point-function-table - (following-char))) - (forward-char 1))) - (found t) - (t - (end-of-line) - nil)))) + (let (found) + (goto-char bp) + (unless shr-kinsoku-shorten + (while (and (setq found (re-search-forward + "\\(\\c>\\)\\| \\|\\c<\\|\\c|" + (line-end-position) 'move)) + (eq (preceding-char) ?'))) + (if (and found (not (match-beginning 1))) + (goto-char (match-beginning 0))))) + (or + (eolp) + ;; Don't put kinsoku-bol characters at the beginning of a line, + ;; or kinsoku-eol characters at the end of a line. + (cond + (shr-kinsoku-shorten + (while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? ))) + (shr-char-kinsoku-eol-p (preceding-char))) + (backward-char 1)) + (when (setq failed (= (current-column) shr-indentation)) + ;; There's no breakable point that doesn't violate kinsoku, + ;; so we look for the second best position. + (while (and (progn + (forward-char 1) + (<= (current-column) shr-width)) + (progn + (setq bp (point)) + (shr-char-kinsoku-eol-p (following-char))))) + (goto-char bp))) + ((shr-char-kinsoku-eol-p (preceding-char)) + (if (shr-char-kinsoku-eol-p (following-char)) + ;; There are consecutive kinsoku-eol characters. + (setq failed t) + (let ((count 4)) + (while + (progn + (backward-char 1) + (and (> (setq count (1- count)) 0) + (not (memq (preceding-char) (list ?\C-@ ?\n ? ))) + (or (shr-char-kinsoku-eol-p (preceding-char)) + (shr-char-kinsoku-bol-p (following-char))))))) + (if (setq failed (= (current-column) shr-indentation)) + ;; There's no breakable point that doesn't violate kinsoku, + ;; so we go to the second best position. + (if (looking-at "\\(\\c<+\\)\\c<") + (goto-char (match-end 1)) + (forward-char 1))))) + (t + (if (shr-char-kinsoku-bol-p (preceding-char)) + ;; There are consecutive kinsoku-bol characters. + (setq failed t) + (let ((count 4)) + (while (and (>= (setq count (1- count)) 0) + (shr-char-kinsoku-bol-p (following-char)) + (shr-char-breakable-p (following-char))) + (forward-char 1)))))) + (when (eq (following-char) ? ) + (forward-char 1)))) + (not failed))) (defun shr-ensure-newline () (unless (zerop (current-column)) @@ -303,17 +404,49 @@ redirects somewhere else." (dolist (type types) (shr-add-font (or shr-start (point)) (point) type)))) +;; Add an overlay in the region, but avoid putting the font properties +;; on blank text at the start of the line, and the newline at the end, +;; to avoid ugliness. (defun shr-add-font (start end type) - (let ((overlay (make-overlay start end))) - (overlay-put overlay 'face type))) + (save-excursion + (goto-char start) + (while (< (point) end) + (when (bolp) + (skip-chars-forward " ")) + (let ((overlay (make-overlay (point) (min (line-end-position) end)))) + (overlay-put overlay 'face type)) + (if (< (line-end-position) end) + (forward-line 1) + (goto-char end))))) (defun shr-browse-url () "Browse the URL under point." (interactive) (let ((url (get-text-property (point) 'shr-url))) + (cond + ((not url) + (message "No link under point")) + ((string-match "^mailto:" url) + (browse-url-mailto url)) + (t + (browse-url url))))) + +(defun shr-save-contents (directory) + "Save the contents from URL in a file." + (interactive "DSave contents of URL to directory: ") + (let ((url (get-text-property (point) 'shr-url))) (if (not url) (message "No link under point") - (browse-url url)))) + (url-retrieve (shr-encode-url url) + 'shr-store-contents (list url directory))))) + +(defun shr-store-contents (status url directory) + (unless (plist-get status :error) + (when (or (search-forward "\n\n" nil t) + (search-forward "\r\n\r\n" nil t)) + (write-region (point) (point-max) + (expand-file-name (file-name-nondirectory url) + directory))))) (defun shr-image-fetched (status buffer start end) (when (and (buffer-name buffer) @@ -326,16 +459,22 @@ redirects somewhere else." (let ((alt (buffer-substring start end)) (inhibit-read-only t)) (delete-region start end) - (shr-put-image data start alt)))))) + (goto-char start) + (shr-put-image data alt)))))) (kill-buffer (current-buffer))) -(defun shr-put-image (data point alt) - (if (not (display-graphic-p)) - (insert alt) - (let ((image (ignore-errors - (shr-rescale-image data)))) - (when image - (put-image image point alt))))) +(defun shr-put-image (data alt) + (if (display-graphic-p) + (let ((image (ignore-errors + (shr-rescale-image data)))) + (when image + ;; When inserting big-ish pictures, put them at the + ;; beginning of the line. + (when (and (> (current-column) 0) + (> (car (image-size image t)) 400)) + (insert "\n")) + (insert-image image (or alt "*")))) + (insert alt))) (defun shr-rescale-image (data) (if (or (not (fboundp 'imagemagick-types)) @@ -364,6 +503,11 @@ redirects somewhere else." image))) image))) +;; 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. Return a string with image data." @@ -376,19 +520,146 @@ Return a string with image data." (search-forward "\r\n\r\n" nil t)) (buffer-substring (point) (point-max)))))) +(defun shr-image-displayer (content-function) + "Return a function to display an image. +CONTENT-FUNCTION is a function to retrieve an image for a cid url that +is an argument. The function to be returned takes three arguments URL, +START, and END. Note that START and END should be merkers." + `(lambda (url start end) + (when url + (if (string-match "\\`cid:" url) + ,(when content-function + `(let ((image (funcall ,content-function + (substring url (match-end 0))))) + (when image + (goto-char start) + (shr-put-image image + (buffer-substring-no-properties start end)) + (delete-region (point) end)))) + (url-retrieve url 'shr-image-fetched + (list (current-buffer) start end) + t))))) + (defun shr-heading (cont &rest types) (shr-ensure-paragraph) (apply #'shr-fontize-cont cont types) (shr-ensure-paragraph)) +(autoload 'widget-convert-button "wid-edit") + +(defun shr-urlify (start url &optional title) + (widget-convert-button + 'url-link start (point) + :help-echo (if title (format "%s (%s)" url title) url) + :keymap shr-map + url) + (put-text-property start (point) 'shr-url url)) + +(defun shr-encode-url (url) + "Encode URL." + (browse-url-url-encode-chars url "[)$ ]")) + +(autoload 'shr-color-visible "shr-color") +(autoload 'shr-color->hexadecimal "shr-color") + +(defun shr-color-check (fg bg) + "Check that FG is visible on BG. +Returns (fg bg) with corrected values. +Returns nil if the colors that would be used are the default +ones, in case fg and bg are nil." + (when (or fg bg) + (let ((fixed (cond ((null fg) 'fg) + ((null bg) 'bg)))) + ;; Convert colors to hexadecimal, or set them to default. + (let ((fg (or (shr-color->hexadecimal fg) + (frame-parameter nil 'foreground-color))) + (bg (or (shr-color->hexadecimal bg) + (frame-parameter nil 'background-color)))) + (cond ((eq fixed 'bg) + ;; Only return the new fg + (list nil (cadr (shr-color-visible bg fg t)))) + ((eq fixed 'fg) + ;; Invert args and results and return only the new bg + (list (cadr (shr-color-visible fg bg t)) nil)) + (t + (shr-color-visible bg fg))))))) + +(defun shr-colorize-region (start end fg &optional bg) + (when (or fg bg) + (let ((new-colors (shr-color-check fg bg))) + (when new-colors + (when fg + (shr-put-color start end :foreground (cadr new-colors))) + (when bg + (shr-put-color start end :background (car new-colors))))))) + +;; Put a color in the region, but avoid putting colors on on blank +;; text at the start of the line, and the newline at the end, to avoid +;; ugliness. Also, don't overwrite any existing color information, +;; since this can be called recursively, and we want the "inner" color +;; to win. +(defun shr-put-color (start end type color) + (save-excursion + (goto-char start) + (while (< (point) end) + (when (bolp) + (skip-chars-forward " ")) + (when (> (line-end-position) (point)) + (shr-put-color-1 (point) (min (line-end-position) end) type color)) + (if (< (line-end-position) end) + (forward-line 1) + (goto-char end))))) + +(defun shr-put-color-1 (start end type color) + (let* ((old-props (get-text-property start 'face)) + (do-put (not (memq type old-props))) + change) + (while (< start end) + (setq change (next-single-property-change start 'face nil end)) + (when do-put + (put-text-property start change 'face + (nconc (list type color) old-props))) + (setq old-props (get-text-property change 'face)) + (setq do-put (not (memq type old-props))) + (setq start change)) + (when (and do-put + (> end start)) + (put-text-property start end 'face + (nconc (list type color old-props)))))) + ;;; Tag-specific rendering rules. +(defun shr-tag-body (cont) + (let* ((start (point)) + (fgcolor (cdr (assq :fgcolor cont))) + (bgcolor (cdr (assq :bgcolor cont))) + (shr-stylesheet (list (cons 'color fgcolor) + (cons 'background-color bgcolor)))) + (shr-generic cont) + (shr-colorize-region start (point) fgcolor bgcolor))) + +(defun shr-tag-style (cont) + ) + +(defun shr-tag-script (cont) + ) + +(defun shr-tag-label (cont) + (shr-generic cont) + (shr-ensure-paragraph)) + (defun shr-tag-p (cont) (shr-ensure-paragraph) (shr-indent) (shr-generic cont) (shr-ensure-paragraph)) +(defun shr-tag-div (cont) + (shr-ensure-newline) + (shr-indent) + (shr-generic cont) + (shr-ensure-newline)) + (defun shr-tag-b (cont) (shr-fontize-cont cont 'bold)) @@ -398,59 +669,81 @@ Return a string with image data." (defun shr-tag-em (cont) (shr-fontize-cont cont 'bold)) +(defun shr-tag-strong (cont) + (shr-fontize-cont cont 'bold)) + (defun shr-tag-u (cont) (shr-fontize-cont cont 'underline)) (defun shr-tag-s (cont) (shr-fontize-cont cont 'strike-through)) +(defun shr-parse-style (style) + (when style + (save-match-data + (when (string-match "\n" style) + (setq style (replace-match " " t t style)))) + (let ((plist nil)) + (dolist (elem (split-string style ";")) + (when elem + (setq elem (split-string elem ":")) + (when (and (car elem) + (cadr elem)) + (let ((name (replace-regexp-in-string "^ +\\| +$" "" (car elem))) + (value (replace-regexp-in-string "^ +\\| +$" "" (cadr elem)))) + (when (string-match " *!important\\'" value) + (setq value (substring value 0 (match-beginning 0)))) + (push (cons (intern name obarray) + value) + plist))))) + plist))) + (defun shr-tag-a (cont) (let ((url (cdr (assq :href cont))) + (title (cdr (assq :title cont))) (start (point)) shr-start) (shr-generic cont) - (widget-convert-button - 'url-link (or shr-start start) (point) - :help-echo url - :keymap shr-map - url) - (put-text-property (or shr-start start) (point) 'shr-url url))) + (shr-urlify (or shr-start start) url title))) -(defun shr-encode-url (url) - "Encode URL." - (browse-url-url-encode-chars url "[)$ ]")) +(defun shr-tag-object (cont) + (let ((start (point)) + url) + (dolist (elem cont) + (when (eq (car elem) 'embed) + (setq url (or url (cdr (assq :src (cdr elem)))))) + (when (and (eq (car elem) 'param) + (equal (cdr (assq :name (cdr elem))) "movie")) + (setq url (or url (cdr (assq :value (cdr elem))))))) + (when url + (shr-insert " [multimedia] ") + (shr-urlify start url)) + (shr-generic cont))) -(defun shr-tag-img (cont) - (when cont +(defun shr-tag-video (cont) + (let ((image (cdr (assq :poster cont))) + (url (cdr (assq :src cont))) + (start (point))) + (shr-tag-img nil image) + (shr-urlify start url))) + +(defun shr-tag-img (cont &optional url) + (when (or url + (and cont + (cdr (assq :src cont)))) (when (and (> (current-column) 0) (not (eq shr-state 'image))) (insert "\n")) (let ((alt (cdr (assq :alt cont))) - (url (cdr (assq :src cont))) - (width (cdr (assq :width cont)))) - ;; Only respect align if width specified. - (when width - ;; Check that width is not larger than max width, otherwise ignore - ;; align - (let ((max-width (* shr-width (frame-char-width))) - (width (string-to-number width))) - (when (< width max-width) - (let ((align (cdr (assq :align cont)))) - (cond - ((string= align "right") - (insert (propertize - " " 'display - `(space . (:align-to - ,(list (- max-width width))))))) - ((string= align "center") - (insert (propertize - " " 'display - `(space . (:balign-to - ,(list (- (/ max-width 2) width)))))))))))) + (url (or url (cdr (assq :src cont))))) (let ((start (point-marker))) (when (zerop (length alt)) - (setq alt "[img]")) + (setq alt "*")) (cond + ((or (member (cdr (assq :height cont)) '("0" "1")) + (member (cdr (assq :width cont)) '("0" "1"))) + ;; Ignore zero-sized or single-pixel images. + ) ((and (not shr-inhibit-images) (string-match "\\`cid:" url)) (let ((url (substring url (match-end 0))) @@ -458,27 +751,29 @@ Return a string with image data." (if (or (not shr-content-function) (not (setq image (funcall shr-content-function url)))) (insert alt) - (shr-put-image image (point) alt)))) + (shr-put-image image alt)))) ((or shr-inhibit-images (and shr-blocked-images (string-match shr-blocked-images url))) (setq shr-start (point)) (let ((shr-state 'space)) - (if (> (length alt) 8) - (shr-insert (substring alt 0 8)) + (if (> (string-width alt) 8) + (shr-insert (truncate-string-to-width alt 8)) (shr-insert alt)))) ((url-is-cached (shr-encode-url url)) - (shr-put-image (shr-get-image-data url) (point) alt)) + (shr-put-image (shr-get-image-data url) alt)) (t (insert alt) (ignore-errors (url-retrieve (shr-encode-url url) 'shr-image-fetched (list (current-buffer) start (point-marker)) t)))) - (insert " ") (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 + (shr-image-displayer shr-content-function)) + (put-text-property start (point) 'help-echo alt) (setq shr-state 'image))))) (defun shr-tag-pre (cont) @@ -548,6 +843,19 @@ Return a string with image data." (shr-ensure-newline) (insert (make-string shr-width shr-hr-line) "\n")) +(defun shr-tag-title (cont) + (shr-heading cont 'bold 'underline)) + +(defun shr-tag-font (cont) + (let* ((start (point)) + (color (cdr (assq :color cont))) + (shr-stylesheet (nconc (list (cons 'color color)) + shr-stylesheet))) + (shr-generic cont) + (when color + (shr-colorize-region start (point) color + (cdr (assq 'background-color shr-stylesheet)))))) + ;;; Table rendering algorithm. ;; Table rendering is the only complicated thing here. We do this by @@ -558,11 +866,12 @@ Return a string with image data." ;; main buffer). Now we know how much space each TD really takes, so ;; we then render everything again with the new widths, and finally ;; insert all these boxes into the main buffer. -(defun shr-tag-table (cont) - (shr-ensure-paragraph) +(defun shr-tag-table-1 (cont) (setq cont (or (cdr (assq 'tbody cont)) cont)) (let* ((shr-inhibit-images t) + (shr-table-depth (1+ shr-table-depth)) + (shr-kinsoku-shorten t) ;; Find all suggested widths. (columns (shr-column-specs cont)) ;; Compute how many characters wide each TD should be. @@ -573,8 +882,9 @@ Return a string with image data." (sketch (shr-make-table cont suggested-widths)) (sketch-widths (shr-table-widths sketch suggested-widths))) ;; This probably won't work very well. - (when (> (1+ (loop for width across sketch-widths - summing (1+ width))) + (when (> (+ (loop for width across sketch-widths + summing (1+ width)) + shr-indentation 1) (frame-width)) (setq truncate-lines t)) ;; Then render the table again with these new "hard" widths. @@ -582,8 +892,64 @@ Return a string with image data." ;; Finally, insert all the images after the table. The Emacs buffer ;; model isn't strong enough to allow us to put the images actually ;; into the tables. - (dolist (elem (shr-find-elements cont 'img)) - (shr-tag-img (cdr elem)))) + (when (zerop shr-table-depth) + (dolist (elem (shr-find-elements cont 'img)) + (shr-tag-img (cdr elem))))) + +(defun shr-tag-table (cont) + (shr-ensure-paragraph) + (let* ((caption (cdr (assq 'caption cont))) + (header (cdr (assq 'thead cont))) + (body (or (cdr (assq 'tbody cont)) cont)) + (footer (cdr (assq 'tfoot cont))) + (bgcolor (cdr (assq :bgcolor cont))) + (start (point)) + (shr-stylesheet (nconc (list (cons 'background-color bgcolor)) + shr-stylesheet)) + (nheader (if header (shr-max-columns header))) + (nbody (if body (shr-max-columns body))) + (nfooter (if footer (shr-max-columns footer)))) + (shr-tag-table-1 + (nconc + (if caption `((tr (td ,@caption)))) + (if header + (if footer + ;; hader + body + footer + (if (= nheader nbody) + (if (= nbody nfooter) + `((tr (td (table (tbody ,@header ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@header ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))) + (nconc `((tr (td (table (tbody ,@header))))) + (if (= nbody nfooter) + `((tr (td (table (tbody ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))))) + ;; header + body + (if (= nheader nbody) + `((tr (td (table (tbody ,@header ,@body))))) + (if (= nheader 1) + `(,@header (tr (td (table (tbody ,@body))))) + `((tr (td (table (tbody ,@header)))) + (tr (td (table (tbody ,@body)))))))) + (if footer + ;; body + footer + (if (= nbody nfooter) + `((tr (td (table (tbody ,@body ,@footer))))) + (nconc `((tr (td (table (tbody ,@body))))) + (if (= nfooter 1) + footer + `((tr (td (table (tbody ,@footer)))))))) + (if caption + `((tr (td (table (tbody ,@body))))) + body))))) + (when bgcolor + (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet)) + bgcolor)))) (defun shr-find-elements (cont type) (let (result) @@ -604,7 +970,7 @@ Return a string with image data." max))) (dotimes (i height) (shr-indent) - (insert "|\n")) + (insert shr-table-vertical-line "\n")) (dolist (column row) (goto-char start) (let ((lines (nth 2 column)) @@ -613,7 +979,7 @@ Return a string with image data." (dolist (line lines) (setq overlay-line (pop overlay-lines)) (end-of-line) - (insert line "|") + (insert line shr-table-vertical-line) (dolist (overlay overlay-line) (let ((o (make-overlay (- (point) (nth 0 overlay) 1) (- (point) (nth 1 overlay) 1))) @@ -625,15 +991,19 @@ Return a string with image data." ;; possibly. (dotimes (i (- height (length lines))) (end-of-line) - (insert (make-string (length (car lines)) ? ) "|") + (insert (make-string (string-width (car lines)) ? ) + shr-table-vertical-line) (forward-line 1))))) (shr-insert-table-ruler widths))) (defun shr-insert-table-ruler (widths) - (shr-indent) + (when (and (bolp) + (> shr-indentation 0)) + (shr-indent)) (insert shr-table-corner) (dotimes (i (length widths)) - (insert (make-string (aref widths i) shr-table-line) shr-table-corner)) + (insert (make-string (aref widths i) shr-table-horizontal-line) + shr-table-corner)) (insert "\n")) (defun shr-table-widths (table suggested-widths) @@ -685,43 +1055,73 @@ Return a string with image data." (defun shr-render-td (cont width fill) (with-temp-buffer - (let ((cache (cdr (assoc (cons width cont) shr-content-cache)))) - (if cache - (insert cache) - (let ((shr-width width) - (shr-indentation 0)) - (shr-generic cont)) - (delete-region - (point) - (+ (point) - (skip-chars-backward " \t\n"))) - (push (cons (cons width cont) (buffer-string)) - shr-content-cache))) - (goto-char (point-min)) - (let ((max 0)) - (while (not (eobp)) - (end-of-line) - (setq max (max max (current-column))) - (forward-line 1)) - (when fill - (goto-char (point-min)) - ;; If the buffer is totally empty, then put a single blank - ;; line here. - (if (zerop (buffer-size)) - (insert (make-string width ? )) - ;; Otherwise, fill the buffer. - (while (not (eobp)) - (end-of-line) - (when (> (- width (current-column)) 0) - (insert (make-string (- width (current-column)) ? ))) - (forward-line 1)))) - (if fill + (let ((bgcolor (cdr (assq :bgcolor cont))) + (fgcolor (cdr (assq :fgcolor cont))) + (style (cdr (assq :style cont))) + (shr-stylesheet shr-stylesheet) + overlays) + (when style + (setq style (and (string-match "color" style) + (shr-parse-style style)))) + (when bgcolor + (setq style (nconc (list (cons 'background-color bgcolor)) style))) + (when fgcolor + (setq style (nconc (list (cons 'color fgcolor)) style))) + (when style + (setq shr-stylesheet (append style shr-stylesheet))) + (let ((cache (cdr (assoc (cons width cont) shr-content-cache)))) + (if cache + (progn + (insert (car cache)) + (let ((end (length (car cache)))) + (dolist (overlay (cadr cache)) + (let ((new-overlay + (make-overlay (1+ (- end (nth 0 overlay))) + (1+ (- end (nth 1 overlay))))) + (properties (nth 2 overlay))) + (while properties + (overlay-put new-overlay + (pop properties) (pop properties))))))) + (let ((shr-width width) + (shr-indentation 0)) + (shr-descend (cons 'td cont))) + (delete-region + (point) + (+ (point) + (skip-chars-backward " \t\n"))) + (push (list (cons width cont) (buffer-string) + (shr-overlays-in-region (point-min) (point-max))) + shr-content-cache))) + (goto-char (point-min)) + (let ((max 0)) + (while (not (eobp)) + (end-of-line) + (setq max (max max (current-column))) + (forward-line 1)) + (when fill + (goto-char (point-min)) + ;; If the buffer is totally empty, then put a single blank + ;; line here. + (if (zerop (buffer-size)) + (insert (make-string width ? )) + ;; Otherwise, fill the buffer. + (while (not (eobp)) + (end-of-line) + (when (> (- width (current-column)) 0) + (insert (make-string (- width (current-column)) ? ))) + (forward-line 1)))) + (when style + (shr-colorize-region + (point-min) (point-max) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet)))) + (if fill + (list max + (count-lines (point-min) (point-max)) + (split-string (buffer-string) "\n") + (shr-collect-overlays)) (list max - (count-lines (point-min) (point-max)) - (split-string (buffer-string) "\n") - (shr-collect-overlays)) - (list max - (shr-natural-width)))))) + (shr-natural-width))))))) (defun shr-natural-width () (goto-char (point-min)) diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index 5b5439fab73..a3647061d15 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -1,7 +1,7 @@ ;;; sieve-manage.el --- Implementation of the managesive protocol in elisp -;; 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: Simon Josefsson <simon@josefsson.org> @@ -79,6 +79,7 @@ (require 'password)) (eval-when-compile + (require 'cl) ; caddr (require 'sasl) (require 'starttls)) (autoload 'sasl-find-mechanism "sasl") diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index e28c07ffaad..27db3e35e20 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -426,10 +426,9 @@ Any details (stdout and stderr) are left in the buffer specified by (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 @@ in the buffer specified by `smime-details-buffer'." (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) @@ -587,6 +585,9 @@ A string or a list of strings is returned." (kill-buffer digbuf) retbuf)) +(declare-function ldap-search "ldap" + (filter &optional host attributes attrsonly withdn)) + (defun smime-cert-by-ldap-1 (mail host) "Get cetificate for MAIL from the ldap server at HOST." (let ((ldapresult @@ -595,7 +596,9 @@ A string or a list of strings is returned." (progn (require 'smime-ldap) 'smime-ldap-search) - 'ldap-search) + (progn + (require 'ldap) + 'ldap-search)) (concat "mail=" mail) host '("userCertificate") nil)) (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) @@ -642,20 +645,18 @@ A string or a list of strings is returned." (defvar smime-buffer "*SMIME*") -(defvar smime-mode-map nil) -(put 'smime-mode 'mode-class 'special) - -(unless smime-mode-map - (setq smime-mode-map (make-sparse-keymap)) - (suppress-keymap smime-mode-map) +(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)) - (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. @@ -664,16 +665,10 @@ All normal editing commands are switched off. 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: ") diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 448a0088fb8..097299f30c4 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -1287,6 +1287,7 @@ variable. When the processor variable is nil, just the classification and spam-use-* check variable are used. This is superseded by the new spam backend code, so it's only consulted for backwards compatibility.") +(make-obsolete-variable 'spam-list-of-processors nil "22.1") (defun spam-group-processor-p (group backend &optional classification) "Checks if GROUP has a BACKEND with CLASSIFICATION registered. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index c707baf98c2..65bcdbcb8f8 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -912,7 +912,111 @@ BUFFER should be a buffer or a buffer name." (insert "\nThe parent category table is:") (describe-vector table 'help-describe-category-set)))))) + +;;; Replacements for old lib-src/ programs. Don't seem especially useful. + +;; Replaces lib-src/digest-doc.c. +;;;###autoload +(defun doc-file-to-man (file) + "Produce an nroff buffer containing the doc-strings from the DOC file." + (interactive (list (read-file-name "Name of DOC file: " doc-directory + internal-doc-file-name t))) + (or (file-readable-p file) + (error "Cannot read file `%s'" file)) + (pop-to-buffer (generate-new-buffer "*man-doc*")) + (setq buffer-undo-list t) + (insert ".TH \"Command Summary for GNU Emacs\"\n" + ".AU Richard M. Stallman\n") + (insert-file-contents file) + (let (notfirst) + (while (search-forward " " nil 'move) + (if (looking-at "S") + (delete-region (1- (point)) (line-end-position)) + (delete-char -1) + (if notfirst + (insert "\n.DE\n") + (setq notfirst t)) + (insert "\n.SH ") + (insert (if (looking-at "F") "Function " "Variable ")) + (delete-char 1) + (forward-line 1) + (insert ".DS L\n")))) + (insert "\n.DE\n") + (setq buffer-undo-list nil) + (nroff-mode)) + +;; Replaces lib-src/sorted-doc.c. +;;;###autoload +(defun doc-file-to-info (file) + "Produce a texinfo buffer with sorted doc-strings from the DOC file." + (interactive (list (read-file-name "Name of DOC file: " doc-directory + internal-doc-file-name t))) + (or (file-readable-p file) + (error "Cannot read file `%s'" file)) + (let ((i 0) type name doc alist) + (with-temp-buffer + (insert-file-contents file) + ;; The characters "@{}" need special treatment. + (while (re-search-forward "[@{}]" nil t) + (backward-char) + (insert "@") + (forward-char 1)) + (goto-char (point-min)) + (while (search-forward " " nil t) + (unless (looking-at "S") + (setq type (char-after) + name (buffer-substring (1+ (point)) (line-end-position)) + doc (buffer-substring (line-beginning-position 2) + (if (search-forward " " nil 'move) + (1- (point)) + (point))) + alist (cons (list name type doc) alist)) + (backward-char 1)))) + (pop-to-buffer (generate-new-buffer "*info-doc*")) + (setq buffer-undo-list t) + ;; Write the output header. + (insert "\\input texinfo @c -*-texinfo-*-\n" + "@setfilename emacsdoc.info\n" + "@settitle Command Summary for GNU Emacs\n" + "@finalout\n" + "\n@node Top\n" + "@unnumbered Command Summary for GNU Emacs\n\n" + "@table @asis\n\n" + "@iftex\n" + "@global@let@ITEM@item\n" + "@def@item{@filbreak@vskip5pt@ITEM}\n" + "@font@tensy cmsy10 scaled @magstephalf\n" + "@font@teni cmmi10 scaled @magstephalf\n" + "@def\\{{@tensy@char110}}\n" ; this backslash goes with cmr10 + "@def|{{@tensy@char106}}\n" + "@def@{{{@tensy@char102}}\n" + "@def@}{{@tensy@char103}}\n" + "@def<{{@teni@char62}}\n" + "@def>{{@teni@char60}}\n" + "@chardef@@64\n" + "@catcode43=12\n" + "@tableindent-0.2in\n" + "@end iftex\n") + ;; Sort the array by name; within each name, by type (functions first). + (setq alist (sort alist (lambda (e1 e2) + (if (string-equal (car e1) (car e2)) + (<= (cadr e1) (cadr e2)) + (string-lessp (car e1) (car e2)))))) + ;; Print each function. + (dolist (e alist) + (insert "\n@item " + (if (char-equal (cadr e) ?\F) "Function" "Variable") + " @code{" (car e) "}\n@display\n" + (nth 2 e) + "\n@end display\n") + ;; Try to avoid a save size overflow in the TeX output routine. + (if (zerop (setq i (% (1+ i) 100))) + (insert "\n@end table\n@table @asis\n"))) + (insert "@end table\n" + "@bye\n") + (setq buffer-undo-list nil) + (texinfo-mode))) + (provide 'help-fns) -;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3 ;;; help-fns.el ends here diff --git a/lisp/help.el b/lisp/help.el index a2e721dd6b3..6c6bd76ec4b 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1,7 +1,8 @@ ;;; help.el --- help commands for Emacs ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -119,9 +120,6 @@ (define-key global-map [f1] 'help-command) (fset 'help-command help-map) -(autoload 'finder-by-keyword "finder" - "Find packages matching a given keyword." t) - ;; insert-button makes the action nil if it is not store somewhere (defvar help-button-cache nil) @@ -1252,5 +1250,4 @@ Select help window if the actual value of the user option (provide 'help) -;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423 ;;; help.el ends here diff --git a/lisp/hexl.el b/lisp/hexl.el index ebc43e43d25..8e000e72ecd 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -212,6 +212,7 @@ Quoting cannot be used, so the arguments cannot themselves contain spaces." (defvar hexl-mode-old-syntax-table) (defvar hexl-mode-old-font-lock-keywords) (defvar hexl-mode-old-eldoc-documentation-function) +(defvar hexl-mode-old-revert-buffer-function) (defvar hexl-ascii-overlay nil "Overlay used to highlight ASCII element corresponding to current point.") @@ -373,10 +374,9 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (setq hexl-mode-old-font-lock-keywords font-lock-defaults) (setq font-lock-defaults '(hexl-font-lock-keywords t)) - ;; Add hooks to rehexlify or dehexlify on various events. - (add-hook 'before-revert-hook 'hexl-before-revert-hook nil t) - (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t) - + (make-local-variable 'hexl-mode-old-revert-buffer-function) + (setq hexl-mode-old-revert-buffer-function revert-buffer-function) + (setq revert-buffer-function 'hexl-revert-buffer-function) (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t) ;; Set a callback function for eldoc. @@ -413,12 +413,6 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode. (let ((isearch-search-fun-function nil)) (isearch-search-fun)))) -(defun hexl-before-revert-hook () - (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)) - -(defun hexl-after-revert-hook () - (hexl-mode)) - (defvar hexl-in-save-buffer nil) (defun hexl-save-buffer () @@ -464,6 +458,23 @@ and edit the file in `hexl-mode'." (if (not (eq major-mode 'hexl-mode)) (hexl-mode))) +(defun hexl-revert-buffer-function (ignore-auto noconfirm) + (let ((coding-system-for-read 'no-conversion) + revert-buffer-function) + ;; Call the original `revert-buffer' without code conversion; also + ;; prevent it from changing the major mode to normal-mode, which + ;; calls `set-auto-mode'. + (revert-buffer nil nil t) + ;; A couple of hacks are necessary here: + ;; 1. change the major-mode to one other than hexl-mode since the + ;; function `hexl-mode' does nothing if the current major-mode is + ;; already hexl-mode. + ;; 2. reset change-major-mode-hook in case that `hexl-mode' + ;; previously added hexl-maybe-dehexlify-buffer to it. + (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) + (setq major-mode 'fundamental-mode) + (hexl-mode))) + (defun hexl-mode-exit (&optional arg) "Exit Hexl mode, returning to previous mode. With arg, don't unhexlify buffer." @@ -483,8 +494,6 @@ With arg, don't unhexlify buffer." (or (bobp) (setq original-point (1+ original-point)))) (goto-char original-point))) - (remove-hook 'before-revert-hook 'hexl-before-revert-hook t) - (remove-hook 'after-revert-hook 'hexl-after-revert-hook t) (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t) (remove-hook 'post-command-hook 'hexl-follow-ascii-find t) (setq hexl-ascii-overlay nil) @@ -512,6 +521,7 @@ With arg, don't unhexlify buffer." (set-syntax-table hexl-mode-old-syntax-table) (setq font-lock-defaults hexl-mode-old-font-lock-keywords) (setq major-mode hexl-mode-old-major-mode) + (setq revert-buffer-function hexl-mode-old-revert-buffer-function) (force-mode-line-update)) (defun hexl-maybe-dehexlify-buffer () diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 68c8f70cae3..2533587bcc5 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -716,8 +716,7 @@ string). It returns t if a new completion is found, nil otherwise." (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 @@ string). It returns t if a new completion is found, nil otherwise." (provide 'hippie-exp) -;; arch-tag: 5e6e00bf-b061-4a7a-9b46-de0ae105ab99 ;;; hippie-exp.el ends here diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 196838f248d..33cb9a80bab 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1308,7 +1308,8 @@ a prefix argument reverses the meaning of that variable." (error "No buffer with name %s" name) (goto-char buf-point))))) -(declare-function diff-sentinel "diff" (code)) +(declare-function diff-sentinel "diff" + (code &optional old-temp-file new-temp-file)) (defun ibuffer-diff-buffer-with-file-1 (buffer) (let ((bufferfile (buffer-local-value 'buffer-file-name buffer)) @@ -1594,5 +1595,4 @@ defaults to one." ;; generated-autoload-file: "ibuffer.el" ;; End: -;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d ;;; ibuf-ext.el ends here diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 052d43b41b6..2dab58fb365 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -2639,7 +2639,7 @@ will be inserted before the group at point." ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode -;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "fa9822b5ef905f06d8a03dc9ce3a2894") +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "3840d79a044995c846fe8bbaa9565a2b") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/image.el b/lisp/image.el index 0afdc71cb9e..f93fd03fba3 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -723,21 +723,6 @@ shall be displayed." (cons (concat "\\." extension "\\'") 'imagemagick) image-type-file-name-regexps))))) - -;;; Inline stock images - -(defvar image-checkbox-checked - (create-image "\300\300\141\143\067\076\034\030" - 'xbm t :width 8 :height 8 :background "grey75" - :foreground "black" :relief -2 :ascent 'center) - "Image of a checked checkbox.") - -(defvar image-checkbox-unchecked - (create-image (make-string 8 0) - 'xbm t :width 8 :height 8 :background "grey75" - :foreground "black" :relief -2 :ascent 'center) - "Image of an unchecked checkbox.") - (provide 'image) ;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3 diff --git a/lisp/info.el b/lisp/info.el index 9b0e87b3c25..7c0333f6b8e 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1,8 +1,8 @@ ;; info.el --- info package for Emacs -;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help @@ -888,17 +888,16 @@ Value is the position at which a match was found, or nil if not found." (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 @@ new buffer." 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 @@ parent node." (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) @@ -3379,6 +3372,8 @@ Build a menu of the possible matches." (declare-function find-library-name "find-func" (library)) (declare-function finder-unknown-keywords "finder" ()) (declare-function lm-commentary "lisp-mnt" (&optional file)) +(defvar finder-keywords-hash) +(defvar package-alist) ; finder requires package (defun Info-finder-find-node (filename nodename &optional no-going-back) "Finder-specific implementation of Info-find-node-2." @@ -3768,15 +3763,18 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (let ((map (make-sparse-keymap))) (tool-bar-local-item-from-menu 'Info-history-back "left-arrow" map Info-mode-map :rtl "right-arrow" - :label "Back") + :label "Back" + :vert-only t) (tool-bar-local-item-from-menu 'Info-history-forward "right-arrow" map Info-mode-map :rtl "left-arrow" - :label "Forward") + :label "Forward" + :vert-only t) (tool-bar-local-item-from-menu 'Info-prev "prev-node" map Info-mode-map :rtl "next-node") (tool-bar-local-item-from-menu 'Info-next "next-node" map Info-mode-map :rtl "prev-node") - (tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map) + (tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map + :vert-only t) (tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map) (tool-bar-local-item-from-menu 'Info-goto-node "jump-to" map Info-mode-map) (tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map @@ -4930,5 +4928,4 @@ type returned by `Info-bookmark-make-record', which see." (provide 'info) -;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac ;;; info.el ends here diff --git a/lisp/international/characters.el b/lisp/international/characters.el index cf43bb1e6ca..db5fe7e86ba 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -188,6 +188,9 @@ Combining diacritic or mark (Unicode General Category M)") cp932-2-byte)) (map-charset-chars #'modify-category-entry l ?j)) +;; Fullwidth characters +(modify-category-entry '(#xff01 . #xff60) ?\|) + ;; Unicode equivalents of JISX0201-kana (let ((range '(#xff61 . #xff9f))) (modify-category-entry range ?k) @@ -1231,6 +1234,170 @@ Setup char-width-table appropriate for non-CJK language environment." (optimize-char-table (standard-category-table)) +;; Display of glyphless characters. + +(defvar char-acronym-table + (make-char-table 'char-acronym-table nil) + "Char table of acronyms for non-graphic characters.") + +(let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL" + "BS" nil nil "VT" "FF" "CR" "SO" "SI" + "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" + "CAN" "EM" "SUB" "ESC" "FC" "GS" "RS" "US"))) + (dotimes (i 32) + (aset char-acronym-table i (car c0-acronyms)) + (setq c0-acronyms (cdr c0-acronyms)))) + +(let ((c1-acronyms '("XXX" "XXX" "BPH" "NBH" "IND" "NEL" "SSA" "ESA" + "HTS" "HTJ" "VTS" "PLD" "PLU" "R1" "SS2" "SS1" + "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA" + "SOS" "XXX" "SC1" "CSI" "ST" "OSC" "PM" "APC"))) + (dotimes (i 32) + (aset char-acronym-table (+ #x0080 i) (car c1-acronyms)) + (setq c1-acronyms (cdr c1-acronyms)))) + +(aset char-acronym-table #x17B4 "KIVAQ") ; KHMER VOWEL INHERENT AQ +(aset char-acronym-table #x17B5 "KIVAA") ; KHMER VOWEL INHERENT AA +(aset char-acronym-table #x200B "ZWSP") ; ZERO WIDTH SPACE +(aset char-acronym-table #x200C "ZWNJ") ; ZERO WIDTH NON-JOINER +(aset char-acronym-table #x200D "ZWJ") ; ZERO WIDTH JOINER +(aset char-acronym-table #x200E "LRM") ; LEFT-TO-RIGHT MARK +(aset char-acronym-table #x200F "RLM") ; RIGHT-TO-LEFT MARK +(aset char-acronym-table #x202A "LRE") ; LEFT-TO-RIGHT EMBEDDING +(aset char-acronym-table #x202B "RLE") ; RIGHT-TO-LEFT EMBEDDING +(aset char-acronym-table #x202C "PDF") ; POP DIRECTIONAL FORMATTING +(aset char-acronym-table #x202D "LRO") ; LEFT-TO-RIGHT OVERRIDE +(aset char-acronym-table #x202E "RLO") ; RIGHT-TO-LEFT OVERRIDE +(aset char-acronym-table #x2060 "WJ") ; WORD JOINER +(aset char-acronym-table #x206A "ISS") ; INHIBIT SYMMETRIC SWAPPING +(aset char-acronym-table #x206B "ASS") ; ACTIVATE SYMMETRIC SWAPPING +(aset char-acronym-table #x206C "IAFS") ; INHIBIT ARABIC FORM SHAPING +(aset char-acronym-table #x206D "AAFS") ; ACTIVATE ARABIC FORM SHAPING +(aset char-acronym-table #x206E "NADS") ; NATIONAL DIGIT SHAPES +(aset char-acronym-table #x206F "NODS") ; NOMINAL DIGIT SHAPES +(aset char-acronym-table #xFEFF "ZWNBSP") ; ZERO WIDTH NO-BREAK SPACE +(aset char-acronym-table #xFFF9 "IAA") ; INTERLINEAR ANNOTATION ANCHOR +(aset char-acronym-table #xFFFA "IAS") ; INTERLINEAR ANNOTATION SEPARATOR +(aset char-acronym-table #xFFFB "IAT") ; INTERLINEAR ANNOTATION TERMINATOR +(aset char-acronym-table #x1D173 "BEGBM") ; MUSICAL SYMBOL BEGIN BEAM +(aset char-acronym-table #x1D174 "ENDBM") ; MUSICAL SYMBOL END BEAM +(aset char-acronym-table #x1D175 "BEGTIE") ; MUSICAL SYMBOL BEGIN TIE +(aset char-acronym-table #x1D176 "END") ; MUSICAL SYMBOL END TIE +(aset char-acronym-table #x1D177 "BEGSLR") ; MUSICAL SYMBOL BEGIN SLUR +(aset char-acronym-table #x1D178 "ENDSLR") ; MUSICAL SYMBOL END SLUR +(aset char-acronym-table #x1D179 "BEGPHR") ; MUSICAL SYMBOL BEGIN PHRASE +(aset char-acronym-table #x1D17A "ENDPHR") ; MUSICAL SYMBOL END PHRASE +(aset char-acronym-table #xE0001 "|->TAG") ; LANGUAGE TAG +(aset char-acronym-table #xE0020 "SP TAG") ; TAG SPACE +(dotimes (i 94) + (aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i)))) +(aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG + +(defun update-glyphless-char-display (&optional variable value) + "Make the setting of `glyphless-char-display-control' take effect. +This function updates the char-table `glyphless-char-display'." + (when value + (set-default variable value)) + (dolist (elt value) + (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) + ;; Users will not expect their newlines and TABs be + ;; displayed as anything but themselves, so exempt those + ;; two characters from c0-control. + (set-char-table-range glyphless-char-display #x9 nil) + (set-char-table-range glyphless-char-display #xa nil)) + ((eq target 'c1-control) + (set-char-table-range glyphless-char-display '(#x80 . #x9F) + method)) + ((eq target 'format-control) + (map-char-table + #'(lambda (char category) + (if (eq category 'Cf) + (let ((this-method method) + from to) + (if (consp char) + (setq from (car char) to (cdr char)) + (setq from char to char)) + (while (<= from to) + (when (/= from #xAD) + (if (eq method 'acronym) + (setq this-method + (aref char-acronym-table from))) + (set-char-table-range glyphless-char-display + from this-method)) + (setq from (1+ from)))))) + unicode-category-table)) + ((eq target 'no-font) + (set-char-table-extra-slot glyphless-char-display 0 method)) + (t + (error "Invalid glyphless character group: %s" target)))))) + +;;; Control of displaying glyphless characters. +(defcustom glyphless-char-display-control + '((format-control . thin-space) + (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. + +GROUP must be one of these symbols: + `c0-control': U+0000..U+001F, but excluding newline and TAB. + `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 (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." + + :type '(alist :key-type (symbol :tag "Character Group") + :value-type (symbol :tag "Display Method")) + :options '((c0-control + (choice (const :tag "Don't display" zero-width) + (const :tag "Display as thin space" thin-space) + (const :tag "Display as empty box" empty-box) + (const :tag "Display acronym" acronym) + (const :tag "Display hex code in a box" hex-code))) + (c1-control + (choice (const :tag "Don't display" zero-width) + (const :tag "Display as thin space" thin-space) + (const :tag "Display as empty box" empty-box) + (const :tag "Display acronym" acronym) + (const :tag "Display hex code in a box" hex-code))) + (format-control + (choice (const :tag "Don't display" zero-width) + (const :tag "Display as thin space" thin-space) + (const :tag "Display as empty box" empty-box) + (const :tag "Display acronym" acronym) + (const :tag "Display hex code in a box" hex-code))) + (no-font + (choice (const :tag "Don't display" zero-width) + (const :tag "Display as thin space" thin-space) + (const :tag "Display as empty box" empty-box) + (const :tag "Display acronym" acronym) + (const :tag "Display hex code in a box" hex-code)))) + :set 'update-glyphless-char-display + :group 'display) + + ;;; Setting word boundary. (setq word-combining-categories diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index a3609c0ccfc..4701e7e5718 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2033,10 +2033,11 @@ See `set-language-info-alist' for use in programs." "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) diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index 808a23577d1..48f0edb49e0 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -1033,7 +1033,9 @@ Return the modified list with the last element prepended to it." (setq buf (car iswitchb-matches)) ;; check to see if buf is non-nil. (if buf - (progn + (let ((bufobjs (mapcar (lambda (name) + (or (get-buffer name) name)) + iswitchb-buflist))) (kill-buffer buf) ;; Check if buffer exists. XEmacs gnuserv.el makes alias @@ -1044,8 +1046,13 @@ Return the modified list with the last element prepended to it." (setq iswitchb-rescan t) ;; Else `kill-buffer' succeeds so re-make the buffer list ;; taking into account packages like uniquify may rename - ;; buffers - (iswitchb-make-buflist iswitchb-default)))))) + ;; buffers, and try to preserve the ordering of buffers. + (setq iswitchb-buflist + (delq nil (mapcar (lambda (b) + (if (bufferp b) + (buffer-name b) + b)) + bufobjs)))))))) ;;; VISIT CHOSEN BUFFER (defun iswitchb-visit-buffer (buffer) diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 68f564c488f..aba9dac1434 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -73,10 +73,18 @@ Otherwise, it is nil.") (defun jka-compr-build-file-regexp () (purecopy - (mapconcat - 'jka-compr-info-regexp - jka-compr-compression-info-list - "\\|"))) + (let ((re-anchored '()) + (re-free '())) + (dolist (e jka-compr-compression-info-list) + (let ((re (jka-compr-info-regexp e))) + (if (string-match "\\\\'\\'" re) + (push (substring re 0 (match-beginning 0)) re-anchored) + (push re re-free)))) + (concat + (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|")) + "\\(?:" + (mapconcat 'identity re-anchored "\\|") + "\\)" file-name-version-regexp "?\\'")))) ;; Functions for accessing the return value of jka-compr-get-compression-info (defun jka-compr-info-regexp (info) (aref info 0)) @@ -97,11 +105,9 @@ The determination as to which compression scheme, if any, to use is based on the filename itself and `jka-compr-compression-info-list'." (catch 'compression-info (let ((case-fold-search nil)) - (mapc - (function (lambda (x) - (and (string-match (jka-compr-info-regexp x) filename) - (throw 'compression-info x)))) - jka-compr-compression-info-list) + (dolist (x jka-compr-compression-info-list) + (and (string-match (jka-compr-info-regexp x) filename) + (throw 'compression-info x))) nil))) (defun jka-compr-install () @@ -198,7 +204,7 @@ options through Custom does this automatically." ;; uncomp-message uncomp-prog uncomp-args ;; can-append strip-extension-flag file-magic-bytes] (mapcar 'purecopy - '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" + '(["\\.Z\\'" "compressing" "compress" ("-c") ;; gzip is more common than uncompress. It can only read, not write. "uncompressing" "gzip" ("-c" "-q" "-d") @@ -206,7 +212,7 @@ options through Custom does this automatically." ;; Formerly, these had an additional arg "-c", but that fails with ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and ;; "Version 0.9.0b, 9-Sept-98". - ["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.bz2\\'" "bzip2ing" "bzip2" nil "bunzip2ing" "bzip2" ("-d") nil t "BZh"] @@ -214,15 +220,15 @@ options through Custom does this automatically." "bzip2ing" "bzip2" nil "bunzip2ing" "bzip2" ("-d") nil nil "BZh"] - ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'" "compressing" "gzip" ("-c" "-q") "uncompressing" "gzip" ("-c" "-q" "-d") t nil "\037\213"] - ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.g?z\\'" "compressing" "gzip" ("-c" "-q") "uncompressing" "gzip" ("-c" "-q" "-d") t t "\037\213"] - ["\\.xz\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.xz\\'" "XZ compressing" "xz" ("-c" "-q") "XZ uncompressing" "xz" ("-c" "-q" "-d") t t "\3757zXZ\0"] diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 868455c4899..7d7e0fdb6bd 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -76,7 +76,7 @@ Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER. ;;;*** ;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -90,7 +90,6 @@ the file name. (autoload 'ada-mode "ada-mode" "\ Ada mode is the major mode for editing Ada code. -\\{ada-mode-map} \(fn)" t nil) @@ -108,7 +107,7 @@ Insert a descriptive header at the top of the file. ;;;*** ;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload 'ada-find-file "ada-xref" "\ @@ -123,7 +122,7 @@ Completion is available. ;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log ;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name ;;;;;; add-log-current-defun-function) "add-log" "vc/add-log.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from vc/add-log.el (put 'change-log-default-name 'safe-local-variable 'string-or-null-p) @@ -497,7 +496,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;*** ;;;### (autoloads (outlineify-sticky allout-mode) "allout" "allout.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from allout.el (put 'allout-use-hanging-indents 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) @@ -804,7 +803,7 @@ setup for auto-startup. ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (19619 52030)) +;;;;;; "net/ange-ftp.el" (19714 43298)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -854,7 +853,7 @@ You can specify the one's name by NAME; the default value is \"Sarah\". ;;;*** ;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on) -;;;;;; "ansi-color" "ansi-color.el" (19598 13691)) +;;;;;; "ansi-color" "ansi-color.el" (19714 43298)) ;;; Generated autoloads from ansi-color.el (autoload 'ansi-color-for-comint-mode-on "ansi-color" "\ @@ -880,7 +879,7 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** ;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules) -;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (19619 52030)) +;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (19714 43298)) ;;; Generated autoloads from progmodes/antlr-mode.el (autoload 'antlr-show-makefile-rules "antlr-mode" "\ @@ -904,7 +903,6 @@ commentary with value `antlr-help-unknown-file-text' is added. The (autoload 'antlr-mode "antlr-mode" "\ Major mode for editing ANTLR grammar files. -\\{antlr-mode-map} \(fn)" t nil) @@ -1043,8 +1041,8 @@ Returns list of symbols and documentation found. ;;;*** -;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1064,7 +1062,7 @@ archive. ;;;*** -;;;### (autoloads (array-mode) "array" "array.el" (19640 47194)) +;;;### (autoloads (array-mode) "array" "array.el" (19714 43298)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1342,8 +1340,8 @@ Keymap summary ;;;*** -;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1425,7 +1423,7 @@ etc. to supply digit arguments. ;;;*** ;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1475,7 +1473,7 @@ insert a template for the file depending on the mode of the buffer. ;;;### (autoloads (batch-update-autoloads update-directory-autoloads ;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) @@ -1595,7 +1593,7 @@ specifies in the mode line. ;;;*** ;;;### (autoloads (mouse-avoidance-mode mouse-avoidance-mode) "avoid" -;;;;;; "avoid.el" (19562 42953)) +;;;;;; "avoid.el" (19714 43298)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1701,7 +1699,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** ;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize) -;;;;;; "bibtex" "textmodes/bibtex.el" (19598 13691)) +;;;;;; "bibtex" "textmodes/bibtex.el" (19714 43298)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1947,7 +1945,7 @@ a reflection. ;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert ;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate ;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark" -;;;;;; "bookmark.el" (19562 42953)) +;;;;;; "bookmark.el" (19714 43298)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2000,8 +1998,8 @@ if you wish to give the bookmark a new location, and `bookmark-jump' will then jump to the new location, as well as recording it in place of the old one in the permanent bookmark record. -BOOKMARK may be a bookmark name (a string) or a bookmark record, but -the latter is usually only used by programmatic callers. +BOOKMARK is usually a bookmark name (a string). It can also be a +bookmark record, but this is usually only done by programmatic callers. If DISPLAY-FUNC is non-nil, it is a function to invoke to display the bookmark. It defaults to `switch-to-buffer'. A typical value for @@ -2015,57 +2013,52 @@ Jump to BOOKMARK in another window. See `bookmark-jump' for more. \(fn BOOKMARK)" t nil) (autoload 'bookmark-relocate "bookmark" "\ -Relocate BOOKMARK to another file (reading file name with minibuffer). -BOOKMARK is a bookmark name (a string), not a bookmark record. +Relocate BOOKMARK-NAME to another file, reading file name with minibuffer. This makes an already existing bookmark point to that file, instead of the one it used to point at. Useful when a file has been renamed after a bookmark was set in it. -\(fn BOOKMARK)" t nil) +\(fn BOOKMARK-NAME)" t nil) (autoload 'bookmark-insert-location "bookmark" "\ -Insert the name of the file associated with BOOKMARK. -BOOKMARK is a bookmark name (a string), not a bookmark record. +Insert the name of the file associated with BOOKMARK-NAME. Optional second arg NO-HISTORY means don't record this in the minibuffer history list `bookmark-history'. -\(fn BOOKMARK &optional NO-HISTORY)" t nil) +\(fn BOOKMARK-NAME &optional NO-HISTORY)" t nil) (defalias 'bookmark-locate 'bookmark-insert-location) (autoload 'bookmark-rename "bookmark" "\ -Change the name of OLD bookmark to NEW name. -If called from keyboard, prompt for OLD and NEW. If called from -menubar, select OLD from a menu and prompt for NEW. +Change the name of OLD-NAME bookmark to NEW-NAME name. +If called from keyboard, prompt for OLD-NAME and NEW-NAME. +If called from menubar, select OLD-NAME from a menu and prompt for NEW-NAME. -Both OLD and NEW are bookmark names (strings), never bookmark records. - -If called from Lisp, prompt for NEW if only OLD was passed as an -argument. If called with two strings, then no prompting is done. You -must pass at least OLD when calling from Lisp. +If called from Lisp, prompt for NEW-NAME if only OLD-NAME was passed +as an argument. If called with two strings, then no prompting is done. +You must pass at least OLD-NAME when calling from Lisp. While you are entering the new name, consecutive C-w's insert consecutive words from the text of the buffer into the new bookmark name. -\(fn OLD &optional NEW)" t nil) +\(fn OLD-NAME &optional NEW-NAME)" t nil) (autoload 'bookmark-insert "bookmark" "\ -Insert the text of the file pointed to by bookmark BOOKMARK. -BOOKMARK is a bookmark name (a string), not a bookmark record. +Insert the text of the file pointed to by bookmark BOOKMARK-NAME. +BOOKMARK-NAME is a bookmark name (a string), not a bookmark record. You may have a problem using this function if the value of variable `bookmark-alist' is nil. If that happens, you need to load in some bookmarks. See help on function `bookmark-load' for more about this. -\(fn BOOKMARK)" t nil) +\(fn BOOKMARK-NAME)" t nil) (autoload 'bookmark-delete "bookmark" "\ -Delete BOOKMARK from the bookmark list. -BOOKMARK is a bookmark name (a string), not a bookmark record. +Delete BOOKMARK-NAME from the bookmark list. Removes only the first instance of a bookmark with that name. If there are one or more other bookmarks with the same name, they will @@ -2074,7 +2067,7 @@ one most recently used in this file, if any). Optional second arg BATCH means don't update the bookmark list buffer, probably because we were called from there. -\(fn BOOKMARK &optional BATCH)" t nil) +\(fn BOOKMARK-NAME &optional BATCH)" t nil) (autoload 'bookmark-write "bookmark" "\ Write bookmarks to a file (reading the file name with the minibuffer). @@ -2150,11 +2143,10 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;;;; browse-url-w3-gnudoit browse-url-w3 browse-url-cci browse-url-mosaic ;;;;;; browse-url-gnome-moz browse-url-emacs browse-url-galeon browse-url-firefox ;;;;;; browse-url-mozilla browse-url-netscape browse-url-xdg-open -;;;;;; browse-url-default-browser browse-url-at-mouse browse-url-at-point -;;;;;; browse-url browse-url-of-region browse-url-of-dired-file -;;;;;; browse-url-of-buffer browse-url-of-file browse-url-url-at-point +;;;;;; browse-url-at-mouse browse-url-at-point browse-url browse-url-of-region +;;;;;; browse-url-of-dired-file browse-url-of-buffer browse-url-of-file ;;;;;; browse-url-browser-function) "browse-url" "net/browse-url.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from net/browse-url.el (defvar 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)) "\ @@ -2170,11 +2162,6 @@ regexp should probably be \".\" to specify a default browser.") (custom-autoload 'browse-url-browser-function "browse-url" t) -(autoload 'browse-url-url-at-point "browse-url" "\ -Not documented - -\(fn)" nil nil) - (autoload 'browse-url-of-file "browse-url" "\ Ask a WWW browser to display FILE. Display the current buffer's file if FILE is nil or if called @@ -2206,6 +2193,8 @@ Ask a WWW browser to display the current region. Ask a WWW browser to load URL. Prompts for a URL, defaulting to the URL at or before point. Variable `browse-url-browser-function' says which browser to use. +If the URL is a mailto: URL, consult `browse-url-mailto-function' +first, if that exists. \(fn URL &rest ARGS)" t nil) @@ -2225,23 +2214,6 @@ to use. \(fn EVENT)" t nil) -(autoload 'browse-url-default-browser "browse-url" "\ -Find a suitable browser and ask it to load URL. -Default to the URL around or before point. - -When called interactively, if variable `browse-url-new-window-flag' is -non-nil, load the document in a new window, if possible, otherwise use -a random existing one. A non-nil interactive prefix argument reverses -the effect of `browse-url-new-window-flag'. - -When called non-interactively, optional second argument NEW-WINDOW is -used instead of `browse-url-new-window-flag'. - -The order attempted is gnome-moz-remote, Mozilla, Firefox, -Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3. - -\(fn URL &rest ARGS)" nil nil) - (autoload 'browse-url-xdg-open "browse-url" "\ Not documented @@ -2557,8 +2529,8 @@ columns on its right towards the left. ;;;*** -;;;### (autoloads (list-buffers) "buff-menu" "buff-menu.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (list-buffers) "buff-menu" "buff-menu.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from buff-menu.el (define-key ctl-x-map "" 'list-buffers) @@ -2596,19 +2568,14 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;### (autoloads (batch-byte-recompile-directory batch-byte-compile ;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile ;;;;;; compile-defun byte-compile-file byte-recompile-directory -;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning -;;;;;; byte-compile-warnings-safe-p) "bytecomp" "emacs-lisp/bytecomp.el" -;;;;;; (19640 50171)) +;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning) +;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (19714 43298)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (put 'byte-compile-dynamic 'safe-local-variable 'booleanp) (put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) (put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp) -(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p) - -(autoload 'byte-compile-warnings-safe-p "bytecomp" "\ -Return non-nil if X is valid as a value of `byte-compile-warnings'. -\(fn X)" nil nil) +(put 'byte-compile-warnings 'safe-local-variable (lambda (v) (or (symbolp v) (null (delq nil (mapcar (lambda (x) (not (symbolp x))) v)))))) (autoload 'byte-compile-disable-warning "bytecomp" "\ Change `byte-compile-warnings' to disable WARNING. @@ -2857,8 +2824,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -2975,7 +2942,7 @@ Return the syntactic context of the current line. ;;;### (autoloads (pike-mode idl-mode java-mode objc-mode c++-mode ;;;;;; c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3135,7 +3102,7 @@ Key bindings: ;;;*** ;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles" -;;;;;; "progmodes/cc-styles.el" (19640 47194)) +;;;;;; "progmodes/cc-styles.el" (19714 43298)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3457,7 +3424,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** ;;;### (autoloads (cfengine-mode) "cfengine" "progmodes/cfengine.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/cfengine.el (autoload 'cfengine-mode "cfengine" "\ @@ -3497,7 +3464,7 @@ Returns non-nil if any false statements are found. ;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer ;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive ;;;;;; checkdoc-interactive checkdoc checkdoc-list-of-strings-p) -;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (19640 47194)) +;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (19714 43298)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) (put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) @@ -3909,7 +3876,7 @@ is run). ;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list ;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command ;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4041,8 +4008,8 @@ on third call it again advances points to the next difference and so on. ;;;;;; compilation-shell-minor-mode compilation-mode compilation-start ;;;;;; compile compilation-disable-input compile-command compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook -;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (19619 -;;;;;; 52030)) +;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4238,8 +4205,8 @@ Enable dynamic word-completion. ;;;*** ;;;### (autoloads (global-auto-composition-mode auto-composition-mode -;;;;;; encode-composition-rule) "composite" "composite.el" (19640 -;;;;;; 47194)) +;;;;;; encode-composition-rule) "composite" "composite.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from composite.el (autoload 'encode-composition-rule "composite" "\ @@ -4498,7 +4465,7 @@ Update copyright notice for all files in DIRECTORY matching MATCH. ;;;*** ;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode) -;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (19640 47194)) +;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (19714 43298)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -4697,7 +4664,7 @@ Run a `perldoc' on the word around point. ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -4787,7 +4754,7 @@ Major mode to edit Cascading Style Sheets. ;;;*** ;;;### (autoloads (cua-selection-mode cua-mode) "cua-base" "emulation/cua-base.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -4846,7 +4813,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;;;; customize-mode customize customize-save-variable customize-set-variable ;;;;;; customize-set-value custom-menu-sort-alphabetically custom-buffer-sort-alphabetically ;;;;;; custom-browse-sort-alphabetically) "cus-edit" "cus-edit.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5149,13 +5116,15 @@ The format is suitable for use with `easy-menu-define'. ;;;*** ;;;### (autoloads (customize-themes describe-theme customize-create-theme) -;;;;;; "cus-theme" "cus-theme.el" (19640 47194)) +;;;;;; "cus-theme" "cus-theme.el" (19714 43298)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ Create or edit a custom theme. -THEME, if non-nil, should be an existing theme to edit. -BUFFER, if non-nil, should be a buffer to use. +THEME, if non-nil, should be an existing theme to edit. If THEME +is `user', provide an option to remove these as custom settings. +BUFFER, if non-nil, should be a buffer to use; the default is +named *Custom Theme*. \(fn &optional THEME BUFFER)" t nil) @@ -5318,8 +5287,8 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5332,8 +5301,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. ;;;*** -;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5504,7 +5473,7 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** ;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5558,8 +5527,8 @@ START and END delimits the corners of text rectangle. ;;;*** -;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/delphi.el (autoload 'delphi-mode "delphi" "\ @@ -5952,7 +5921,7 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** ;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib" -;;;;;; "calendar/diary-lib.el" (19640 47194)) +;;;;;; "calendar/diary-lib.el" (19714 43298)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -5994,8 +5963,8 @@ Major mode for editing the diary file. ;;;*** -;;;### (autoloads (diff-backup diff diff-command diff-switches) "diff" -;;;;;; "vc/diff.el" (19562 42953)) +;;;### (autoloads (diff-buffer-with-file diff-backup diff diff-command +;;;;;; diff-switches) "diff" "vc/diff.el" (19714 43298)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-c") "\ @@ -6030,6 +5999,12 @@ With prefix arg, prompt for diff switches. \(fn FILE &optional SWITCHES)" t nil) +(autoload 'diff-buffer-with-file "diff" "\ +View the differences between BUFFER and its associated file. +This requires the external program `diff' to be in your `exec-path'. + +\(fn &optional BUFFER)" t nil) + ;;;*** ;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el" @@ -6074,7 +6049,7 @@ Optional arguments are passed to `dig-invoke'. ;;;### (autoloads (dired-mode dired-auto-revert-buffer dired-noselect ;;;;;; dired-other-frame dired-other-window dired dired-trivial-filenames -;;;;;; dired-listing-switches) "dired" "dired.el" (19640 47194)) +;;;;;; dired-listing-switches) "dired" "dired.el" (19714 43298)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6088,7 +6063,7 @@ some of the `ls' switches are not supported; see the doc string of (custom-autoload 'dired-listing-switches "dired" t) -(defvar dired-chown-program (purecopy (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown"))) "\ +(defvar dired-chown-program (purecopy (if (memq system-type '(hpux usg-unix-v irix gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown"))) "\ Name of chown command (usually `chown' or `/etc/chown').") (defvar dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#") "\ @@ -6219,7 +6194,7 @@ Keybindings: ;;;*** ;;;### (autoloads (dirtrack dirtrack-mode) "dirtrack" "dirtrack.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6448,7 +6423,7 @@ Locate SOA record and increment the serial field. ;;;*** ;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode -;;;;;; doc-view-mode-p) "doc-view" "doc-view.el" (19591 62571)) +;;;;;; doc-view-mode-p) "doc-view" "doc-view.el" (19714 43269)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6483,7 +6458,7 @@ Not documented ;;;*** -;;;### (autoloads (doctor) "doctor" "play/doctor.el" (19562 42953)) +;;;### (autoloads (doctor) "doctor" "play/doctor.el" (19714 43298)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6520,7 +6495,7 @@ Switch to *dungeon* buffer and start game. ;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap ;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode" -;;;;;; "emacs-lisp/easy-mmode.el" (19598 13691)) +;;;;;; "emacs-lisp/easy-mmode.el" (19714 43298)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -6559,7 +6534,8 @@ BODY contains code to execute each time the mode is enabled or disabled. of the variable MODE to store the state of the mode. PLACE can also be of the form (GET . SET) where GET is an expression that returns the current state and SET is a function that takes - a new state and sets it. + a new state and sets it. If you specify a :variable, this + function assumes it is defined elsewhere. For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" @@ -6783,7 +6759,7 @@ To implement dynamic menus, either call this from ;;;;;; ebnf-eps-file ebnf-eps-directory ebnf-spool-region ebnf-spool-buffer ;;;;;; ebnf-spool-file ebnf-spool-directory ebnf-print-region ebnf-print-buffer ;;;;;; ebnf-print-file ebnf-print-directory ebnf-customize) "ebnf2ps" -;;;;;; "progmodes/ebnf2ps.el" (19562 42953)) +;;;;;; "progmodes/ebnf2ps.el" (19714 43298)) ;;; Generated autoloads from progmodes/ebnf2ps.el (autoload 'ebnf-customize "ebnf2ps" "\ @@ -7057,8 +7033,8 @@ See `ebnf-style-database' documentation. ;;;;;; ebrowse-tags-find-declaration-other-window ebrowse-tags-find-definition ;;;;;; ebrowse-tags-view-definition ebrowse-tags-find-declaration ;;;;;; ebrowse-tags-view-declaration ebrowse-member-mode ebrowse-electric-choose-tree -;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (19591 -;;;;;; 62571)) +;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7081,9 +7057,7 @@ Return a buffer containing a tree or nil if no tree found or canceled. (autoload 'ebrowse-member-mode "ebrowse" "\ Major mode for Ebrowse member buffers. -\\{ebrowse-member-mode-map} - -\(fn)" nil nil) +\(fn)" t nil) (autoload 'ebrowse-tags-view-declaration "ebrowse" "\ View declaration of member at point. @@ -7209,7 +7183,7 @@ Display statistics for a class tree. ;;;*** ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7246,7 +7220,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** ;;;### (autoloads (ecomplete-setup) "ecomplete" "gnus/ecomplete.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7256,7 +7230,7 @@ Not documented ;;;*** -;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (19619 52030)) +;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (19714 43298)) ;;; Generated autoloads from cedet/ede.el (defvar global-ede-mode nil "\ @@ -7282,7 +7256,7 @@ an EDE controlled project. ;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form ;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug" -;;;;;; "emacs-lisp/edebug.el" (19640 47194)) +;;;;;; "emacs-lisp/edebug.el" (19714 43298)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7618,7 +7592,7 @@ Display Ediff's registry. ;;;*** ;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) -;;;;;; "ediff-util" "vc/ediff-util.el" (19640 47194)) +;;;;;; "ediff-util" "vc/ediff-util.el" (19714 43298)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -7692,7 +7666,7 @@ or nil, use a compact 80-column format. ;;;*** ;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt" -;;;;;; "emulation/edt.el" (19619 52030)) +;;;;;; "emulation/edt.el" (19714 43298)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -7790,10 +7764,13 @@ Emacs Lisp mode) that support ElDoc.") ;;;*** -;;;### (autoloads (electric-pair-mode electric-indent-mode) "electric" -;;;;;; "electric.el" (19598 13691)) +;;;### (autoloads (electric-layout-mode electric-pair-mode electric-indent-mode) +;;;;;; "electric" "electric.el" (19714 43298)) ;;; Generated autoloads from electric.el +(defvar electric-indent-chars '(10) "\ +Characters that should cause automatic reindentation.") + (defvar electric-indent-mode nil "\ Non-nil if Electric-Indent mode is enabled. See the command `electric-indent-mode' for a description of this minor mode. @@ -7823,6 +7800,20 @@ Automatically pair-up parens when inserting an open paren. \(fn &optional ARG)" t nil) +(defvar electric-layout-mode nil "\ +Non-nil if Electric-Layout mode is enabled. +See the command `electric-layout-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `electric-layout-mode'.") + +(custom-autoload 'electric-layout-mode "electric" nil) + +(autoload 'electric-layout-mode "electric" "\ +Automatically insert newlines around some chars. + +\(fn &optional ARG)" t nil) + ;;;*** ;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (19562 @@ -7843,7 +7834,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. ;;;### (autoloads (elint-initialize elint-defun elint-current-buffer ;;;;;; elint-directory elint-file) "elint" "emacs-lisp/elint.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -7915,7 +7906,7 @@ displayed. ;;;*** ;;;### (autoloads (report-emacs-bug) "emacsbug" "mail/emacsbug.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -7930,7 +7921,7 @@ Prompts for bug subject. Leaves you in a mail buffer. ;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote ;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor ;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" -;;;;;; "vc/emerge.el" (19562 42953)) +;;;;;; "vc/emerge.el" (19714 43298)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8026,8 +8017,8 @@ Not documented ;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region ;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file ;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys -;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (19640 -;;;;;; 47194)) +;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8248,7 +8239,7 @@ Not documented ;;;### (autoloads (epa-global-mail-mode epa-mail-import-keys epa-mail-encrypt ;;;;;; epa-mail-sign epa-mail-verify epa-mail-decrypt epa-mail-mode) -;;;;;; "epa-mail" "epa-mail.el" (19598 13691)) +;;;;;; "epa-mail" "epa-mail.el" (19714 43298)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8312,7 +8303,7 @@ Minor mode to hook EasyPG into Mail mode. ;;;*** -;;;### (autoloads (epg-make-context) "epg" "epg.el" (19598 13691)) +;;;### (autoloads (epg-make-context) "epg" "epg.el" (19714 43298)) ;;; Generated autoloads from epg.el (autoload 'epg-make-context "epg" "\ @@ -8323,7 +8314,7 @@ Return a context object. ;;;*** ;;;### (autoloads (epg-expand-group epg-check-configuration epg-configuration) -;;;;;; "epg-config" "epg-config.el" (19598 13691)) +;;;;;; "epg-config" "epg-config.el" (19714 43298)) ;;; Generated autoloads from epg-config.el (autoload 'epg-configuration "epg-config" "\ @@ -8848,8 +8839,8 @@ Emacs shell interactive mode. ;;;*** -;;;### (autoloads (eshell-test) "esh-test" "eshell/esh-test.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (eshell-test) "esh-test" "eshell/esh-test.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from eshell/esh-test.el (autoload 'eshell-test "esh-test" "\ @@ -8901,7 +8892,7 @@ corresponding to a successful execution. ;;;;;; visit-tags-table tags-table-mode find-tag-default-function ;;;;;; find-tag-hook tags-add-tables tags-compression-info-list ;;;;;; tags-table-list tags-case-fold-search) "etags" "progmodes/etags.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9385,7 +9376,7 @@ Not documented ;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline ;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -9626,7 +9617,7 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19591 62571)) +;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19714 43298)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -9692,8 +9683,8 @@ with no args, if that value is non-nil. ;;;### (autoloads (variable-pitch-mode buffer-face-toggle buffer-face-set ;;;;;; buffer-face-mode text-scale-adjust text-scale-decrease text-scale-increase ;;;;;; text-scale-set face-remap-set-base face-remap-reset-base -;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (19591 -;;;;;; 62571)) +;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -9951,7 +9942,7 @@ Evaluate the forms in variable `ffap-bindings'. ;;;### (autoloads (file-cache-minibuffer-complete file-cache-add-directory-recursively ;;;;;; file-cache-add-directory-using-locate file-cache-add-directory-using-find ;;;;;; file-cache-add-file file-cache-add-directory-list file-cache-add-directory) -;;;;;; "filecache" "filecache.el" (19591 62571)) +;;;;;; "filecache" "filecache.el" (19714 43298)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -10264,7 +10255,7 @@ Visit the file you click on in another window. ;;;;;; find-variable find-variable-noselect find-function-other-frame ;;;;;; find-function-other-window find-function find-function-noselect ;;;;;; find-function-search-for-symbol find-library) "find-func" -;;;;;; "emacs-lisp/find-func.el" (19562 42953)) +;;;;;; "emacs-lisp/find-func.el" (19714 43298)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ @@ -10440,7 +10431,7 @@ Change the filter on a find-lisp-find-dired buffer to REGEXP. ;;;*** ;;;### (autoloads (finder-by-keyword finder-commentary finder-list-keywords) -;;;;;; "finder" "finder.el" (19619 52030)) +;;;;;; "finder" "finder.el" (19714 43298)) ;;; Generated autoloads from finder.el (autoload 'finder-list-keywords "finder" "\ @@ -10500,7 +10491,7 @@ Not documented ;;;*** ;;;### (autoloads (flymake-mode-off flymake-mode-on flymake-mode) -;;;;;; "flymake" "progmodes/flymake.el" (19598 13691)) +;;;;;; "flymake" "progmodes/flymake.el" (19714 43298)) ;;; Generated autoloads from progmodes/flymake.el (autoload 'flymake-mode "flymake" "\ @@ -10524,7 +10515,7 @@ Turn flymake mode off. ;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off ;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode) -;;;;;; "flyspell" "textmodes/flyspell.el" (19598 13691)) +;;;;;; "flyspell" "textmodes/flyspell.el" (19714 43298)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -10733,7 +10724,7 @@ Visit a file in Forms mode in other window. ;;;*** ;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -10811,7 +10802,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (fortune fortune-to-signature fortune-compile fortune-from-region -;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (19562 42953)) +;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (19714 43298)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -10850,7 +10841,6 @@ and choose the directory as the fortune-file. (autoload 'fortune "fortune" "\ Display a fortune cookie. - If called with a prefix asks for the FILE to choose the fortune from, otherwise uses the value of `fortune-file'. If you want to have fortune choose from a set of files in a directory, call interactively with prefix @@ -10861,7 +10851,7 @@ and choose the directory as the fortune-file. ;;;*** ;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -11069,7 +11059,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** ;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server -;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (19640 47194)) +;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus.el (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) @@ -11122,7 +11112,7 @@ prompt the user for the name of an NNTP server to use. ;;;;;; gnus-agent-get-undownloaded-list gnus-agent-delete-group ;;;;;; gnus-agent-rename-group gnus-agent-possibly-save-gcc gnus-agentize ;;;;;; gnus-slave-unplugged gnus-plugged gnus-unplugged) "gnus-agent" -;;;;;; "gnus/gnus-agent.el" (19640 47194)) +;;;;;; "gnus/gnus-agent.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -11213,7 +11203,7 @@ If CLEAN, obsolete (ignore). ;;;*** ;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11224,7 +11214,7 @@ Make the current buffer look like a nice article. ;;;*** ;;;### (autoloads (gnus-bookmark-bmenu-list gnus-bookmark-jump gnus-bookmark-set) -;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (19640 47194)) +;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-bookmark.el (autoload 'gnus-bookmark-set "gnus-bookmark" "\ @@ -11249,8 +11239,8 @@ deletion, or > if it is flagged for displaying. ;;;### (autoloads (gnus-cache-delete-group gnus-cache-rename-group ;;;;;; gnus-cache-generate-nov-databases gnus-cache-generate-active -;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (19640 -;;;;;; 47194)) +;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from gnus/gnus-cache.el (autoload 'gnus-jog-cache "gnus-cache" "\ @@ -11292,7 +11282,7 @@ supported. ;;;*** ;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article) -;;;;;; "gnus-delay" "gnus/gnus-delay.el" (19598 13691)) +;;;;;; "gnus-delay" "gnus/gnus-delay.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -11328,7 +11318,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** ;;;### (autoloads (gnus-user-format-function-D gnus-user-format-function-d) -;;;;;; "gnus-diary" "gnus/gnus-diary.el" (19640 47194)) +;;;;;; "gnus-diary" "gnus/gnus-diary.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-diary.el (autoload 'gnus-user-format-function-d "gnus-diary" "\ @@ -11344,7 +11334,7 @@ Not documented ;;;*** ;;;### (autoloads (turn-on-gnus-dired-mode) "gnus-dired" "gnus/gnus-dired.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/gnus-dired.el (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ @@ -11355,7 +11345,7 @@ Convenience method to turn on gnus-dired-mode. ;;;*** ;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -11413,7 +11403,7 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to ;;;*** ;;;### (autoloads (gnus-treat-mail-gravatar gnus-treat-from-gravatar) -;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (19640 47194)) +;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-gravatar.el (autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\ @@ -11431,7 +11421,7 @@ If gravatars are already displayed, remove them. ;;;*** ;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group) -;;;;;; "gnus-group" "gnus/gnus-group.el" (19640 47194)) +;;;;;; "gnus-group" "gnus/gnus-group.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -11449,7 +11439,7 @@ Pop up a frame and enter GROUP. ;;;*** ;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html" -;;;;;; "gnus/gnus-html.el" (19640 47194)) +;;;;;; "gnus/gnus-html.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -11606,7 +11596,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** ;;;### (autoloads (gnus-button-reply gnus-button-mailto gnus-msg-mail) -;;;;;; "gnus-msg" "gnus/gnus-msg.el" (19640 47194)) +;;;;;; "gnus-msg" "gnus/gnus-msg.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -11727,7 +11717,7 @@ Add NUM into sorted LIST by side effect. ;;;*** ;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize) -;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19640 47194)) +;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19714 43298)) ;;; Generated autoloads from gnus/gnus-registry.el (autoload 'gnus-registry-initialize "gnus-registry" "\ @@ -11783,7 +11773,7 @@ Update the format specification near point. ;;;*** ;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -11794,7 +11784,7 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** ;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -11822,7 +11812,7 @@ Install the sync hooks. ;;;*** ;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -11832,7 +11822,7 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;;*** -;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (19562 42953)) +;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (19714 43298)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -11912,7 +11902,7 @@ You can provide a list of argument to pass to CB in CBARGS. ;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults ;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command -;;;;;; grep-window-height) "grep" "progmodes/grep.el" (19562 42953)) +;;;;;; grep-window-height) "grep" "progmodes/grep.el" (19714 43298)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -11945,7 +11935,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').") (custom-autoload 'grep-setup-hook "grep" t) -(defconst grep-regexp-alist '(("^\\(.+?\\)\\(:[ ]*\\)\\([0-9]+\\)\\2" 1 3) ("^\\(\\(.+?\\):\\([0-9]+\\):\\).*?\\(\\[01;31m\\(?:\\[K\\)?\\)\\(.*?\\)\\(\\[[0-9]*m\\)" 2 3 ((lambda nil (setq compilation-error-screen-columns nil) (- (match-beginning 4) (match-end 1))) lambda nil (- (match-end 5) (match-end 1) (- (match-end 4) (match-beginning 4)))) nil 1) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ +(defconst grep-regexp-alist '(("^\\(.+?\\)\\(:[ ]*\\)\\([0-9]+\\)\\2" 1 3) ("^\\(\\(.+?\\):\\([1-9][0-9]*\\):\\).*?\\(\\[01;31m\\(?:\\[K\\)?\\)\\(.*?\\)\\(\\[[0-9]*m\\)" 2 3 ((lambda nil (setq compilation-error-screen-columns nil) (- (match-beginning 4) (match-end 1))) lambda nil (- (match-end 5) (match-end 1) (- (match-end 4) (match-beginning 4)))) nil 1) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ Regexp used to match grep hits. See `compilation-error-regexp-alist'.") (defvar grep-program (purecopy "grep") "\ @@ -12082,7 +12072,7 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** ;;;### (autoloads (gud-tooltip-mode gdb-script-mode jdb pdb perldb -;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (19619 52030)) +;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (19714 43298)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -12388,10 +12378,10 @@ different regions. With numeric argument ARG, behaves like ;;;*** -;;;### (autoloads (describe-categories describe-syntax describe-variable -;;;;;; variable-at-point describe-function-1 find-lisp-object-file-name -;;;;;; help-C-file-name describe-function) "help-fns" "help-fns.el" -;;;;;; (19619 52030)) +;;;### (autoloads (doc-file-to-info doc-file-to-man describe-categories +;;;;;; describe-syntax describe-variable variable-at-point describe-function-1 +;;;;;; find-lisp-object-file-name help-C-file-name describe-function) +;;;;;; "help-fns" "help-fns.el" (19714 43298)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -12458,6 +12448,16 @@ BUFFER should be a buffer or a buffer name. \(fn &optional BUFFER)" t nil) +(autoload 'doc-file-to-man "help-fns" "\ +Produce an nroff buffer containing the doc-strings from the DOC file. + +\(fn FILE)" t nil) + +(autoload 'doc-file-to-info "help-fns" "\ +Produce a texinfo buffer with sorted doc-strings from the DOC file. + +\(fn FILE)" t nil) + ;;;*** ;;;### (autoloads (three-step-help) "help-macro" "help-macro.el" @@ -12586,7 +12586,7 @@ Provide help for current mode. ;;;*** ;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" -;;;;;; "hexl.el" (19640 47194)) +;;;;;; "hexl.el" (19714 43298)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -12817,7 +12817,7 @@ be found in variable `hi-lock-interactive-patterns'. ;;;*** ;;;### (autoloads (hide-ifdef-mode) "hideif" "progmodes/hideif.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -13049,7 +13049,7 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;;;; hippie-expand-ignore-buffers hippie-expand-max-buffers hippie-expand-no-restriction ;;;;;; hippie-expand-dabbrev-as-symbol hippie-expand-dabbrev-skip-space ;;;;;; hippie-expand-verbose hippie-expand-try-functions-list) "hippie-exp" -;;;;;; "hippie-exp.el" (19562 42953)) +;;;;;; "hippie-exp.el" (19714 43298)) ;;; Generated autoloads from hippie-exp.el (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\ @@ -13166,9 +13166,11 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;;;; holiday-bahai-holidays holiday-islamic-holidays holiday-christian-holidays ;;;;;; holiday-hebrew-holidays holiday-other-holidays holiday-local-holidays ;;;;;; holiday-oriental-holidays holiday-general-holidays) "holidays" -;;;;;; "calendar/holidays.el" (19598 13691)) +;;;;;; "calendar/holidays.el" (19714 43298)) ;;; Generated autoloads from calendar/holidays.el +(define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") + (defvar holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fools' Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\ General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details.") @@ -13177,7 +13179,7 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-general-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") +(define-obsolete-variable-alias 'oriental-holidays 'holiday-oriental-holidays "23.1") (defvar holiday-oriental-holidays (mapcar 'purecopy '((holiday-chinese-new-year) (if calendar-chinese-all-holidays-flag (append (holiday-chinese 1 15 "Lantern Festival") (holiday-chinese-qingming) (holiday-chinese 5 5 "Dragon Boat Festival") (holiday-chinese 7 7 "Double Seventh Festival") (holiday-chinese 8 15 "Mid-Autumn Festival") (holiday-chinese 9 9 "Double Ninth Festival") (holiday-chinese-winter-solstice))))) "\ Oriental holidays. @@ -13187,7 +13189,7 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-oriental-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'oriental-holidays 'holiday-oriental-holidays "23.1") +(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") (defvar holiday-local-holidays nil "\ Local holidays. @@ -13197,7 +13199,7 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-local-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") +(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") (defvar holiday-other-holidays nil "\ User defined holidays. @@ -13207,8 +13209,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-other-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") - (defvar hebrew-holidays-1 (mapcar 'purecopy '((holiday-hebrew-rosh-hashanah) (if calendar-hebrew-all-holidays-flag (holiday-julian 11 (let ((m displayed-month) (y displayed-year) year) (calendar-increment-month m y -1) (setq year (calendar-extract-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y))))) (if (zerop (% (1+ year) 4)) 22 21)) "\"Tal Umatar\" (evening)")))) "\ Component of the old default value of `holiday-hebrew-holidays'.") @@ -13229,6 +13229,8 @@ Component of the old default value of `holiday-hebrew-holidays'.") (put 'hebrew-holidays-4 'risky-local-variable t) +(define-obsolete-variable-alias 'hebrew-holidays 'holiday-hebrew-holidays "23.1") + (defvar holiday-hebrew-holidays (mapcar 'purecopy '((holiday-hebrew-passover) (holiday-hebrew-rosh-hashanah) (holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (append (holiday-hebrew-tisha-b-av) (holiday-hebrew-misc))))) "\ Jewish holidays. See the documentation for `calendar-holidays' for details.") @@ -13237,7 +13239,7 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-hebrew-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'hebrew-holidays 'holiday-hebrew-holidays "23.1") +(define-obsolete-variable-alias 'christian-holidays 'holiday-christian-holidays "23.1") (defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Eastern Orthodox Christmas") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\ Christian holidays. @@ -13247,7 +13249,7 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-christian-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'christian-holidays 'holiday-christian-holidays "23.1") +(define-obsolete-variable-alias 'islamic-holidays 'holiday-islamic-holidays "23.1") (defvar holiday-islamic-holidays (mapcar 'purecopy '((holiday-islamic-new-year) (holiday-islamic 9 1 "Ramadan Begins") (if calendar-islamic-all-holidays-flag (append (holiday-islamic 1 10 "Ashura") (holiday-islamic 3 12 "Mulad-al-Nabi") (holiday-islamic 7 26 "Shab-e-Mi'raj") (holiday-islamic 8 15 "Shab-e-Bara't") (holiday-islamic 9 27 "Shab-e Qadr") (holiday-islamic 10 1 "Id-al-Fitr") (holiday-islamic 12 10 "Id-al-Adha"))))) "\ Islamic holidays. @@ -13257,7 +13259,7 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-islamic-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'islamic-holidays 'holiday-islamic-holidays "23.1") +(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") (defvar holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Bab") (holiday-fixed 5 29 "Ascension of Baha'u'llah") (holiday-fixed 7 9 "Martyrdom of the Bab") (holiday-fixed 10 20 "Birth of the Bab") (holiday-fixed 11 12 "Birth of Baha'u'llah") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))))) "\ Baha'i holidays. @@ -13267,7 +13269,7 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-bahai-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") +(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") (defvar holiday-solar-holidays (mapcar 'purecopy '((solar-equinoxes-solstices) (holiday-sexp calendar-daylight-savings-starts (format "Daylight Saving Time Begins %s" (solar-time-string (/ calendar-daylight-savings-starts-time (float 60)) calendar-standard-time-zone-name))) (holiday-sexp calendar-daylight-savings-ends (format "Daylight Saving Time Ends %s" (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) calendar-daylight-time-zone-name))))) "\ Sun-related holidays. @@ -13277,8 +13279,6 @@ See the documentation for `calendar-holidays' for details.") (put 'holiday-solar-holidays 'risky-local-variable t) -(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") - (put 'calendar-holidays 'risky-local-variable t) (autoload 'holidays "holidays" "\ @@ -13457,7 +13457,7 @@ bound to the current value of the filter. ;;;*** ;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers) -;;;;;; "ibuffer" "ibuffer.el" (19640 47194)) +;;;;;; "ibuffer" "ibuffer.el" (19714 43298)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -13572,7 +13572,7 @@ otherwise turn it off. ;;;*** -;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (19562 42953)) +;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (19714 43298)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -13613,7 +13613,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -13639,7 +13639,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** ;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/idlwave.el (autoload 'idlwave-mode "idlwave" "\ @@ -14064,7 +14064,7 @@ Toggle inline image minor mode. ;;;;;; put-image create-image image-type-auto-detected-p image-type-available-p ;;;;;; image-type image-type-from-file-name image-type-from-file-header ;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -14660,7 +14660,7 @@ Convert old Emacs Devanagari characters to UCS. ;;;### (autoloads (inferior-lisp inferior-lisp-prompt inferior-lisp-load-command ;;;;;; inferior-lisp-program inferior-lisp-filter-regexp) "inf-lisp" -;;;;;; "progmodes/inf-lisp.el" (19640 47194)) +;;;;;; "progmodes/inf-lisp.el" (19714 43298)) ;;; Generated autoloads from progmodes/inf-lisp.el (defvar inferior-lisp-filter-regexp (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") "\ @@ -14728,7 +14728,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;;;; Info-goto-emacs-command-node Info-mode info-finder info-apropos ;;;;;; Info-index Info-directory Info-on-current-buffer info-standalone ;;;;;; info-emacs-manual info info-other-window) "info" "info.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from info.el (autoload 'info-other-window "info" "\ @@ -15172,7 +15172,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings ;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell ;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary) -;;;;;; "ispell" "textmodes/ispell.el" (19619 52030)) +;;;;;; "ispell" "textmodes/ispell.el" (19714 43298)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -15392,8 +15392,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19640 -;;;;;; 47194)) +;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from iswitchb.el (defvar iswitchb-mode nil "\ @@ -15519,16 +15519,12 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19619 52030)) +;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19714 43298)) ;;; Generated autoloads from progmodes/js.el (autoload 'js-mode "js" "\ Major mode for editing JavaScript. -Key bindings: - -\\{js-mode-map} - \(fn)" t nil) (defalias 'javascript-mode 'js-mode) @@ -15766,7 +15762,7 @@ Not documented ;;;*** ;;;### (autoloads (lm lm-test-run) "landmark" "play/landmark.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from play/landmark.el (defalias 'landmark-repeat 'lm-test-run) @@ -15959,7 +15955,7 @@ Not documented ;;;*** -;;;### (autoloads (life) "life" "play/life.el" (19562 42953)) +;;;### (autoloads (life) "life" "play/life.el" (19714 43298)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -16044,7 +16040,7 @@ something strange, such as redefining an Emacs function. ;;;*** ;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches) -;;;;;; "locate" "locate.el" (19562 42953)) +;;;;;; "locate" "locate.el" (19714 43298)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -16056,7 +16052,7 @@ This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches.") (autoload 'locate "locate" "\ 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, @@ -16072,7 +16068,8 @@ the variables `locate-command' or `locate-make-command-line'. 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'. \(fn SEARCH-STRING &optional FILTER ARG)" t nil) @@ -16095,7 +16092,7 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (19562 42953)) +;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (19714 43298)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -16155,8 +16152,8 @@ are indicated with a symbol. ;;;*** ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer -;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (19562 -;;;;;; 42953)) +;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt))) @@ -16250,7 +16247,7 @@ for further customization of the printer command. ;;;*** ;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -16276,13 +16273,12 @@ This function is suitable for execution in a .emacs file. ;;;*** -;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ A major mode to edit m4 macro files. -\\{m4-mode-map} \(fn)" t nil) @@ -16392,7 +16388,7 @@ and then select the region of un-tablified names and use ;;;*** ;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" -;;;;;; "mail/mail-extr.el" (19598 13691)) +;;;;;; "mail/mail-extr.el" (19714 43298)) ;;; Generated autoloads from mail/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -16608,7 +16604,7 @@ current header, calls `mail-complete-function' and passes prefix arg if any. ;;;*** ;;;### (autoloads (mailclient-send-it) "mailclient" "mail/mailclient.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -16739,8 +16735,8 @@ An adapted `makefile-mode' that knows about imake. ;;;*** -;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -16854,7 +16850,7 @@ Returns non-nil if the new state is enabled. ;;;*** -;;;### (autoloads nil "menu-bar" "menu-bar.el" (19619 52030)) +;;;### (autoloads nil "menu-bar" "menu-bar.el" (19714 43298)) ;;; Generated autoloads from menu-bar.el (put 'menu-bar-mode 'standard-value '(t)) @@ -16867,7 +16863,7 @@ Returns non-nil if the new state is enabled. ;;;;;; message-forward-make-body message-forward message-recover ;;;;;; message-supersede message-cancel-news message-followup message-wide-reply ;;;;;; message-reply message-news message-mail message-mode) "message" -;;;;;; "gnus/message.el" (19640 47194)) +;;;;;; "gnus/message.el" (19714 43298)) ;;; Generated autoloads from gnus/message.el (define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) @@ -17033,26 +17029,16 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/meta-mode.el (autoload 'metafont-mode "meta-mode" "\ Major mode for editing Metafont sources. -Special commands: -\\{meta-mode-map} - -Turning on Metafont mode calls the value of the variables -`meta-common-mode-hook' and `metafont-mode-hook'. \(fn)" t nil) (autoload 'metapost-mode "meta-mode" "\ Major mode for editing MetaPost sources. -Special commands: -\\{meta-mode-map} - -Turning on MetaPost mode calls the value of the variable -`meta-common-mode-hook' and `metafont-mode-hook'. \(fn)" t nil) @@ -17348,7 +17334,7 @@ Returns non-nil if the new state is enabled. ;;;*** -;;;### (autoloads (butterfly) "misc" "misc.el" (19598 13691)) +;;;### (autoloads (butterfly) "misc" "misc.el" (19714 43298)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -17449,19 +17435,18 @@ whose file names match the specified wildcard. ;;;*** ;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/mixal-mode.el (autoload 'mixal-mode "mixal-mode" "\ Major mode for the mixal asm language. -\\{mixal-mode-map} \(fn)" t nil) ;;;*** ;;;### (autoloads (mm-inline-external-body mm-extern-cache-contents) -;;;;;; "mm-extern" "gnus/mm-extern.el" (19640 47194)) +;;;;;; "mm-extern" "gnus/mm-extern.el" (19714 43298)) ;;; Generated autoloads from gnus/mm-extern.el (autoload 'mm-extern-cache-contents "mm-extern" "\ @@ -17494,7 +17479,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** ;;;### (autoloads (mm-url-insert-file-contents-external mm-url-insert-file-contents) -;;;;;; "mm-url" "gnus/mm-url.el" (19598 13691)) +;;;;;; "mm-url" "gnus/mm-url.el" (19714 43298)) ;;; Generated autoloads from gnus/mm-url.el (autoload 'mm-url-insert-file-contents "mm-url" "\ @@ -17511,7 +17496,7 @@ Insert file contents of URL using `mm-url-program'. ;;;*** ;;;### (autoloads (mm-uu-dissect-text-parts mm-uu-dissect) "mm-uu" -;;;;;; "gnus/mm-uu.el" (19598 13691)) +;;;;;; "gnus/mm-uu.el" (19714 43298)) ;;; Generated autoloads from gnus/mm-uu.el (autoload 'mm-uu-dissect "mm-uu" "\ @@ -17548,7 +17533,7 @@ Not documented ;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt ;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt) -;;;;;; "mml2015" "gnus/mml2015.el" (19640 47194)) +;;;;;; "mml2015" "gnus/mml2015.el" (19714 43298)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -17588,11 +17573,13 @@ Not documented ;;;*** -;;;### (autoloads (modula-2-mode) "modula2" "progmodes/modula2.el" -;;;;;; (19640 47194)) +;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/modula2.el -(autoload 'modula-2-mode "modula2" "\ +(defalias 'modula-2-mode 'm2-mode) + +(autoload 'm2-mode "modula2" "\ 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. @@ -17637,7 +17624,7 @@ Convert morse coded text in region to ordinary ASCII text. ;;;*** ;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag" -;;;;;; "mouse-drag.el" (19562 42953)) +;;;;;; "mouse-drag.el" (19714 43298)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -17684,8 +17671,8 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from mouse-sel.el (defvar mouse-sel-mode nil "\ @@ -17737,7 +17724,7 @@ primary selection and region. ;;;*** -;;;### (autoloads (mpc) "mpc" "mpc.el" (19562 42953)) +;;;### (autoloads (mpc) "mpc" "mpc.el" (19714 43269)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -17779,8 +17766,8 @@ different buffer menu using the function `msb'. ;;;*** -;;;### (autoloads nil "mule-cmds" "international/mule-cmds.el" (19598 -;;;;;; 13691)) +;;;### (autoloads nil "mule-cmds" "international/mule-cmds.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from international/mule-cmds.el (put 'input-method-alist 'risky-local-variable t) @@ -18069,8 +18056,8 @@ per-character basis, this may not be accurate. ;;;### (autoloads (network-connection network-connection-to-service ;;;;;; whois-reverse-lookup whois finger ftp run-dig dns-lookup-host ;;;;;; nslookup nslookup-host ping traceroute route arp netstat -;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (19619 -;;;;;; 52030)) +;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -18182,7 +18169,7 @@ listed in the PORTS list. ;;;;;; uncomment-region comment-kill comment-set-column comment-indent ;;;;;; comment-indent-default comment-normalize-vars comment-multi-line ;;;;;; comment-padding comment-style comment-column) "newcomment" -;;;;;; "newcomment.el" (19619 52030)) +;;;;;; "newcomment.el" (19714 43298)) ;;; Generated autoloads from newcomment.el (defalias 'indent-for-comment 'comment-indent) @@ -18346,8 +18333,8 @@ is passed on to the respective function. (autoload 'comment-dwim "newcomment" "\ Call the comment command you want (Do What I Mean). If the region is active and `transient-mark-mode' is on, call - `comment-region' (unless it only consists of comments, in which - case it calls `uncomment-region'). +`comment-region' (unless it only consists of comments, in which +case it calls `uncomment-region'). Else, if the current line is empty, call `comment-insert-comment-function' if it is defined, otherwise insert a comment and indent it. Else if a prefix ARG is specified, call `comment-kill'. @@ -18458,7 +18445,7 @@ Start newsticker treeview. ;;;*** ;;;### (autoloads (nndiary-generate-nov-databases) "nndiary" "gnus/nndiary.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -18468,8 +18455,8 @@ Generate NOV databases in all nndiary directories. ;;;*** -;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (19640 -;;;;;; 47194)) +;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -18484,7 +18471,7 @@ symbol in the alist. ;;;*** ;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -18496,7 +18483,7 @@ This command does not work if you use short group names. ;;;*** ;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -18507,7 +18494,7 @@ Generate NOV databases in all nnml directories. ;;;*** ;;;### (autoloads (disable-command enable-command disabled-command-function) -;;;;;; "novice" "novice.el" (19562 42953)) +;;;;;; "novice" "novice.el" (19714 43298)) ;;; Generated autoloads from novice.el (defvar disabled-command-function 'disabled-command-function "\ @@ -18567,8 +18554,8 @@ Return nil if the face cannot display a glyph for N. ;;;*** -;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -18642,21 +18629,25 @@ the variable `nxml-enabled-unicode-blocks'. ;;;*** -;;;### (autoloads (org-babel-previous-src-block org-babel-next-src-block -;;;;;; org-babel-goto-named-result org-babel-goto-named-src-block -;;;;;; org-babel-hide-result-toggle-maybe org-babel-sha1-hash org-babel-execute-subtree -;;;;;; org-babel-execute-buffer org-babel-open-src-block-result -;;;;;; org-babel-switch-to-session org-babel-load-in-session org-babel-expand-src-block -;;;;;; org-babel-execute-src-block org-babel-pop-to-session-maybe +;;;### (autoloads (org-babel-mark-block org-babel-previous-src-block +;;;;;; org-babel-next-src-block org-babel-goto-named-result org-babel-goto-named-src-block +;;;;;; org-babel-goto-src-block-head org-babel-hide-result-toggle-maybe +;;;;;; org-babel-sha1-hash org-babel-execute-subtree org-babel-execute-buffer +;;;;;; org-babel-open-src-block-result org-babel-switch-to-session-with-code +;;;;;; org-babel-switch-to-session org-babel-initiate-session org-babel-load-in-session +;;;;;; org-babel-expand-src-block org-babel-execute-src-block org-babel-pop-to-session-maybe ;;;;;; org-babel-load-in-session-maybe org-babel-expand-src-block-maybe -;;;;;; org-babel-execute-src-block-maybe) "ob" "org/ob.el" (19598 -;;;;;; 13691)) +;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob" +;;;;;; "org/ob.el" (19714 43298)) ;;; Generated autoloads from org/ob.el -(autoload 'org-babel-execute-src-block-maybe "ob" "\ -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'. +(autoload 'org-babel-execute-safely-maybe "ob" "\ +Not documented + +\(fn)" nil nil) + +(autoload 'org-babel-execute-maybe "ob" "\ +Not documented \(fn)" t nil) @@ -18687,6 +18678,10 @@ 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'. @@ -18711,11 +18706,24 @@ session. \(fn &optional ARG INFO)" t nil) +(autoload 'org-babel-initiate-session "ob" "\ +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. + +\(fn &optional ARG INFO)" t nil) + (autoload 'org-babel-switch-to-session "ob" "\ -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. +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'. + +\(fn &optional ARG INFO)" t nil) + +(autoload 'org-babel-switch-to-session-with-code "ob" "\ +Switch to code buffer and display session. \(fn &optional ARG INFO)" t nil) @@ -18751,6 +18759,11 @@ Toggle visibility of result at point. \(fn)" t nil) +(autoload 'org-babel-goto-src-block-head "ob" "\ +Go to the beginning of the current code block. + +\(fn)" t nil) + (autoload 'org-babel-goto-named-src-block "ob" "\ Go to a named source-code block. @@ -18773,10 +18786,15 @@ With optional prefix argument ARG, jump backward ARG many source blocks. \(fn &optional ARG)" t nil) +(autoload 'org-babel-mark-block "ob" "\ +Mark current src block + +\(fn)" t nil) + ;;;*** ;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "org/ob-keys.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/ob-keys.el (autoload 'org-babel-describe-bindings "ob-keys" "\ @@ -18787,11 +18805,12 @@ Describe all keybindings behind `org-babel-key-prefix'. ;;;*** ;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe -;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (19562 42953)) +;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (19714 43298)) ;;; Generated autoloads from org/ob-lob.el (autoload 'org-babel-lob-ingest "ob-lob" "\ -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'. \(fn &optional FILE)" t nil) @@ -18805,21 +18824,24 @@ if so then run the appropriate source block from the Library. (autoload 'org-babel-lob-get-info "ob-lob" "\ 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'. - \(fn)" nil nil) ;;;*** -;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file) -;;;;;; "ob-tangle" "org/ob-tangle.el" (19562 42953)) +;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file +;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "org/ob-tangle.el" +;;;;;; (19714 43298)) ;;; Generated autoloads from org/ob-tangle.el +(defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\ +Alist mapping languages to their file extensions. +The key is the language name, the value is the string that should +be inserted as the extension commonly used to identify files +written in this language. If no entry is found in this list, +then the name of the language is used.") + +(custom-autoload 'org-babel-tangle-lang-exts "ob-tangle" t) + (autoload 'org-babel-load-file "ob-tangle" "\ Load Emacs Lisp source code blocks in the Org-mode FILE. This function exports the source code using @@ -18850,7 +18872,7 @@ exported source code blocks by language. ;;;*** ;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/octave-inf.el (autoload 'inferior-octave "octave-inf" "\ @@ -18873,7 +18895,7 @@ startup file, `~/.emacs-octave'. ;;;*** ;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/octave-mod.el (autoload 'octave-mode "octave-mod" "\ @@ -18904,14 +18926,6 @@ Keybindings 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. @@ -18969,7 +18983,7 @@ including a reproducible test case and send the message. ;;;;;; org-insert-link-global org-store-link org-run-like-in-org-mode ;;;;;; turn-on-orgstruct++ turn-on-orgstruct orgstruct-mode org-global-cycle ;;;;;; org-mode org-babel-do-load-languages) "org" "org/org.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19192,7 +19206,7 @@ Call the customize function with org as argument. ;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list ;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views ;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda -;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (19619 52030)) +;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (19714 43298)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-agenda "org-agenda" "\ @@ -19373,7 +19387,6 @@ 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. \(fn &rest IGNORE)" t nil) @@ -19443,7 +19456,7 @@ belonging to the \"Work\" category. ;;;### (autoloads (org-archive-subtree-default-with-confirmation ;;;;;; org-archive-subtree-default) "org-archive" "org/org-archive.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-archive.el (autoload 'org-archive-subtree-default "org-archive" "\ @@ -19463,8 +19476,8 @@ This command is set with the variable `org-archive-default-command'. ;;;### (autoloads (org-export-as-ascii org-export-region-as-ascii ;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer ;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer -;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (19562 -;;;;;; 42953)) +;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from org/org-ascii.el (autoload 'org-export-as-latin1 "org-ascii" "\ @@ -19537,8 +19550,8 @@ publishing directory. ;;;*** -;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from org/org-attach.el (autoload 'org-attach "org-attach" "\ @@ -19550,7 +19563,7 @@ Shows a list of commands and prompts for another key to execute a command. ;;;*** ;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org/org-bbdb.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-bbdb.el (autoload 'org-bbdb-anniversaries "org-bbdb" "\ @@ -19561,7 +19574,7 @@ Extract anniversaries from BBDB for display in the agenda. ;;;*** ;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here -;;;;;; org-capture) "org-capture" "org/org-capture.el" (19562 42953)) +;;;;;; org-capture) "org-capture" "org/org-capture.el" (19714 43298)) ;;; Generated autoloads from org/org-capture.el (autoload 'org-capture "org-capture" "\ @@ -19599,7 +19612,7 @@ Set org-capture-templates to be similar to `org-remember-templates'. ;;;*** ;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable) -;;;;;; "org-clock" "org/org-clock.el" (19562 42953)) +;;;;;; "org-clock" "org/org-clock.el" (19714 43298)) ;;; Generated autoloads from org/org-clock.el (autoload 'org-get-clocktable "org-clock" "\ @@ -19617,7 +19630,7 @@ Set up hooks for clock persistence. ;;;*** ;;;### (autoloads (org-datetree-find-date-create) "org-datetree" -;;;;;; "org/org-datetree.el" (19562 42953)) +;;;;;; "org/org-datetree.el" (19714 43298)) ;;; Generated autoloads from org/org-datetree.el (autoload 'org-datetree-find-date-create "org-datetree" "\ @@ -19633,7 +19646,7 @@ tree can be found. ;;;### (autoloads (org-export-as-docbook org-export-as-docbook-pdf-and-open ;;;;;; org-export-as-docbook-pdf org-export-region-as-docbook org-replace-region-by-docbook ;;;;;; org-export-as-docbook-to-buffer org-export-as-docbook-batch) -;;;;;; "org-docbook" "org/org-docbook.el" (19562 42953)) +;;;;;; "org-docbook" "org/org-docbook.el" (19714 43298)) ;;; Generated autoloads from org/org-docbook.el (autoload 'org-export-as-docbook-batch "org-docbook" "\ @@ -19710,7 +19723,7 @@ publishing directory. ;;;### (autoloads (org-insert-export-options-template org-export-as-org ;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-exp.el (autoload 'org-export "org-exp" "\ @@ -19767,8 +19780,8 @@ Insert into the buffer a template with information for exporting. ;;;*** ;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update -;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (19562 -;;;;;; 42953)) +;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from org/org-feed.el (autoload 'org-feed-update-all "org-feed" "\ @@ -19796,7 +19809,7 @@ Show the raw feed buffer of a feed. ;;;*** ;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org/org-footnote.el" (19562 42953)) +;;;;;; "org/org-footnote.el" (19714 43298)) ;;; Generated autoloads from org/org-footnote.el (autoload 'org-footnote-action "org-footnote" "\ @@ -19823,13 +19836,26 @@ referenced sequence. ;;;### (autoloads (org-freemind-to-org-mode org-freemind-from-org-sparse-tree ;;;;;; org-freemind-from-org-mode org-freemind-from-org-mode-node ;;;;;; org-freemind-show org-export-as-freemind) "org-freemind" -;;;;;; "org/org-freemind.el" (19562 42953)) +;;;;;; "org/org-freemind.el" (19714 43298)) ;;; Generated autoloads from org/org-freemind.el (autoload 'org-export-as-freemind "org-freemind" "\ -Not documented +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. -\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil) +See `org-freemind-from-org-mode' for more information. + +\(fn &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil) (autoload 'org-freemind-show "org-freemind" "\ Show file MM-FILE in Freemind. @@ -19838,11 +19864,21 @@ Show file MM-FILE in Freemind. (autoload 'org-freemind-from-org-mode-node "org-freemind" "\ Convert node at line NODE-LINE to the FreeMind file MM-FILE. +See `org-freemind-from-org-mode' for more information. \(fn NODE-LINE MM-FILE)" t nil) (autoload 'org-freemind-from-org-mode "org-freemind" "\ 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). \(fn ORG-FILE MM-FILE)" t nil) @@ -19861,7 +19897,7 @@ Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE. ;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html ;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer ;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html" -;;;;;; "org/org-html.el" (19562 42953)) +;;;;;; "org/org-html.el" (19714 43298)) ;;; Generated autoloads from org/org-html.el (put 'org-export-html-style-include-default 'safe-local-variable 'booleanp) @@ -19955,7 +19991,7 @@ that uses these same face definitions. ;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files ;;;;;; org-export-icalendar-this-file) "org-icalendar" "org/org-icalendar.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-icalendar.el (autoload 'org-export-icalendar-this-file "org-icalendar" "\ @@ -19980,9 +20016,10 @@ The file is stored under the name `org-combined-agenda-icalendar-file'. ;;;*** -;;;### (autoloads (org-id-find-id-file org-id-find org-id-goto org-id-get-with-outline-drilling -;;;;;; org-id-get-with-outline-path-completion org-id-get org-id-copy -;;;;;; org-id-get-create) "org-id" "org/org-id.el" (19562 42953)) +;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find +;;;;;; org-id-goto org-id-get-with-outline-drilling org-id-get-with-outline-path-completion +;;;;;; org-id-get org-id-copy org-id-get-create) "org-id" "org/org-id.el" +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-id.el (autoload 'org-id-get-create "org-id" "\ @@ -20043,10 +20080,15 @@ Query the id database for the file in which this ID is located. \(fn ID)" nil nil) +(autoload 'org-id-store-link "org-id" "\ +Store a link to the current entry, using its ID. + +\(fn)" t nil) + ;;;*** ;;;### (autoloads (org-indent-mode) "org-indent" "org/org-indent.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-indent.el (autoload 'org-indent-mode "org-indent" "\ @@ -20061,7 +20103,7 @@ FIXME: How to update when broken? ;;;*** ;;;### (autoloads (org-irc-store-link) "org-irc" "org/org-irc.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-irc.el (autoload 'org-irc-store-link "org-irc" "\ @@ -20074,7 +20116,7 @@ Dispatch to the appropriate function to store a link to an IRC session. ;;;### (autoloads (org-export-as-pdf-and-open org-export-as-pdf org-export-as-latex ;;;;;; org-export-region-as-latex org-replace-region-by-latex org-export-as-latex-to-buffer ;;;;;; org-export-as-latex-batch) "org-latex" "org/org-latex.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-latex.el (autoload 'org-export-as-latex-batch "org-latex" "\ @@ -20154,8 +20196,8 @@ Export as LaTeX, then process through to PDF, and open. ;;;*** ;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull -;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (19562 -;;;;;; 42953)) +;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from org/org-mobile.el (autoload 'org-mobile-push "org-mobile" "\ @@ -20180,7 +20222,7 @@ Create a file that contains all custom agenda views. ;;;*** ;;;### (autoloads (org-plot/gnuplot) "org-plot" "org/org-plot.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-plot.el (autoload 'org-plot/gnuplot "org-plot" "\ @@ -20194,7 +20236,7 @@ line directly before or after the table. ;;;### (autoloads (org-publish-current-project org-publish-current-file ;;;;;; org-publish-all org-publish) "org-publish" "org/org-publish.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-publish.el (defalias 'org-publish-project 'org-publish) @@ -20228,7 +20270,7 @@ the project. ;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template ;;;;;; org-remember-annotation org-remember-insinuate) "org-remember" -;;;;;; "org/org-remember.el" (19562 42953)) +;;;;;; "org/org-remember.el" (19714 43298)) ;;; Generated autoloads from org/org-remember.el (autoload 'org-remember-insinuate "org-remember" "\ @@ -20304,7 +20346,7 @@ See also the variable `org-reverse-note-order'. ;;;*** ;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl) -;;;;;; "org-table" "org/org-table.el" (19562 42953)) +;;;;;; "org-table" "org/org-table.el" (19714 43298)) ;;; Generated autoloads from org/org-table.el (autoload 'turn-on-orgtbl "org-table" "\ @@ -20328,7 +20370,7 @@ The table is taken from the parameter TXT, or from the buffer at point. ;;;*** ;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler) -;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (19562 42953)) +;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (19714 43298)) ;;; Generated autoloads from org/org-taskjuggler.el (autoload 'org-export-as-taskjuggler "org-taskjuggler" "\ @@ -20356,7 +20398,7 @@ with the TaskJuggler GUI. ;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region ;;;;;; org-timer org-timer-start) "org-timer" "org/org-timer.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-timer.el (autoload 'org-timer-start "org-timer" "\ @@ -20376,11 +20418,14 @@ the region 0:00:00. 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. -\(fn &optional RESTART)" t nil) +If NO-INSERT-P is non-nil, return the string instead of inserting +it in the buffer. + +\(fn &optional RESTART NO-INSERT-P)" t nil) (autoload 'org-timer-change-times-in-region "org-timer" "\ Change all h:mm:ss time in region by a DELTA. @@ -20397,7 +20442,7 @@ 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. @@ -20414,7 +20459,7 @@ replace any running timer. ;;;*** ;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org/org-xoxo.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from org/org-xoxo.el (autoload 'org-export-as-xoxo "org-xoxo" "\ @@ -20486,7 +20531,7 @@ See the command `outline-mode' for more information on this mode. ;;;### (autoloads (list-packages describe-package package-initialize ;;;;;; package-install-file package-install-from-buffer package-install ;;;;;; package-enable-at-startup) "package" "emacs-lisp/package.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from emacs-lisp/package.el (defvar package-enable-at-startup t "\ @@ -20528,8 +20573,9 @@ The file can either be a tar file or an Emacs Lisp file. (autoload 'package-initialize "package" "\ Load Emacs Lisp packages, and activate them. The variable `package-load-list' controls which packages to load. +If optional arg NO-ACTIVATE is non-nil, don't activate packages. -\(fn)" t nil) +\(fn &optional NO-ACTIVATE)" t nil) (autoload 'describe-package "package" "\ Display the full documentation of PACKAGE (a symbol). @@ -20547,7 +20593,7 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads (show-paren-mode) "paren" "paren.el" (19562 42953)) +;;;### (autoloads (show-paren-mode) "paren" "paren.el" (19714 43298)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -20585,8 +20631,8 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20741,7 +20787,7 @@ but before calling PC Selection mode): ;;;*** ;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20755,10 +20801,12 @@ UPatterns can take the following forms: (and UPAT...) matches if all the patterns match. `QPAT matches if the QPattern QPAT matches. (pred PRED) matches if PRED applied to the object returns non-nil. + (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. QPatterns can take the following forms: (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. ,UPAT matches if the UPattern UPAT matches. + STRING matches if the object is `equal' to STRING. ATOM matches if the object is `eq' to ATOM. QPatterns for vectors are not implemented yet. @@ -20780,14 +20828,18 @@ 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). -\(fn BINDINGS BODY)" nil (quote macro)) +\(fn BINDINGS &rest BODY)" nil (quote macro)) + +(put 'pcase-let* 'lisp-indent-function '1) (autoload 'pcase-let "pcase" "\ Like `let' but where you can use `pcase' patterns for bindings. -BODY should be an expression, and BINDINGS should be a list of bindings +BODY should be a list of expressions, and BINDINGS should be a list of bindings of the form (UPAT EXP). -\(fn BINDINGS BODY)" nil (quote macro)) +\(fn BINDINGS &rest BODY)" nil (quote macro)) + +(put 'pcase-let 'lisp-indent-function '1) ;;;*** @@ -21064,7 +21116,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** ;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -21273,7 +21325,7 @@ True if decoded armor MESSAGE-KEYS has symmetric encryption indicator. ;;;*** ;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -21381,7 +21433,7 @@ pong-mode keybindings:\\<pong-mode-map> ;;;*** -;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (19640 47194)) +;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (19714 43298)) ;;; Generated autoloads from gnus/pop3.el (autoload 'pop3-movemail "pop3" "\ @@ -21462,7 +21514,7 @@ Ignores leading comment characters. ;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview ;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript ;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from printing.el (autoload 'pr-interface "printing" "\ @@ -22065,7 +22117,7 @@ See `proced-mode' for a description of features available in Proced buffers. ;;;*** ;;;### (autoloads (switch-to-prolog prolog-mode) "prolog" "progmodes/prolog.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -22088,6 +22140,45 @@ With prefix argument \\[universal-prefix], prompt for the program to use. ;;;*** +;;;### (autoloads (open-protocol-stream) "proto-stream" "gnus/proto-stream.el" +;;;;;; (19714 43298)) +;;; Generated autoloads from gnus/proto-stream.el + +(autoload 'open-protocol-stream "proto-stream" "\ +Open a network stream to HOST, upgrading to STARTTLS if possible. +The first four parameters have the same meaning as in +`open-network-stream'. The function returns a list where the +first element is the stream, the second element is the greeting +the server replied with after connecting, and the third element +is a string representing the capabilities of the server (if any). + +The PARAMETERS is a keyword list that can have the following +values: + +:type -- either `network', `tls', `shell' or `starttls'. If +omitted, the default is `network'. `network' will be +opportunistically upgraded to STARTTLS if both the server and +Emacs supports it. + +:end-of-command -- a regexp saying what the end of a command is. +This defaults to \"\\n\". + +:success -- a regexp saying whether the STARTTLS command was +successful or not. For instance, for NNTP this is \"^3\". + +:capability-command -- a string representing the command used to +query server for capabilities. For instance, for IMAP this is +\"1 CAPABILITY\\r\\n\". + +:starttls-function -- a function that takes one parameter, which +is the response to the capaibility command. It should return nil +if it turns out that the server doesn't support STARTTLS, or the +command to switch on STARTTLS otherwise. + +\(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil) + +;;;*** + ;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (19598 ;;;;;; 13691)) ;;; Generated autoloads from ps-bdf.el @@ -22100,8 +22191,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/ps-mode.el (autoload 'ps-mode "ps-mode" "\ @@ -22152,8 +22243,8 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type -;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (19640 -;;;;;; 47194)) +;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from ps-print.el (defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\ @@ -22350,7 +22441,7 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** ;;;### (autoloads (python-shell jython-mode python-mode run-python) -;;;;;; "python" "progmodes/python.el" (19598 13691)) +;;;;;; "python" "progmodes/python.el" (19714 43298)) ;;; Generated autoloads from progmodes/python.el (add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode)) @@ -22361,20 +22452,24 @@ If EXTENSION is any other symbol, it is ignored. (autoload 'run-python "python" "\ Run an inferior Python process, input and output via buffer *Python*. -CMD is the Python command to run. NOSHOW non-nil means don't show the -buffer automatically. +CMD is the Python command to run. NOSHOW non-nil means don't +show the buffer automatically. + +Interactively, a prefix arg means to prompt for the initial +Python command line (default is `python-command'). -Normally, if there is a process already running in `python-buffer', -switch to that buffer. Interactively, a prefix arg allows you to edit -the initial command line (default is `python-command'); `-i' etc. args -will be added to this as appropriate. A new process is started if: -one isn't running attached to `python-buffer', or interactively the -default `python-command', or argument NEW is non-nil. See also the -documentation for `python-buffer'. +A new process is started if one isn't running attached to +`python-buffer', or if called from Lisp with non-nil arg NEW. +Otherwise, if a process is already running in `python-buffer', +switch to that buffer. -Runs the hook `inferior-python-mode-hook' (after the -`comint-mode-hook' is run). (Type \\[describe-mode] in the process -buffer for a list of commands.) +This command runs the hook `inferior-python-mode-hook' after +running `comint-mode-hook'. Type \\[describe-mode] in the +process buffer for a list of commands. + +By default, Emacs inhibits the loading of Python modules from the +current working directory, for security reasons. To disable this +behavior, change `python-remove-cwd-from-path' to nil. \(fn &optional CMD NOSHOW NEW)" t nil) @@ -22436,7 +22531,7 @@ command is used to switch to an existing process, only when a new process is started. If you use this, you will probably want to ensure that the current arguments are retained (they will be included in the prompt). This argument is ignored when this function is called -programmatically, or when running in Emacs 19.34 or older. +programmatically. Note: You can toggle between using the CPython interpreter and the JPython interpreter by hitting \\[python-toggle-shells]. This toggles @@ -22720,8 +22815,8 @@ of each directory. ;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls ;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url -;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (19640 -;;;;;; 47194)) +;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from net/quickurl.el (defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\ @@ -23082,7 +23177,7 @@ This enforces rescanning the buffer on next use. ;;;*** ;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from textmodes/reftex-cite.el (autoload 'reftex-citation "reftex-cite" "\ @@ -23129,7 +23224,7 @@ With no argument, this command toggles ;;;*** ;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from textmodes/reftex-index.el (autoload 'reftex-index-phrases-mode "reftex-index" "\ @@ -23185,7 +23280,7 @@ of master file. ;;;*** ;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload 'regexp-opt "regexp-opt" "\ @@ -23216,7 +23311,7 @@ This means the number of non-shy regexp grouping constructs ;;;### (autoloads (remember-diary-extract-entries remember-clipboard ;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from textmodes/remember.el (autoload 'remember "remember" "\ @@ -23247,7 +23342,7 @@ Extract diary entries from the region. ;;;*** -;;;### (autoloads (repeat) "repeat" "repeat.el" (19619 52030)) +;;;### (autoloads (repeat) "repeat" "repeat.el" (19714 43298)) ;;; Generated autoloads from repeat.el (autoload 'repeat "repeat" "\ @@ -23302,7 +23397,7 @@ mail-sending package is used for editing and sending the message. ;;;*** ;;;### (autoloads (reposition-window) "reposition" "reposition.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -23429,8 +23524,8 @@ variable. ;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers ;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers ;;;;;; rmail-dont-reply-to-names rmail-user-mail-address-regexp -;;;;;; rmail-movemail-variant-p) "rmail" "mail/rmail.el" (19640 -;;;;;; 47194)) +;;;;;; rmail-movemail-variant-p) "rmail" "mail/rmail.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from mail/rmail.el (autoload 'rmail-movemail-variant-p "rmail" "\ @@ -23701,7 +23796,7 @@ Return a pattern. ;;;*** ;;;### (autoloads (rng-nxml-mode-init) "rng-nxml" "nxml/rng-nxml.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -23714,7 +23809,7 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** ;;;### (autoloads (rng-validate-mode) "rng-valid" "nxml/rng-valid.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -23844,7 +23939,7 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** ;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -23882,7 +23977,7 @@ for modes derived from Text mode, like Mail mode. ;;;*** ;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/ruby-mode.el (autoload 'ruby-mode "ruby-mode" "\ @@ -24255,7 +24350,7 @@ which is probably undesirable. ;;;*** ;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -24408,7 +24503,7 @@ Semantic mode. ;;;;;; mail-alias-file mail-default-reply-to mail-archive-file-name ;;;;;; mail-header-separator send-mail-function mail-interactive ;;;;;; mail-self-blind mail-specify-envelope-from mail-from-style) -;;;;;; "sendmail" "mail/sendmail.el" (19619 52030)) +;;;;;; "sendmail" "mail/sendmail.el" (19714 43298)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24708,10 +24803,16 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** ;;;### (autoloads (server-save-buffers-kill-terminal server-mode -;;;;;; server-force-delete server-start) "server" "server.el" (19640 -;;;;;; 47194)) +;;;;;; server-force-delete server-start) "server" "server.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from server.el +(put 'server-host 'risky-local-variable t) + +(put 'server-port 'risky-local-variable t) + +(put 'server-auth-dir 'risky-local-variable t) + (autoload 'server-start "server" "\ Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which @@ -24722,11 +24823,14 @@ Emacs distribution as your standard \"editor\". 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]. -\(fn &optional LEAVE-DEAD)" t nil) +\(fn &optional LEAVE-DEAD INHIBIT-PROMPT)" t nil) (autoload 'server-force-delete "server" "\ Unconditionally delete connection file for server NAME. @@ -24782,7 +24886,7 @@ These are active only in the minibuffer, when entering or editing a formula: ;;;*** ;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24848,7 +24952,7 @@ To work around that, do: ;;;*** ;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/sh-script.el (put 'sh-shell 'safe-local-variable 'symbolp) @@ -25017,7 +25121,7 @@ Set up file shadowing. ;;;*** ;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -25066,8 +25170,8 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19640 -;;;;;; 47194)) +;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from gnus/shr.el (autoload 'shr-insert-document "shr" "\ @@ -25114,8 +25218,8 @@ Turning on Sieve mode runs `sieve-mode-hook'. ;;;*** -;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -25164,7 +25268,7 @@ with no arguments, if that value is non-nil. ;;;*** ;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy-new -;;;;;; define-skeleton) "skeleton" "skeleton.el" (19591 62571)) +;;;;;; define-skeleton) "skeleton" "skeleton.el" (19714 43298)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -25274,7 +25378,7 @@ symmetrical ones, and the same character twice for the others. ;;;*** ;;;### (autoloads (smerge-start-session smerge-mode smerge-ediff) -;;;;;; "smerge-mode" "vc/smerge-mode.el" (19591 62571)) +;;;;;; "smerge-mode" "vc/smerge-mode.el" (19714 43298)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -25479,7 +25583,7 @@ Pick your favourite shortcuts: ;;;### (autoloads (reverse-region sort-columns sort-regexp-fields ;;;;;; sort-fields sort-numeric-fields sort-pages sort-paragraphs -;;;;;; sort-lines sort-subr) "sort" "sort.el" (19562 42953)) +;;;;;; sort-lines sort-subr) "sort" "sort.el" (19714 43298)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25623,8 +25727,8 @@ From a program takes two point or marker arguments, BEG and END. ;;;*** -;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19640 -;;;;;; 47194)) +;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25683,7 +25787,7 @@ Spam reports will be queued with the method used when ;;;*** ;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" -;;;;;; "speedbar.el" (19591 62571)) +;;;;;; "speedbar.el" (19714 43298)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25772,7 +25876,7 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix ;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect ;;;;;; sql-mode sql-help sql-add-product-keywords) "sql" "progmodes/sql.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/sql.el (autoload 'sql-add-product-keywords "sql" "\ @@ -26583,7 +26687,7 @@ The variable `tab-width' controls the spacing of tab stops. ;;;;;; table-recognize table-insert-row-column table-insert-column ;;;;;; table-insert-row table-insert table-point-left-cell-hook ;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook) -;;;;;; "table" "textmodes/table.el" (19619 52030)) +;;;;;; "table" "textmodes/table.el" (19714 43298)) ;;; Generated autoloads from textmodes/table.el (defvar table-cell-map-hook nil "\ @@ -27210,7 +27314,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** ;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl" -;;;;;; "progmodes/tcl.el" (19598 13691)) +;;;;;; "progmodes/tcl.el" (19714 43298)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -27241,9 +27345,6 @@ Turning on Tcl mode runs `tcl-mode-hook'. Read the documentation for `tcl-mode-hook' to see what kinds of interesting hook functions already exist. -Commands: -\\{tcl-mode-map} - \(fn)" t nil) (autoload 'inferior-tcl "tcl" "\ @@ -27289,7 +27390,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** ;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -27410,7 +27511,7 @@ tetris-mode keybindings: ;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command ;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp ;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -27712,7 +27813,7 @@ Major mode to edit DocTeX files. ;;;*** ;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer) -;;;;;; "texinfmt" "textmodes/texinfmt.el" (19591 62571)) +;;;;;; "texinfmt" "textmodes/texinfmt.el" (19714 43298)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27752,7 +27853,7 @@ if large. You can use `Info-split' to do this manually. ;;;*** ;;;### (autoloads (texinfo-mode texinfo-close-quote texinfo-open-quote) -;;;;;; "texinfo" "textmodes/texinfo.el" (19598 13691)) +;;;;;; "texinfo" "textmodes/texinfo.el" (19714 43298)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -28125,7 +28226,7 @@ Return a string giving the duration of the Emacs initialization. ;;;;;; time-to-day-in-year date-leap-year-p days-between date-to-day ;;;;;; time-add time-subtract time-since days-to-time time-less-p ;;;;;; seconds-to-time date-to-time) "time-date" "calendar/time-date.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from calendar/time-date.el (autoload 'date-to-time "time-date" "\ @@ -28133,8 +28234,9 @@ Parse a string DATE that represents a date-time and return a time value. If DATE lacks timezone information, GMT is assumed. \(fn DATE)" nil nil) -(if (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) +(if (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time)))) (progn (defalias 'time-to-seconds 'float-time) (make-obsolete 'time-to-seconds 'float-time "21.1")) @@ -28146,7 +28248,7 @@ Convert SECONDS (a floating point number) to a time value. \(fn SECONDS)" nil nil) (autoload 'time-less-p "time-date" "\ -Say whether time value T1 is less than time value T2. +Return non-nil if time value T1 is earlier than time value T2. \(fn T1 T2)" nil nil) @@ -28282,7 +28384,7 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out ;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in ;;;;;; timeclock-modeline-display) "timeclock" "calendar/timeclock.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from calendar/timeclock.el (autoload 'timeclock-modeline-display "timeclock" "\ @@ -28505,7 +28607,7 @@ Show TODO list. ;;;### (autoloads (tool-bar-local-item-from-menu tool-bar-add-item-from-menu ;;;;;; tool-bar-local-item tool-bar-add-item toggle-tool-bar-mode-from-frame) -;;;;;; "tool-bar" "tool-bar.el" (19619 52030)) +;;;;;; "tool-bar" "tool-bar.el" (19714 43298)) ;;; Generated autoloads from tool-bar.el (autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\ @@ -28576,7 +28678,7 @@ holds a keymap. ;;;*** ;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from emulation/tpu-edt.el (defvar tpu-edt-mode nil "\ @@ -28688,7 +28790,7 @@ BUFFER defaults to `trace-buffer'. ;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion ;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers ;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp" -;;;;;; "net/tramp.el" (19640 47194)) +;;;;;; "net/tramp.el" (19714 43298)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28826,7 +28928,7 @@ Discard Tramp from loading remote files. ;;;*** ;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el" -;;;;;; (19619 52030)) +;;;;;; (19714 43298)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ @@ -28924,7 +29026,7 @@ First column's text sSs Second column's text ;;;;;; type-break type-break-mode type-break-keystroke-threshold ;;;;;; type-break-good-break-interval type-break-good-rest-interval ;;;;;; type-break-interval type-break-mode) "type-break" "type-break.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -29230,8 +29332,8 @@ Convert old-style Rmail Babyl file FILE to system inbox format file TO-FILE. ;;;*** -;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -29375,8 +29477,8 @@ Not documented ;;;*** -;;;### (autoloads (url-file) "url-file" "url/url-file.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (url-file) "url-file" "url/url-file.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -29923,7 +30025,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers ;;;;;; vc-revision-other-window vc-root-diff vc-diff vc-version-diff ;;;;;; vc-register vc-next-action vc-before-checkin-hook vc-checkin-hook -;;;;;; vc-checkout-hook) "vc" "vc/vc.el" (19640 47194)) +;;;;;; vc-checkout-hook) "vc" "vc/vc.el" (19714 43298)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -30036,13 +30138,17 @@ the variable `vc-BACKEND-header'. \(fn)" t nil) (autoload 'vc-merge "vc" "\ -Merge changes between two revisions into the current buffer's file. -This asks for two revisions to merge from in the minibuffer. If the -first revision is a branch number, then merge all changes from that -branch. If the first revision is empty, merge news, i.e. recent changes -from the current branch. +Perform a version control merge operation. +On a distributed version control system, this runs a \"merge\" +operation to incorporate changes from another branch onto the +current branch, prompting for an argument list. -See Info node `Merging'. +On a non-distributed version control system, this merges changes +between two revisions into the current fileset. This asks for +two revisions to merge from in the minibuffer. If the first +revision is a branch number, then merge all changes from that +branch. If the first revision is empty, merge the most recent +changes from the current branch. \(fn)" t nil) @@ -30114,13 +30220,20 @@ depending on the underlying version-control system. (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") (autoload 'vc-update "vc" "\ -Update the current fileset's files to their tip revisions. -For each one that contains no changes, and is not locked, then this simply -replaces the work file with the latest revision on its branch. If the file -contains changes, and the backend supports merging news, then any recent -changes from the current branch are merged into the working file. +Update the current fileset or branch. +On a distributed version control system, this runs a \"pull\" +operation to update the current branch, prompting for an argument +list if required. Optional prefix ARG forces a prompt. -\(fn)" t nil) +On a non-distributed version control system, update the current +fileset to the tip revisions. For each unchanged and unlocked +file, this simply replaces the work file with the latest revision +on its branch. If the file contains changes, any changes in the +tip revision are merged into the working file. + +\(fn &optional ARG)" t nil) + +(defalias 'vc-pull 'vc-update) (autoload 'vc-switch-backend "vc" "\ Make BACKEND the current version control system for FILE. @@ -30215,7 +30328,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (19598 13691)) +;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (19714 43298)) ;;; Generated autoloads from vc/vc-arch.el (defun vc-arch-registered (file) (if (vc-find-root file "{arch}/=tagging-method") @@ -30225,7 +30338,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (19598 13691)) +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (19714 43298)) ;;; Generated autoloads from vc/vc-bzr.el (defconst vc-bzr-admin-dirname ".bzr" "\ @@ -30240,7 +30353,7 @@ Name of the directory containing Bzr repository status files.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (19640 47194)) +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (19714 43298)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) (when (file-readable-p (expand-file-name @@ -30250,7 +30363,7 @@ Name of the directory containing Bzr repository status files.") ;;;*** -;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (19598 13691)) +;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (19714 43298)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -30309,7 +30422,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (19619 52030)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (19714 43298)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -30327,7 +30440,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (19598 13691)) +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (19714 43298)) ;;; Generated autoloads from vc/vc-mtn.el (defconst vc-mtn-admin-dir "_MTN") @@ -30342,7 +30455,7 @@ case, and the process object in the asynchronous case. ;;;*** ;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -30356,7 +30469,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** ;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el" -;;;;;; (19640 47194)) +;;;;;; (19714 43298)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -30389,7 +30502,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** ;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/vera-mode.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -30447,7 +30560,7 @@ Key bindings: ;;;*** ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30584,7 +30697,7 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" -;;;;;; (19598 13691)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -31631,7 +31744,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** ;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el" -;;;;;; (19562 42953)) +;;;;;; (19714 43298)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -31662,7 +31775,7 @@ and off otherwise. ;;;### (autoloads (whitespace-report-region whitespace-report whitespace-cleanup-region ;;;;;; whitespace-cleanup global-whitespace-toggle-options whitespace-toggle-options ;;;;;; global-whitespace-newline-mode global-whitespace-mode whitespace-newline-mode -;;;;;; whitespace-mode) "whitespace" "whitespace.el" (19598 13691)) +;;;;;; whitespace-mode) "whitespace" "whitespace.el" (19714 43298)) ;;; Generated autoloads from whitespace.el (autoload 'whitespace-mode "whitespace" "\ @@ -32092,8 +32205,8 @@ With arg, turn widget mode on if and only if arg is positive. ;;;*** ;;;### (autoloads (widget-setup widget-insert widget-delete widget-create -;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19640 -;;;;;; 47194)) +;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19714 +;;;;;; 43298)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -32216,7 +32329,7 @@ With arg, turn Winner mode on if and only if arg is positive. ;;;*** ;;;### (autoloads (woman-bookmark-jump woman-find-file woman-dired-find-file -;;;;;; woman woman-locale) "woman" "woman.el" (19619 52030)) +;;;;;; woman woman-locale) "woman" "woman.el" (19714 43298)) ;;; Generated autoloads from woman.el (defvar woman-locale nil "\ @@ -32632,14 +32745,14 @@ Zone out, completely. ;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "facemenu.el" ;;;;;; "faces.el" "files.el" "finder-inf.el" "foldout.el" "font-lock.el" ;;;;;; "format-spec.el" "forms-d2.el" "forms-pass.el" "frame.el" -;;;;;; "fringe.el" "generic-x.el" "gnus/auth-source.el" "gnus/compface.el" -;;;;;; "gnus/gnus-async.el" "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" -;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-dup.el" -;;;;;; "gnus/gnus-eform.el" "gnus/gnus-ems.el" "gnus/gnus-int.el" -;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.el" "gnus/gnus-salt.el" -;;;;;; "gnus/gnus-score.el" "gnus/gnus-setup.el" "gnus/gnus-srvr.el" -;;;;;; "gnus/gnus-topic.el" "gnus/gnus-undo.el" "gnus/gnus-util.el" -;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/ietf-drums.el" +;;;;;; "fringe.el" "generic-x.el" "gnus/auth-source.el" "gnus/color.el" +;;;;;; "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el" +;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cus.el" "gnus/gnus-demon.el" +;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-ems.el" +;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el" +;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-setup.el" +;;;;;; "gnus/gnus-srvr.el" "gnus/gnus-topic.el" "gnus/gnus-undo.el" +;;;;;; "gnus/gnus-util.el" "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/ietf-drums.el" ;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el" "gnus/mail-prsvr.el" ;;;;;; "gnus/mail-source.el" "gnus/mailcap.el" "gnus/messcompat.el" ;;;;;; "gnus/mm-bodies.el" "gnus/mm-decode.el" "gnus/mm-encode.el" @@ -32651,9 +32764,9 @@ Zone out, completely. ;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el" ;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" ;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el" -;;;;;; "gnus/rfc2231.el" "gnus/sieve-manage.el" "gnus/smime.el" -;;;;;; "gnus/spam-stat.el" "gnus/spam-wash.el" "help.el" "hex-util.el" -;;;;;; "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" +;;;;;; "gnus/rfc2231.el" "gnus/rtree.el" "gnus/shr-color.el" "gnus/sieve-manage.el" +;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "help.el" +;;;;;; "hex-util.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" ;;;;;; "international/charprop.el" "international/cp51932.el" "international/eucjp-ms.el" ;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.el" ;;;;;; "international/ja-dic-utl.el" "international/mule-conf.el" @@ -32702,17 +32815,19 @@ Zone out, completely. ;;;;;; "nxml/rng-maint.el" "nxml/rng-match.el" "nxml/rng-parse.el" ;;;;;; "nxml/rng-pttrn.el" "nxml/rng-uri.el" "nxml/rng-util.el" ;;;;;; "nxml/xsd-regexp.el" "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el" -;;;;;; "org/ob-clojure.el" "org/ob-comint.el" "org/ob-css.el" "org/ob-ditaa.el" -;;;;;; "org/ob-dot.el" "org/ob-emacs-lisp.el" "org/ob-eval.el" "org/ob-exp.el" -;;;;;; "org/ob-gnuplot.el" "org/ob-haskell.el" "org/ob-latex.el" +;;;;;; "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" "org/ob-css.el" +;;;;;; "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el" +;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-gnuplot.el" "org/ob-haskell.el" +;;;;;; "org/ob-js.el" "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lisp.el" ;;;;;; "org/ob-matlab.el" "org/ob-mscgen.el" "org/ob-ocaml.el" "org/ob-octave.el" -;;;;;; "org/ob-perl.el" "org/ob-python.el" "org/ob-ref.el" "org/ob-ruby.el" -;;;;;; "org/ob-sass.el" "org/ob-screen.el" "org/ob-sh.el" "org/ob-sql.el" -;;;;;; "org/ob-sqlite.el" "org/ob-table.el" "org/org-beamer.el" -;;;;;; "org/org-bibtex.el" "org/org-colview.el" "org/org-compat.el" -;;;;;; "org/org-crypt.el" "org/org-ctags.el" "org/org-docview.el" -;;;;;; "org/org-entities.el" "org/org-exp-blocks.el" "org/org-faces.el" -;;;;;; "org/org-gnus.el" "org/org-habit.el" "org/org-info.el" "org/org-inlinetask.el" +;;;;;; "org/ob-org.el" "org/ob-perl.el" "org/ob-plantuml.el" "org/ob-python.el" +;;;;;; "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" "org/ob-scheme.el" +;;;;;; "org/ob-screen.el" "org/ob-sh.el" "org/ob-sql.el" "org/ob-sqlite.el" +;;;;;; "org/ob-table.el" "org/org-beamer.el" "org/org-bibtex.el" +;;;;;; "org/org-colview.el" "org/org-compat.el" "org/org-crypt.el" +;;;;;; "org/org-ctags.el" "org/org-docview.el" "org/org-entities.el" +;;;;;; "org/org-exp-blocks.el" "org/org-faces.el" "org/org-gnus.el" +;;;;;; "org/org-habit.el" "org/org-info.el" "org/org-inlinetask.el" ;;;;;; "org/org-install.el" "org/org-jsinfo.el" "org/org-list.el" ;;;;;; "org/org-mac-message.el" "org/org-macs.el" "org/org-mew.el" ;;;;;; "org/org-mhe.el" "org/org-mks.el" "org/org-mouse.el" "org/org-protocol.el" @@ -32734,8 +32849,7 @@ Zone out, completely. ;;;;;; "textmodes/page.el" "textmodes/paragraphs.el" "textmodes/refbib.el" ;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el" ;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" -;;;;;; "textmodes/texnfo-upd.el" "textmodes/text-mode.el" "themes/tango-dark-theme.el" -;;;;;; "themes/tango-theme.el" "themes/wheatgrass-theme.el" "timezone.el" +;;;;;; "textmodes/texnfo-upd.el" "textmodes/text-mode.el" "timezone.el" ;;;;;; "tooltip.el" "tree-widget.el" "uniquify.el" "url/url-about.el" ;;;;;; "url/url-cookie.el" "url/url-dired.el" "url/url-expand.el" ;;;;;; "url/url-ftp.el" "url/url-history.el" "url/url-imap.el" "url/url-methods.el" @@ -32744,7 +32858,7 @@ Zone out, completely. ;;;;;; "vc/ediff-vers.el" "vc/ediff-wind.el" "vc/pcvs-info.el" "vc/pcvs-parse.el" ;;;;;; "vc/pcvs-util.el" "vc/vc-dav.el" "vcursor.el" "version.el" ;;;;;; "vt-control.el" "vt100-led.el" "w32-fns.el" "w32-vars.el" -;;;;;; "widget.el" "x-dnd.el") (19640 50567 802767)) +;;;;;; "widget.el" "x-dnd.el") (19714 43806 445397)) ;;;*** diff --git a/lisp/loadup.el b/lisp/loadup.el index 7757a0e5b40..d13e38c0b36 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -234,15 +234,14 @@ (load "disp-table"))) ; needed to setup ibm-pc char set, see internal.el (if (featurep 'ns) (progn - (load "emacs-lisp/easymenu") ;; for platform-related menu adjustments + (load "term/common-win") (load "term/ns-win"))) (if (fboundp 'x-create-frame) ;; Do it after loading term/foo-win.el since the value of the ;; mouse-wheel-*-event vars depends on those files being loaded or not. (load "mwheel")) -(if (fboundp 'atan) ; preload some constants and - (progn ; floating pt. functions if we have float support. - (load "emacs-lisp/float-sup"))) +;; Preload some constants and floating point functions. +(load "emacs-lisp/float-sup") (load "vc/vc-hooks") (load "vc/ediff-hook") @@ -403,5 +402,4 @@ ;; no-update-autoloads: t ;; End: -;; arch-tag: 121e1dd4-36e1-45ac-860e-239f577a6335 ;;; loadup.el ends here diff --git a/lisp/locate.el b/lisp/locate.el index f1983a3e18a..4c4312b9598 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -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) ;; )) ;; @@ -145,6 +145,11 @@ the version.)" :type 'string :group 'locate) +(defcustom locate-post-command-hook nil + "List of hook functions run after `locate' (see `run-hooks')." + :type 'hook + :group 'locate) + (defvar locate-history-list nil "The history list used by the \\[locate] command.") @@ -226,6 +231,11 @@ that is, with a prefix arg, you get the default behavior." :group 'locate :type 'boolean) +(defcustom locate-mode-hook nil + "List of hook functions run by `locate-mode' (see `run-mode-hooks')." + :type 'hook + :group 'locate) + ;; Functions (defun locate-default-make-command-line (search-string) @@ -270,7 +280,7 @@ that is, with a prefix arg, you get the default behavior." (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 +296,8 @@ the variables `locate-command' or `locate-make-command-line'. 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 +311,7 @@ ARG is the interactive prefix arg." (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 +333,13 @@ ARG is the interactive prefix arg." (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 +454,7 @@ file name or is inside a subdirectory." \\<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. @@ -473,9 +481,9 @@ do not work in subdirectories. (make-local-variable 'directory-listing-before-filename-regexp) ;; This should support both Unix and Windoze style names (setq directory-listing-before-filename-regexp - (concat "^." + (concat "^.\\(" (make-string (1- locate-filename-indentation) ?\s) - "\\(/\\|[A-Za-z]:\\)\\|" + "\\)\\|" (default-value 'directory-listing-before-filename-regexp))) (make-local-variable 'dired-actual-switches) (setq dired-actual-switches "") @@ -687,5 +695,4 @@ the database on the command line." (provide 'locate) -;; arch-tag: 60c4d098-b5d5-4b3c-a3e0-51a2e9f43898 ;;; locate.el ends here diff --git a/lisp/lpr.el b/lisp/lpr.el index 559dc5513ae..3b91172a7ef 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -152,7 +152,9 @@ The variable `lpr-page-header-program' specifies the program to use." "Print buffer contents without pagination or page headers. See the variables `lpr-switches' and `lpr-command' for customization of the printer command." - (interactive) + (interactive + (unless (y-or-n-p "Send current buffer to default printer? ") + (error "Cancelled"))) (print-region-1 (point-min) (point-max) lpr-switches nil)) ;;;###autoload @@ -169,7 +171,9 @@ in the print command itself; we expect them to request pagination. See the variables `lpr-switches' and `lpr-command' for further customization of the printer command." - (interactive) + (interactive + (unless (y-or-n-p "Send current buffer to default printer? ") + (error "Cancelled"))) (print-region-1 (point-min) (point-max) lpr-switches t)) ;;;###autoload @@ -177,7 +181,10 @@ for further customization of the printer command." "Print region contents without pagination or page headers. See the variables `lpr-switches' and `lpr-command' for customization of the printer command." - (interactive "r") + (interactive + (if (y-or-n-p "Send selected text to default printer? ") + (list (region-beginning) (region-end)) + (error "Cancelled"))) (print-region-1 start end lpr-switches nil)) ;;;###autoload @@ -194,7 +201,10 @@ in the print command itself; we expect them to request pagination. See the variables `lpr-switches' and `lpr-command' for further customization of the printer command." - (interactive "r") + (interactive + (if (y-or-n-p "Send selected text to default printer? ") + (list (region-beginning) (region-end)) + (error "Cancelled"))) (print-region-1 start end lpr-switches t)) (defun print-region-1 (start end switches page-headers) diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index f19143228c5..58ed6685dc2 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -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,28 +70,51 @@ :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) +;; Only made an obsolete alias in 23.3. Before that, the initial +;; value was set according to: +;; (or (memq ls-lisp-emulation '(MS-Windows MacOS)) +;; (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case)) +;; Which isn't the right thing to do. +(define-obsolete-variable-alias 'ls-lisp-dired-ignore-case + 'ls-lisp-ignore-case "21.1") + (defcustom ls-lisp-ignore-case - ;; Name change for consistency with other option names. - (or (memq ls-lisp-emulation '(MS-Windows MacOS)) - (and (boundp 'ls-lisp-dired-ignore-case) ls-lisp-dired-ignore-case)) + (memq ls-lisp-emulation '(MS-Windows MacOS)) "Non-nil causes ls-lisp alphabetic sorting to ignore case." + :set-after '(ls-lisp-emulation) :type 'boolean :group 'ls-lisp) @@ -99,6 +122,7 @@ option will have no effect until you restart Emacs." "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 +138,15 @@ It should contain none or more of the symbols: links, uid, gid. 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 +182,7 @@ regardless of whether the locale can be determined. 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 +193,11 @@ current year. The OLD-TIME-FORMAT is used for older files. To use ISO :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 +245,8 @@ The Lisp emulation does not run any external programs or shells. It 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 +327,6 @@ not contain `d', so that a full listing is expected." (if (memq ?n switches) 'integer 'string))) - (now (current-time)) (sum 0) (max-uid-len 0) (max-gid-len 0) @@ -372,7 +397,7 @@ not contain `d', so that a full listing is expected." 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 +436,7 @@ not contain `d', so that a full listing is expected." (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 +510,8 @@ SWITCHES is a list of characters. Default sorting is alphabetic." (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 +609,10 @@ FOLLOWED by null and full filename, SOLELY for full alpha sort." (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 +670,7 @@ SWITCHES, TIME-INDEX and NOW give the full switch list and time data." 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 +688,13 @@ Return nil if no time switch found." ((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 +737,4 @@ All ls time options, namely c, t and u, are handled." (provide 'ls-lisp) -;; arch-tag: e55f399b-05ec-425c-a6d5-f5e349c35ab4 ;;; ls-lisp.el ends here diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index d84e60fb604..e6da4746041 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -58,6 +58,9 @@ ;; User options end here. +(defvar report-emacs-bug-tracker-url "http://debbugs.gnu.org/cgi/" + "Base URL of the GNU bugtracker. +Used for querying duplicates and linking to existing bugs.") (defvar report-emacs-bug-orig-text nil "The automatically-created initial text of the bug report.") @@ -120,7 +123,6 @@ (concat "mailto:" to)) (error "Subject, To or body not found"))))) - ;;;###autoload (defun report-emacs-bug (topic &optional recent-keys) "Report a bug in GNU Emacs. @@ -277,16 +279,11 @@ usually do not have translators to read other languages for them.\n\n") (if can-xdg-email (define-key (current-local-map) "\C-cm" 'report-emacs-bug-insert-to-mailer)) - ;; Could test major-mode instead. - (cond ((memq mail-user-agent '(message-user-agent gnus-user-agent)) - (setq report-emacs-bug-send-command "message-send-and-exit" - report-emacs-bug-send-hook 'message-send-hook)) - ((eq mail-user-agent 'sendmail-user-agent) - (setq report-emacs-bug-send-command "mail-send-and-exit" - report-emacs-bug-send-hook 'mail-send-hook)) - ((eq mail-user-agent 'mh-e-user-agent) - (setq report-emacs-bug-send-command "mh-send-letter" - report-emacs-bug-send-hook 'mh-before-send-letter-hook))) + (setq report-emacs-bug-send-command (get mail-user-agent 'sendfunc) + report-emacs-bug-send-hook (get mail-user-agent 'hookvar)) + (if report-emacs-bug-send-command + (setq report-emacs-bug-send-command + (symbol-name report-emacs-bug-send-command))) (unless report-emacs-bug-no-explanations (with-output-to-temp-buffer "*Bug Help*" (princ "While in the mail buffer:\n\n") @@ -375,6 +372,90 @@ and send the mail again%s." 'field 'emacsbug-prompt)) (delete-region pos (field-end (1+ pos))))))) + +;; Querying the bug database + +(defvar report-emacs-bug-bug-alist nil) +(make-variable-buffer-local 'report-emacs-bug-bug-alist) +(defvar report-emacs-bug-choice-widget nil) +(make-variable-buffer-local 'report-emacs-bug-choice-widget) + +(defun report-emacs-bug-create-existing-bugs-buffer (bugs keywords) + (switch-to-buffer (get-buffer-create "*Existing Emacs Bugs*")) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (setq report-emacs-bug-bug-alist bugs) + (widget-insert (propertize (concat "Already known bugs (" + keywords "):\n\n") + 'face 'bold)) + (if bugs + (setq report-emacs-bug-choice-widget + (apply 'widget-create 'radio-button-choice + :value (caar bugs) + (let (items) + (dolist (bug bugs) + (push (list + 'url-link + :format (concat "Bug#" (number-to-string (nth 2 bug)) + ": " (cadr bug) "\n %[%v%]\n") + ;; FIXME: Why is only the link of the + ;; active item clickable? + (car bug)) + items)) + (nreverse items)))) + (widget-insert "No bugs maching your keywords found.\n")) + (widget-insert "\n") + (widget-create 'push-button + :notify (lambda (&rest ignore) + ;; TODO: Do something! + (message "Reporting new bug!")) + "Report new bug") + (when bugs + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (let ((val (widget-value report-emacs-bug-choice-widget))) + ;; TODO: Do something! + (message "Appending to bug %s!" + (nth 2 (assoc val report-emacs-bug-bug-alist))))) + "Append to chosen bug")) + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-buffer)) + "Quit reporting bug") + (widget-insert "\n")) + (use-local-map widget-keymap) + (widget-setup) + (goto-char (point-min))) + +(defun report-emacs-bug-parse-query-results (status keywords) + (goto-char (point-min)) + (let (buglist) + (while (re-search-forward "<a href=\"bugreport\\.cgi\\?bug=\\([[:digit:]]+\\)\">\\([^<]+\\)</a>" nil t) + (let ((number (match-string 1)) + (subject (match-string 2))) + (when (not (string-match "^#" subject)) + (push (list + ;; first the bug URL + (concat report-emacs-bug-tracker-url + "bugreport.cgi?bug=" number) + ;; then the subject and number + subject (string-to-number number)) + buglist)))) + (report-emacs-bug-create-existing-bugs-buffer (nreverse buglist) keywords))) + +(defun report-emacs-bug-query-existing-bugs (keywords) + "Query for KEYWORDS at `report-emacs-bug-tracker-url', and return the result. +The result is an alist with items of the form (URL SUBJECT NO)." + (interactive "sBug keywords (comma separated): ") + (url-retrieve (concat report-emacs-bug-tracker-url + "pkgreport.cgi?include=subject%3A" + (replace-regexp-in-string "[[:space:]]+" "+" keywords) + ";package=emacs") + 'report-emacs-bug-parse-query-results (list keywords))) + (provide 'emacsbug) ;;; emacsbug.el ends here diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 342d735c939..9b958e41b05 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1,7 +1,8 @@ ;;; mail-extr.el --- extract full name and address from RFC 822 mail header -*- coding: utf-8 -*- ;; Copyright (C) 1991, 1992, 1993, 1994, 1997, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Joe Wells <jbw@cs.bu.edu> ;; Maintainer: FSF @@ -691,8 +692,8 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL ;; (defvar disable-initial-guessing-flag) ; dynamic assignment -(defvar cbeg) ; dynamic assignment -(defvar cend) ; dynamic assignment +(defvar mailextr-cbeg) ; dynamic assignment +(defvar mailextr-cend) ; dynamic assignment (defvar mail-extr-all-top-level-domains) ; Defined below. ;;;###autoload @@ -762,7 +763,8 @@ consing a string.)" record-pos-symbol first-real-pos last-real-pos phrase-beg phrase-end - cbeg cend ; dynamically set from -voodoo + ;; Dynamically set in mail-extr-voodoo. + mailextr-cbeg mailextr-cend quote-beg quote-end atom-beg atom-end mbox-beg mbox-end @@ -796,19 +798,19 @@ consing a string.)" ((eq char ?\() (set-syntax-table mail-extr-address-comment-syntax-table) ;; only record the first non-empty comment's position - (if (and (not cbeg) + (if (and (not mailextr-cbeg) (save-excursion (forward-char 1) (mail-extr-skip-whitespace-forward) (not (eq ?\) (char-after (point)))))) - (setq cbeg (point))) + (setq mailextr-cbeg (point))) ;; TODO: don't record if unbalanced (or (mail-extr-safe-move-sexp 1) (forward-char 1)) (set-syntax-table mail-extr-address-syntax-table) - (if (and cbeg - (not cend)) - (setq cend (point)))) + (if (and mailextr-cbeg + (not mailextr-cend)) + (setq mailextr-cend (point)))) ;; quoted text ((eq char ?\") ;; only record the first non-empty quote's position @@ -994,10 +996,10 @@ consing a string.)" (> last-real-pos (1+ group-\;-pos)) (setq last-real-pos (1+ group-\;-pos))) ;; *** This may be wrong: - (and cend - (> cend group-\;-pos) - (setq cend nil - cbeg nil)) + (and mailextr-cend + (> mailextr-cend group-\;-pos) + (setq mailextr-cend nil + mailextr-cbeg nil)) (and quote-end (> quote-end group-\;-pos) (setq quote-end nil @@ -1228,8 +1230,8 @@ consing a string.)" (narrow-to-region phrase-beg phrase-end)) ;; Example: fml@foo.bar.dom (First M. Last) - (cbeg - (narrow-to-region (1+ cbeg) (1- cend)) + (mailextr-cbeg + (narrow-to-region (1+ mailextr-cbeg) (1- mailextr-cend)) (mail-extr-undo-backslash-quoting (point-min) (point-max)) ;; Deal with spacing problems @@ -1472,7 +1474,6 @@ place. It affects how `mail-extract-address-components' works." (case-fold-search nil) mixed-case-flag lower-case-flag ;;upper-case-flag suffix-flag last-name-comma-flag - ;;cbeg cend initial begin-again-flag drop-this-word-if-trailing-flag @@ -1618,7 +1619,7 @@ place. It affects how `mail-extract-address-components' works." ;; Delete parenthesized/quoted comment/nickname ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) - (setq cbeg (point)) + (setq mailextr-cbeg (point)) (set-syntax-table mail-extr-address-text-comment-syntax-table) (cond ((memq (following-char) '(?\' ?\`)) (or (search-forward "'" nil t @@ -1628,23 +1629,23 @@ place. It affects how `mail-extract-address-components' works." (or (mail-extr-safe-move-sexp 1) (goto-char (point-max))))) (set-syntax-table mail-extr-address-text-syntax-table) - (setq cend (point)) + (setq mailextr-cend (point)) (cond ;; Handle case of entire name being quoted ((and (eq word-count 0) (looking-at " *\\'") - (>= (- cend cbeg) 2)) - (narrow-to-region (1+ cbeg) (1- cend)) + (>= (- mailextr-cend mailextr-cbeg) 2)) + (narrow-to-region (1+ mailextr-cbeg) (1- mailextr-cend)) (goto-char (point-min))) (t ;; Handle case of quoted initial - (if (and (or (= 3 (- cend cbeg)) - (and (= 4 (- cend cbeg)) - (eq ?. (char-after (+ 2 cbeg))))) + (if (and (or (= 3 (- mailextr-cend mailextr-cbeg)) + (and (= 4 (- mailextr-cend mailextr-cbeg)) + (eq ?. (char-after (+ 2 mailextr-cbeg))))) (not (looking-at " *\\'"))) - (setq initial (char-after (1+ cbeg))) + (setq initial (char-after (1+ mailextr-cbeg))) (setq initial nil)) - (delete-region cbeg cend) + (delete-region mailextr-cbeg mailextr-cend) (if initial (insert initial ". "))))) @@ -2174,5 +2175,4 @@ place. It affects how `mail-extract-address-components' works." (provide 'mail-extr) -;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d ;;; mail-extr.el ends here diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el index dd5ec2dd388..2a5d77d4f74 100644 --- a/lisp/mail/mailclient.el +++ b/lisp/mail/mailclient.el @@ -46,6 +46,7 @@ (require 'sendmail) ;; for mail-sendmail-undelimit-header (require 'mail-utils) ;; for mail-fetch-field +(require 'browse-url) (defcustom mailclient-place-body-on-clipboard-flag (fboundp 'w32-set-clipboard-data) @@ -122,7 +123,10 @@ The mail client is taken to be the handler of mailto URLs." (while (and (re-search-forward "\n\n\n*" delimline t) (< (point) delimline)) (replace-match "\n")) - (let ((case-fold-search t)) + (let ((case-fold-search t) + ;; Use the external browser function to send the + ;; message. + (browse-url-mailto-function nil)) ;; initialize limiter (setq mailclient-delim-static "?") ;; construct and call up mailto URL diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el index 960d3c65487..939e499a024 100644 --- a/lisp/mail/mailheader.el +++ b/lisp/mail/mailheader.el @@ -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 @@ value." (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 @@ A key of nil has as its value a list of defaulted headers to ignore." (provide 'mailheader) -;; arch-tag: 6e7aa221-80b5-4b3d-b46f-fd66ab567be0 ;;; mailheader.el ends here diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index 1a397db7a0d..3ca0750aaf6 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -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> @@ -181,7 +181,8 @@ your primary spool is. If this fails, set it to something like (define-key map "q" 'mspools-quit) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) - (define-key map "g" 'revert-buffer)) + (define-key map "g" 'revert-buffer) + map) "Keymap for the *spools* buffer.") ;;; Code @@ -279,10 +280,7 @@ Buffer is not displayed if SHOW is non-nil." )) (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 @@ -322,11 +320,7 @@ Buffer is not displayed if SHOW is non-nil." (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 @@ -410,5 +404,4 @@ nil." (provide 'mspools) -;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6 ;;; mspools.el ends here diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el index f04cf3fc466..0c91fcd8394 100644 --- a/lisp/mail/rfc2368.el +++ b/lisp/mail/rfc2368.el @@ -92,13 +92,11 @@ Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. & -> &), before calling this function." (let ((case-fold-search t) prequery query headers-alist) - + (setq mailto-url (replace-regexp-in-string "\n" " " mailto-url)) (if (string-match rfc2368-mailto-regexp mailto-url) (progn - (setq prequery (match-string rfc2368-mailto-prequery-index mailto-url)) - (setq query (match-string rfc2368-mailto-query-index mailto-url)) @@ -131,10 +129,8 @@ calling this function." headers-alist) - (error "Failed to match a mailto: url")) - )) + (error "Failed to match a mailto: url")))) (provide 'rfc2368) -;; arch-tag: ea804934-ad96-4f69-957b-857a76e4fd95 ;;; rfc2368.el ends here diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 47e52f27aa1..ffb52683bd7 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -39,6 +39,7 @@ ;; (require 'mail-utils) +(require 'rfc2047) (defconst rmail-attribute-header "X-RMAIL-ATTRIBUTES" "The header that stores the Rmail attribute data.") @@ -638,7 +639,7 @@ Element N specifies the summary line for message N+1.") This is set to nil by default.") -(defcustom rmail-enable-mime nil +(defcustom rmail-enable-mime t "If non-nil, RMAIL uses MIME features. If the value is t, RMAIL automatically shows MIME decoded message. If the value is neither t nor nil, RMAIL does not show MIME decoded message @@ -649,6 +650,7 @@ unless the feature specified by `rmail-mime-feature' is available." :type '(choice (const :tag "on" t) (const :tag "off" nil) (other :tag "when asked" ask)) + :version "23.3" :group 'rmail) (defvar rmail-enable-mime-composing nil @@ -693,13 +695,12 @@ start of the header) with three arguments MSG, REGEXP, and LIMIT, where MSG is the message number, REGEXP is the regular expression, LIMIT is the position specifying the end of header.") -(defvar rmail-mime-feature 'rmail-mime +(defvar rmail-mime-feature 'rmailmm "Feature to require to load MIME support in Rmail. When starting Rmail, if `rmail-enable-mime' is non-nil, this feature is required with `require'. -The default value is `rmail-mime'. This feature is provided by -the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.") +The default value is `rmailmm'") ;; FIXME this is unused. (defvar rmail-decode-mime-charset t @@ -1509,17 +1510,9 @@ Hook `rmail-quit-hook' is run after expunging." (set-buffer-modified-p nil)) (replace-buffer-in-windows rmail-summary-buffer) (bury-buffer rmail-summary-buffer)) - (if rmail-enable-mime - (let ((obuf rmail-buffer) - (ovbuf rmail-view-buffer)) - (set-buffer rmail-view-buffer) - (quit-window) - (replace-buffer-in-windows ovbuf) - (replace-buffer-in-windows obuf) - (bury-buffer obuf)) - (let ((obuf (current-buffer))) - (quit-window) - (replace-buffer-in-windows obuf)))) + (let ((obuf (current-buffer))) + (quit-window) + (replace-buffer-in-windows obuf))) (defun rmail-bury () "Bury current Rmail buffer and its summary buffer." @@ -2219,15 +2212,7 @@ If nil, that means the current message." (let ((blurb (rmail-get-labels))) (setq mode-line-process (format " %d/%d%s" - rmail-current-message rmail-total-messages blurb)) - ;; If rmail-enable-mime is non-nil, we may have to update - ;; `mode-line-process' of rmail-view-buffer too. - (if (and rmail-enable-mime - (not (eq (current-buffer) rmail-view-buffer)) - (buffer-live-p rmail-view-buffer)) - (let ((mlp mode-line-process)) - (with-current-buffer rmail-view-buffer - (setq mode-line-process mlp)))))) + rmail-current-message rmail-total-messages blurb)))) (defun rmail-get-attr-value (attr state) "Return the character value for ATTR. @@ -2706,6 +2691,11 @@ The current mail message becomes the message displayed." (message "Showing message %d" msg)) (narrow-to-region beg end) (goto-char beg) + (if (and rmail-enable-mime + (re-search-forward "mime-version: 1.0" nil t)) + (let ((rmail-buffer mbox-buf) + (rmail-view-buffer view-buf)) + (funcall rmail-show-mime-function)) (setq body-start (search-forward "\n\n" nil t)) (narrow-to-region beg (point)) (goto-char beg) @@ -2722,11 +2712,6 @@ The current mail message becomes the message displayed." ;; unibyte temporary buffer where the character decoding takes ;; place. (with-current-buffer rmail-view-buffer - ;; We give the view buffer a buffer-local value of - ;; rmail-header-style based on the binding in effect when - ;; this function is called; `rmail-toggle-headers' can - ;; inspect this value to determine how to toggle. - (set (make-local-variable 'rmail-header-style) header-style) (erase-buffer)) (if (null character-coding) ;; Do it directly since that is fast. @@ -2749,8 +2734,13 @@ The current mail message becomes the message displayed." (error "uuencoded messages are not supported yet")) (t)) (rmail-decode-region (point-min) (point-max) - coding-system view-buf))) + coding-system view-buf)))) (with-current-buffer rmail-view-buffer + ;; We give the view buffer a buffer-local value of + ;; rmail-header-style based on the binding in effect when + ;; this function is called; `rmail-toggle-headers' can + ;; inspect this value to determine how to toggle. + (set (make-local-variable 'rmail-header-style) header-style) ;; Unquote quoted From lines (goto-char (point-min)) (while (re-search-forward "^>+From " nil t) @@ -2766,6 +2756,10 @@ The current mail message becomes the message displayed." (with-current-buffer rmail-view-buffer (insert "\n") (goto-char (point-min)) + ;; Decode the headers according to RFC2047. + (save-excursion + (search-forward "\n\n" nil 'move) + (rfc2047-decode-region (point-min) (point))) (rmail-highlight-headers) ;(rmail-activate-urls) ;(rmail-process-quoted-material) @@ -4295,7 +4289,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "9f67f3b67de9b700b128b73c52abfefa") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "ec0bed149baed671125f623e5b012f6f") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ @@ -4386,7 +4380,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "4715fb58fb191bf6b192458ea75524b2") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "666a5db1021cdcba6e68a18a553d65f1") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 3882c9e47c8..918d2dfc365 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -27,17 +27,57 @@ ;; Essentially based on the design of Alexander Pohoyda's MIME ;; extensions (mime-display.el and mime.el). -;; Call `M-x rmail-mime' when viewing an Rmail message. + +;; This file provides two operation modes for viewing a MIME message. + +;; (1) When rmail-enable-mime is non-nil (now it is the default), the +;; function `rmail-show-mime' is automatically called. That function +;; shows a MIME message directly in RMAIL's view buffer. + +;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x +;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*". + +;; Both operations share the intermediate functions rmail-mime-process +;; and rmail-mime-process-multipart as below. + +;; rmail-show-mime +;; +- rmail-mime-parse +;; | +- rmail-mime-process <--+------------+ +;; | | +---------+ | +;; | + rmail-mime-process-multipart --+ +;; | +;; + rmail-mime-insert <----------------+ +;; +- rmail-mime-insert-text | +;; +- rmail-mime-insert-bulk | +;; +- rmail-mime-insert-multipart --+ +;; +;; rmail-mime +;; +- rmail-mime-show <----------------------------------+ +;; +- rmail-mime-process | +;; +- rmail-mime-handle | +;; +- rmail-mime-text-handler | +;; +- rmail-mime-bulk-handler | +;; | + rmail-mime-insert-bulk +;; +- rmail-mime-multipart-handler | +;; +- rmail-mime-process-multipart --+ + +;; In addition, for the case of rmail-enable-mime being non-nil, this +;; file provides two functions rmail-insert-mime-forwarded-message and +;; rmail-insert-mime-resent-message for composing forwarded and resent +;; messages respectively. ;; Todo: -;; Handle multipart/alternative. +;; Make rmail-mime-media-type-handlers-alist usable in the first +;; operation mode. +;; Handle multipart/alternative in the second operation mode. ;; Offer the option to call external/internal viewers (doc-view, xpdf, etc). ;;; Code: (require 'rmail) (require 'mail-parse) +(require 'message) ;;; User options. @@ -91,6 +131,52 @@ automatically display the image in the buffer." ;;; End of user options. +;;; MIME-entity object + +(defun rmail-mime-entity (type disposition transfer-encoding + header body children) + "Retrun a newly created MIME-entity object. + +A MIME-entity is a vector of 6 elements: + + [ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ] + +TYPE and DISPOSITION correspond to MIME headers Content-Type: and +Cotent-Disposition: respectively, and has this format: + + \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) + +VALUE is a string and ATTRIBUTE is a symbol. + +Consider the following header, for example: + +Content-Type: multipart/mixed; + boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\" + +The corresponding TYPE argument must be: + +\(\"multipart/mixed\" + \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\")) + +TRANSFER-ENCODING corresponds to MIME header +Content-Transfer-Encoding, and is a lowercased string. + +HEADER and BODY are a cons (BEG . END), where BEG and END specify +the region of the corresponding part in RMAIL's data (mbox) +buffer. BODY may be nil. In that case, the current buffer is +narrowed to the body part. + +CHILDREN is a list of MIME-entities for a \"multipart\" entity, and +nil for the other types." + (vector type disposition transfer-encoding header body children)) + +;; Accessors for a MIME-entity object. +(defsubst rmail-mime-entity-type (entity) (aref entity 0)) +(defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) +(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) +(defsubst rmail-mime-entity-header (entity) (aref entity 3)) +(defsubst rmail-mime-entity-body (entity) (aref entity 4)) +(defsubst rmail-mime-entity-children (entity) (aref entity 5)) ;;; Buttons @@ -99,6 +185,7 @@ automatically display the image in the buffer." (let* ((filename (button-get button 'filename)) (directory (button-get button 'directory)) (data (button-get button 'data)) + (mbox-buf rmail-view-buffer) (ofilename filename)) (setq filename (expand-file-name (read-file-name (format "Save as (default: %s): " filename) @@ -117,7 +204,17 @@ automatically display the image in the buffer." ;; file, the magic signature compares equal with the unibyte ;; signature string recorded in jka-compr-compression-info-list. (set-buffer-multibyte nil) - (insert data) + (setq buffer-undo-list t) + (if (stringp data) + (insert data) + ;; DATA is a MIME-entity object. + (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) + (body (rmail-mime-entity-body data))) + (insert-buffer-substring mbox-buf (car body) (cdr body)) + (cond ((string= transfer-encoding "base64") + (ignore-errors (base64-decode-region (point-min) (point-max)))) + ((string= transfer-encoding "quoted-printable") + (quoted-printable-decode-region (point-min) (point-max)))))) (write-region nil nil filename nil nil nil t)))) (define-button-type 'rmail-mime-save 'action 'rmail-mime-save) @@ -134,6 +231,23 @@ automatically display the image in the buffer." (when (coding-system-p coding-system) (decode-coding-region (point-min) (point-max) coding-system)))) +(defun rmail-mime-insert-text (entity) + "Insert MIME-entity ENTITY as a plain text MIME part in the current buffer." + (let* ((content-type (rmail-mime-entity-type entity)) + (charset (cdr (assq 'charset (cdr content-type)))) + (coding-system (if charset (intern (downcase charset)))) + (transfer-encoding (rmail-mime-entity-transfer-encoding entity)) + (body (rmail-mime-entity-body entity))) + (save-restriction + (narrow-to-region (point) (point)) + (insert-buffer-substring rmail-buffer (car body) (cdr body)) + (cond ((string= transfer-encoding "base64") + (ignore-errors (base64-decode-region (point-min) (point-max)))) + ((string= transfer-encoding "quoted-printable") + (quoted-printable-decode-region (point-min) (point-max)))) + (if (coding-system-p coding-system) + (decode-coding-region (point-min) (point-max) coding-system))))) + ;; FIXME move to the test/ directory? (defun test-rmail-mime-handler () "Test of a mail using no MIME parts at all." @@ -152,10 +266,28 @@ MIME-Version: 1.0 (defun rmail-mime-insert-image (type data) - "Insert an image of type TYPE, where DATA is the image data." + "Insert an image of type TYPE, where DATA is the image data. +If DATA is not a string, it is a MIME-entity object." (end-of-line) - (insert ?\n) - (insert-image (create-image data type t))) + (let ((modified (buffer-modified-p))) + (insert ?\n) + (unless (stringp data) + ;; DATA is a MIME-entity. + (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) + (body (rmail-mime-entity-body data)) + (mbox-buffer rmail-view-buffer)) + (with-temp-buffer + (set-buffer-multibyte nil) + (setq buffer-undo-list t) + (insert-buffer-substring mbox-buffer (car body) (cdr body)) + (cond ((string= transfer-encoding "base64") + (ignore-errors (base64-decode-region (point-min) (point-max)))) + ((string= transfer-encoding "quoted-printable") + (quoted-printable-decode-region (point-min) (point-max)))) + (setq data + (buffer-substring-no-properties (point-min) (point-max)))))) + (insert-image (create-image data type t)) + (set-buffer-modified-p modified))) (defun rmail-mime-image (button) "Display the image associated with BUTTON." @@ -172,8 +304,19 @@ MIME-Version: 1.0 "Handle the current buffer as an attachment to download. For images that Emacs is capable of displaying, the behavior depends upon the value of `rmail-mime-show-images'." + (rmail-mime-insert-bulk + (rmail-mime-entity content-type content-disposition content-transfer-encoding + nil nil nil))) + +(defun rmail-mime-insert-bulk (entity) + "Inesrt a MIME-entity ENTITY as an attachment. +The optional second arg DATA, if non-nil, is a string containing +the attachment data that is already decoded." ;; Find the default directory for this media type. - (let* ((directory (catch 'directory + (let* ((content-type (rmail-mime-entity-type entity)) + (content-disposition (rmail-mime-entity-disposition entity)) + (body (rmail-mime-entity-body entity)) + (directory (catch 'directory (dolist (entry rmail-mime-attachment-dirs-alist) (when (string-match (car entry) (car content-type)) (dolist (dir (cdr entry)) @@ -183,17 +326,21 @@ depends upon the value of `rmail-mime-show-images'." (cdr (assq 'filename (cdr content-disposition))) "noname")) (label (format "\nAttached %s file: " (car content-type))) - (data (buffer-string)) - (udata (string-as-unibyte data)) - (size (length udata)) - (osize size) (units '(B kB MB GB)) - type) - (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message + data udata size osize type) + (if body + (setq data entity + udata entity + size (- (cdr body) (car body))) + (setq data (buffer-string) + udata (string-as-unibyte data) + size (length udata)) + (delete-region (point-min) (point-max))) + (setq osize size) + (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message (cdr units)) (setq size (/ size 1024.0) units (cdr units))) - (delete-region (point-min) (point-max)) (insert label) (insert-button filename :type 'rmail-mime-save @@ -249,6 +396,22 @@ The current buffer should be narrowed to the body. CONTENT-TYPE, CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values of the respective parsed headers. See `rmail-mime-handle' for their format." + (rmail-mime-process-multipart + content-type content-disposition content-transfer-encoding nil)) + +(defun rmail-mime-process-multipart (content-type + content-disposition + content-transfer-encoding + parse-only) + "Process the current buffer as a multipart MIME body. + +If PARSE-ONLY is nil, modify the current buffer directly for showing +the MIME body and return nil. + +Otherwise, just parse the current buffer and return a list of +MIME-entity objects. + +The other arguments are the same as `rmail-mime-multipart-handler'." ;; Some MUAs start boundaries with "--", while it should start ;; with "CRLF--", as defined by RFC 2046: ;; The boundary delimiter MUST occur at the beginning of a line, @@ -257,7 +420,7 @@ format." ;; of the preceding part. ;; We currently don't handle that. (let ((boundary (cdr (assq 'boundary content-type))) - beg end next) + beg end next entities) (unless boundary (rmail-mm-get-boundary-error-message "No boundary defined" content-type content-disposition @@ -267,7 +430,9 @@ format." (goto-char (point-min)) (when (and (search-forward boundary nil t) (looking-at "[ \t]*\n")) - (delete-region (point-min) (match-end 0))) + (if parse-only + (narrow-to-region (match-end 0) (point-max)) + (delete-region (point-min) (match-end 0)))) ;; Loop over all body parts, where beg points at the beginning of ;; the part and end points at the end of the part. next points at ;; the beginning of the next part. @@ -285,13 +450,17 @@ format." (rmail-mm-get-boundary-error-message "Malformed boundary" content-type content-disposition content-transfer-encoding))) - (delete-region end next) ;; Handle the part. - (save-restriction - (narrow-to-region beg end) - (rmail-mime-show)) - (goto-char (setq beg next))))) - + (if parse-only + (save-restriction + (narrow-to-region beg end) + (setq entities (cons (rmail-mime-process nil t) entities))) + (delete-region end next) + (save-restriction + (narrow-to-region beg end) + (rmail-mime-show))) + (goto-char (setq beg next))) + (nreverse entities))) (defun test-rmail-mime-multipart-handler () "Test of a mail used as an example in RFC 2046." @@ -394,6 +563,9 @@ called recursively if multiple parts are available. The current buffer must contain a single message. It will be modified." + (rmail-mime-process show-headers nil)) + +(defun rmail-mime-process (show-headers parse-only) (let ((end (point-min)) content-type content-transfer-encoding @@ -437,14 +609,105 @@ modified." ;; attachment according to RFC 2183. (unless (member (car content-disposition) '("inline" "attachment")) (setq content-disposition '("attachment"))) - ;; Hide headers and handle the part. - (save-restriction - (cond ((string= (car content-type) "message/rfc822") - (narrow-to-region end (point-max))) - ((not show-headers) - (delete-region (point-min) end))) - (rmail-mime-handle content-type content-disposition - content-transfer-encoding)))) + + (if parse-only + (cond ((string-match "multipart/.*" (car content-type)) + (setq end (1- end)) + (save-restriction + (let ((header (if show-headers (cons (point-min) end)))) + (narrow-to-region end (point-max)) + (rmail-mime-entity content-type + content-disposition + content-transfer-encoding + header nil + (rmail-mime-process-multipart + content-type content-disposition + content-transfer-encoding t))))) + ((string-match "message/rfc822" (car content-type)) + (or show-headers + (narrow-to-region end (point-max))) + (rmail-mime-process t t)) + (t + (rmail-mime-entity content-type + content-disposition + content-transfer-encoding + nil + (cons end (point-max)) + nil))) + ;; Hide headers and handle the part. + (save-restriction + (cond ((string= (car content-type) "message/rfc822") + (narrow-to-region end (point-max))) + ((not show-headers) + (delete-region (point-min) end))) + (rmail-mime-handle content-type content-disposition + content-transfer-encoding))))) + +(defun rmail-mime-insert-multipart (entity) + "Insert MIME-entity ENTITY of multipart type in the current buffer." + (let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity)) + "/"))) + (disposition (rmail-mime-entity-disposition entity)) + (header (rmail-mime-entity-header entity)) + (children (rmail-mime-entity-children entity))) + (if header + (let ((pos (point))) + (or (bolp) + (insert "\n")) + (insert-buffer-substring rmail-buffer (car header) (cdr header)) + (rfc2047-decode-region pos (point)) + (insert "\n"))) + (cond + ((string= subtype "mixed") + (dolist (child children) + (rmail-mime-insert child '("text/plain") disposition))) + ((string= subtype "digest") + (dolist (child children) + (rmail-mime-insert child '("message/rfc822") disposition))) + ((string= subtype "alternative") + (let (best-plain-text best-text) + (dolist (child children) + (if (string= (or (car (rmail-mime-entity-disposition child)) + (car disposition)) + "inline") + (if (string-match "text/plain" + (car (rmail-mime-entity-type child))) + (setq best-plain-text child) + (if (string-match "text/.*" + (car (rmail-mime-entity-type child))) + (setq best-text child))))) + (if (or best-plain-text best-text) + (rmail-mime-insert (or best-plain-text best-text)) + ;; No child could be handled. Insert all. + (dolist (child children) + (rmail-mime-insert child nil disposition))))) + (t + ;; Unsupported subtype. Insert all of them. + (dolist (child children) + (rmail-mime-insert child)))))) + +(defun rmail-mime-parse () + "Parse the current Rmail message as a MIME message. +The value is a MIME-entiy object (see `rmail-mime-enty-new')." + (save-excursion + (goto-char (point-min)) + (rmail-mime-process nil t))) + +(defun rmail-mime-insert (entity &optional content-type disposition) + "Insert a MIME-entity ENTITY in the current buffer. + +This function will be called recursively if multiple parts are +available." + (if (rmail-mime-entity-children entity) + (rmail-mime-insert-multipart entity) + (setq content-type + (or (rmail-mime-entity-type entity) content-type)) + (setq disposition + (or (rmail-mime-entity-disposition entity) disposition)) + (if (and (string= (car disposition) "inline") + (string-match "text/.*" (car content-type))) + (rmail-mime-insert-text entity) + (rmail-mime-insert-bulk entity)))) (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" "Major mode used in `rmail-mime' buffers." @@ -480,6 +743,50 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." (error "%s; type: %s; disposition: %s; encoding: %s" message type disposition encoding)) +(defun rmail-show-mime () + (let ((mbox-buf rmail-buffer)) + (condition-case nil + (let ((entity (rmail-mime-parse))) + (with-current-buffer rmail-view-buffer + (let ((inhibit-read-only t) + (rmail-buffer mbox-buf)) + (erase-buffer) + (rmail-mime-insert entity)))) + (error + ;; Decoding failed. Insert the original message body as is. + (let ((region (with-current-buffer mbox-buf + (goto-char (point-min)) + (re-search-forward "^$" nil t) + (forward-line 1) + (cons (point) (point-max))))) + (with-current-buffer rmail-view-buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-buffer-substring mbox-buf (car region) (cdr region)))) + (message "MIME decoding failed")))))) + +(setq rmail-show-mime-function 'rmail-show-mime) + +(defun rmail-insert-mime-forwarded-message (forward-buffer) + (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer))) + (save-restriction + (narrow-to-region (point) (point)) + (message-forward-make-body-mime mbox-buf)))) + +(setq rmail-insert-mime-forwarded-message-function + 'rmail-insert-mime-forwarded-message) + +(defun rmail-insert-mime-resent-message (forward-buffer) + (insert-buffer-substring + (with-current-buffer forward-buffer rmail-view-buffer)) + (goto-char (point-min)) + (when (looking-at "From ") + (forward-line 1) + (delete-region (point-min) (point)))) + +(setq rmail-insert-mime-resent-message-function + 'rmail-insert-mime-resent-message) + (provide 'rmailmm) ;; Local Variables: diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 0b8abbca6a5..f1efb33e6cb 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -32,6 +32,7 @@ ;; For rmail-select-summary. (require 'rmail) +(require 'rfc2047) (defcustom rmail-summary-scroll-between-messages t "Non-nil means Rmail summary scroll commands move between messages. @@ -364,13 +365,15 @@ The current buffer contains the unrestricted message collection." (aset rmail-summary-vector (1- msgnum) line)) line)) -(defcustom rmail-summary-line-decoder (function identity) +(defcustom rmail-summary-line-decoder (function rfc2047-decode-string) "Function to decode a Rmail summary line. It receives the summary line for one message as a string and should return the decoded string. -By default, it is `identity', which returns the string unaltered." +By default, it is `rfc2047-decode-string', which decodes MIME-encoded +subject." :type 'function + :version "23.3" :group 'rmail-summary) (defun rmail-create-summary-line (msgnum) @@ -589,10 +592,17 @@ the message being processed." (t (- mch 14)))) (min len (+ lo 25))))))))) (concat (if (re-search-forward "^Subject:" nil t) - (progn (skip-chars-forward " \t") - (buffer-substring (point) - (progn (end-of-line) - (point)))) + (let (pos str) + (skip-chars-forward " \t") + (setq pos (point)) + (forward-line 1) + (setq str (buffer-substring pos (1- (point)))) + (while (looking-at "\\s ") + (setq str (concat str " " + (buffer-substring (match-end 0) + (line-end-position)))) + (forward-line 1)) + str) (re-search-forward "[\n][\n]+" nil t) (buffer-substring (point) (progn (end-of-line) (point)))) "\n"))) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 081e743dcd8..7a9ab601bcc 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -383,15 +383,8 @@ The default value matches citations like `foo-bar>' plus whitespace." map)) (autoload 'build-mail-aliases "mailalias" - "Read mail aliases from user's personal aliases file and set `mail-aliases'." - nil) - -(autoload 'expand-mail-aliases "mailalias" - "Expand all mail aliases in suitable header fields found between BEG and END. -Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants. -Optional second arg EXCLUDE may be a regular expression defining text to be -removed from alias expansions." - nil) + "Read mail aliases from personal aliases file and set `mail-aliases'. +By default, this is the file specified by `mail-personal-alias-file'.") ;;;###autoload (defcustom mail-signature t @@ -718,7 +711,7 @@ Leave point at the start of the delimiter line." "Carry out Auto Fill for Mail mode. If within the headers, this makes the new lines into continuation lines." (if (< (point) (mail-header-end)) - (let ((old-line-start (save-excursion (beginning-of-line) (point)))) + (let ((old-line-start (line-beginning-position))) (if (do-auto-fill) (save-excursion (beginning-of-line) @@ -1149,8 +1142,7 @@ external program defined by `sendmail-program'." ;; 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. @@ -1955,5 +1947,4 @@ you can move to one of them and type C-c C-c to recover that one." (provide 'sendmail) -;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626 ;;; sendmail.el ends here diff --git a/lisp/makesum.el b/lisp/makesum.el index c77a248eb45..4b5cd036f94 100644 --- a/lisp/makesum.el +++ b/lisp/makesum.el @@ -1,7 +1,7 @@ ;;; makesum.el --- generate key binding summary for Emacs -;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help @@ -98,7 +98,7 @@ Previous contents of that buffer are killed first." (forward-line half) (while (< half nlines) (setq half (1+ half)) - (setq line (buffer-substring (point) (save-excursion (end-of-line) (point)))) + (setq line (buffer-substring (point) (line-end-position))) (setq lines (cons line lines)) (delete-region (point) (progn (forward-line 1) (point))))) (setq lines (nreverse lines)) @@ -112,5 +112,4 @@ Previous contents of that buffer are killed first." (provide 'makesum) -;; arch-tag: c2383336-fc89-46ad-8110-ded42bffaee3 ;;; makesum.el ends here diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 0659ae98717..4708c52e12e 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -35,14 +35,33 @@ (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))) (defvar menu-bar-help-menu (make-sparse-keymap "Help")) -;; Force Help item to come last, after the major mode's own items. -;; The symbol used to be called `help', but that gets confused with the -;; help key. -(setq menu-bar-final-items '(help-menu)) +(if (not (featurep 'ns)) + ;; Force Help item to come last, after the major mode's own items. + ;; The symbol used to be called `help', but that gets confused with the + ;; help key. + (setq menu-bar-final-items '(help-menu)) + (if (eq system-type 'darwin) + (setq menu-bar-final-items '(buffer services help-menu)) + (setq menu-bar-final-items '(buffer services hide-app quit)) + ;; Add standard top-level items to GNUstep menu. + (define-key global-map [menu-bar quit] + `(menu-item ,(purecopy "Quit") save-buffers-kill-emacs + :help ,(purecopy "Save unsaved buffers, then exit"))) + (define-key global-map [menu-bar hide-app] + `(menu-item ,(purecopy "Hide") ns-do-hide-emacs + :help ,(purecopy "Hide Emacs")))) + (define-key global-map [menu-bar services] ; set-up in ns-win + (cons (purecopy "Services") (make-sparse-keymap "Services")))) + +;; If running under GNUstep, "Help" is moved and renamed "Info" (see below). +(or (and (featurep 'ns) + (not (eq system-type 'darwin))) + (define-key global-map [menu-bar help-menu] + (cons (purecopy "Help") menu-bar-help-menu))) -(define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu)) (defvar menu-bar-tools-menu (make-sparse-keymap "Tools")) -(define-key global-map [menu-bar tools] (cons (purecopy "Tools") menu-bar-tools-menu)) +(define-key global-map [menu-bar tools] + (cons (purecopy "Tools") menu-bar-tools-menu)) ;; This definition is just to show what this looks like. ;; It gets modified in place when menu-bar-update-buffers is called. (defvar global-buffers-menu-map (make-sparse-keymap "Buffers")) @@ -52,12 +71,20 @@ (define-key global-map [menu-bar options] (cons (purecopy "Options") menu-bar-options-menu)) (defvar menu-bar-edit-menu (make-sparse-keymap "Edit")) -(define-key global-map [menu-bar edit] (cons (purecopy "Edit") menu-bar-edit-menu)) +(define-key global-map [menu-bar edit] + (cons (purecopy "Edit") menu-bar-edit-menu)) (defvar menu-bar-file-menu (make-sparse-keymap "File")) -(define-key global-map [menu-bar file] (cons (purecopy "File") menu-bar-file-menu)) +(define-key global-map [menu-bar file] + (cons (purecopy "File") menu-bar-file-menu)) -;; This alias is for compatibility with 19.28 and before. -(defvar menu-bar-files-menu menu-bar-file-menu) +;; Put "Help" menu at the front, called "Info". +(and (featurep 'ns) + (not (eq system-type 'darwin)) + (define-key global-map [menu-bar help-menu] + (cons (purecopy "Info") menu-bar-help-menu))) + +;; Only declared obsolete (and only made a proper alias) in 23.3. +(define-obsolete-variable-alias 'menu-bar-files-menu 'menu-bar-file-menu "22.1") ;; This is referenced by some code below; it is defined in uniquify.el (defvar uniquify-buffer-name-style) @@ -361,6 +388,11 @@ (define-key menu-bar-edit-menu [props] `(menu-item ,(purecopy "Text Properties") facemenu-menu)) +;; ns-win.el said: Add spell for platorm consistency. +(if (featurep 'ns) + (define-key menu-bar-edit-menu [spell] + `(menu-item ,(purecopy "Spell") ispell-menu-map))) + (define-key menu-bar-edit-menu [fill] `(menu-item ,(purecopy "Fill") fill-region :enable (and mark-active (not buffer-read-only)) @@ -453,30 +485,45 @@ ,(purecopy "Delete the text in region between mark and current position"))) (defvar yank-menu (cons (purecopy "Select Yank") nil)) (fset 'yank-menu (cons 'keymap yank-menu)) -(define-key menu-bar-edit-menu [paste-from-menu] - `(menu-item ,(purecopy "Paste from Kill Menu") yank-menu +(define-key menu-bar-edit-menu (if (featurep 'ns) [select-paste] + [paste-from-menu]) + ;; ns-win.el said: Change text to be more consistent with + ;; surrounding menu items `paste', etc." + `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste" + "Paste from Kill Menu")) yank-menu :enable (and (cdr yank-menu) (not buffer-read-only)) :help ,(purecopy "Choose a string from the kill ring and paste it"))) (define-key menu-bar-edit-menu [paste] `(menu-item ,(purecopy "Paste") yank :enable (and (or - ;; Emacs compiled --without-x doesn't have - ;; x-selection-exists-p. + ;; Emacs compiled --without-x (or --with-ns) + ;; doesn't have x-selection-exists-p. (and (fboundp 'x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)) - kill-ring) + (if (featurep 'ns) ; like paste-from-menu + (cdr yank-menu) + kill-ring)) (not buffer-read-only)) :help ,(purecopy "Paste (yank) text most recently cut/copied"))) (define-key menu-bar-edit-menu [copy] - `(menu-item ,(purecopy "Copy") menu-bar-kill-ring-save - :enable mark-active - :help ,(purecopy "Copy text in region between mark and current position") - :keys ,(purecopy "\\[kill-ring-save]"))) + ;; ns-win.el said: Substitute a Copy function that works better + ;; under X (for GNUstep). + `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns) + 'ns-copy-including-secondary + 'menu-bar-kill-ring-save) + :enable mark-active + :help ,(purecopy "Copy text in region between mark and current position") + :keys ,(purecopy (if (featurep 'ns) + "\\[ns-copy-including-secondary]" + "\\[kill-ring-save]")))) (define-key menu-bar-edit-menu [cut] `(menu-item ,(purecopy "Cut") kill-region :enable (and mark-active (not buffer-read-only)) :help ,(purecopy "Cut (kill) text in region between mark and current position"))) +;; ns-win.el said: Separate undo from cut/paste section. +(if (featurep 'ns) + (define-key menu-bar-edit-menu [separator-undo] `(,(purecopy "--")))) (define-key menu-bar-edit-menu [undo] `(menu-item ,(purecopy "Undo") undo :enable (and (not buffer-read-only) @@ -486,7 +533,6 @@ (consp buffer-undo-list))) :help ,(purecopy "Undo last operation"))) - (defun menu-bar-kill-ring-save (beg end) (interactive "r") (if (mouse-region-match) @@ -974,10 +1020,24 @@ mail status in mode line")) :visible (and (display-graphic-p) (fboundp 'x-show-tip)) :button (:toggle . tooltip-mode))) +(defun menu-bar-frame-for-menubar () + "Return the frame suitable for updating the menu bar." + (or (and (framep menu-updating-frame) + menu-updating-frame) + (selected-frame))) + +(defun menu-bar-positive-p (val) + "Return non-nil iff VAL is a positive number." + (and (numberp val) + (> val 0))) + (define-key menu-bar-showhide-menu [menu-bar-mode] `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame :help ,(purecopy "Turn menu-bar on/off") - :button (:toggle . (> (frame-parameter nil 'menu-bar-lines) 0)))) + :button + (:toggle . (menu-bar-positive-p + (frame-parameter (menu-bar-frame-for-menubar) + 'menu-bar-lines))))) (defun menu-bar-set-tool-bar-position (position) (customize-set-variable 'tool-bar-mode t) @@ -1008,47 +1068,55 @@ mail status in mode line")) (defvar menu-bar-showhide-tool-bar-menu (make-sparse-keymap "Tool-bar")) (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-left] - `(menu-item ,(purecopy "On the left") + `(menu-item ,(purecopy "On the left") menu-bar-showhide-tool-bar-menu-customize-enable-left :help ,(purecopy "Tool-bar at the left side") :visible (display-graphic-p) - :button - (:radio . (and tool-bar-mode - (eq (frame-parameter nil 'tool-bar-position) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) 'left))))) (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-right] - `(menu-item ,(purecopy "On the right") + `(menu-item ,(purecopy "On the right") menu-bar-showhide-tool-bar-menu-customize-enable-right :help ,(purecopy "Tool-bar at the right side") :visible (display-graphic-p) :button - (:radio . (and tool-bar-mode - (eq (frame-parameter nil 'tool-bar-position) + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) 'right))))) (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-bottom] - `(menu-item ,(purecopy "On the bottom") + `(menu-item ,(purecopy "On the bottom") menu-bar-showhide-tool-bar-menu-customize-enable-bottom :help ,(purecopy "Tool-bar at the bottom") :visible (display-graphic-p) :button - (:radio . (and tool-bar-mode - (eq (frame-parameter nil 'tool-bar-position) + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) 'bottom))))) (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-top] - `(menu-item ,(purecopy "On the top") + `(menu-item ,(purecopy "On the top") menu-bar-showhide-tool-bar-menu-customize-enable-top :help ,(purecopy "Tool-bar at the top") :visible (display-graphic-p) :button - (:radio . (and tool-bar-mode - (eq (frame-parameter nil 'tool-bar-position) + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) 'top))))) (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-none] - `(menu-item ,(purecopy "None") + `(menu-item ,(purecopy "None") menu-bar-showhide-tool-bar-menu-customize-disable :help ,(purecopy "Turn tool-bar off") :visible (display-graphic-p) @@ -1064,8 +1132,10 @@ mail status in mode line")) `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame :help ,(purecopy "Turn tool-bar on/off") :visible (display-graphic-p) - :button (:toggle . (> (frame-parameter nil 'tool-bar-lines) 0)))) -) + :button + (:toggle . (menu-bar-positive-p + (frame-parameter (menu-bar-frame-for-menubar) + 'tool-bar-lines)))))) (define-key menu-bar-options-menu [showhide] `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu)) @@ -1668,6 +1738,13 @@ key, a click, or a menu-item"))) `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial :help ,(purecopy "Learn how to use Emacs"))) +;; In OS X it's in the app menu already. +;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. +(and (featurep 'ns) + (not (eq system-type 'darwin)) + (define-key menu-bar-help-menu [info-panel] + `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel))) + (defun menu-bar-menu-frame-live-and-visible-p () "Return non-nil if the menu frame is alive and visible. The menu frame is the frame for which we are updating the menu." @@ -2020,7 +2097,8 @@ With a numeric argument, if the argument is positive, turn on menu bars; otherwise, turn off menu bars." :init-value t :global t - :group 'frames + ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. + :variable menu-bar-mode ;; Turn the menu-bars on all frames on or off. (let ((val (if menu-bar-mode 1 0))) @@ -2055,7 +2133,10 @@ turn on menu bars; otherwise, turn off menu bars." See `menu-bar-mode' for more information." (interactive (list (or current-prefix-arg 'toggle))) (if (eq arg 'toggle) - (menu-bar-mode (if (> (frame-parameter nil 'menu-bar-lines) 0) 0 1)) + (menu-bar-mode + (if (menu-bar-positive-p + (frame-parameter (menu-bar-frame-for-menubar) 'menu-bar-lines)) + 0 1)) (menu-bar-mode arg))) (declare-function x-menu-bar-open "term/x-win" (&optional frame)) @@ -2082,5 +2163,4 @@ If FRAME is nil or not given, use the selected frame." (provide 'menu-bar) -;; arch-tag: 6e6a3c22-4ec4-4d3d-8190-583f8ef94ced ;;; menu-bar.el ends here diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index ad1dbc8f024..336fd0100c1 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,11 @@ +2010-11-07 Glenn Morris <rgm@gnu.org> + + * mh-seq.el (mh-read-msg-list): Use point-at-eol. + +2010-11-03 Glenn Morris <rgm@gnu.org> + + * mh-mime.el (dots, type, ov): Avoid unnecessary declaration. + 2010-05-14 Peter S Galbraith <psg@debian.org> * mh-mime.el (mh-decode-message-subject): New function to decode diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index a24489ca9b7..7492f9600b3 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -5452,7 +5452,7 @@ from mh-exec-cmd. * mh-utils.el (mh-temp-folders-buffer): Sequences and folders - loose the -temp from their buffer names as they are interesting to + lose the -temp from their buffer names as they are interesting to the user. * mh-seq.el (mh-list-sequences): New name, mh-sequences-buffer as @@ -11400,7 +11400,8 @@ (dist): Leave release in current directory. - Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -11417,4 +11418,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: 2577172b-b1bf-4d87-acfb-c9d8780e8851 diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 8d47af40ebd..860256e236a 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1,8 +1,7 @@ ;;; mh-mime.el --- MH-E MIME support -;; Copyright (C) 1993, 1995, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -837,9 +836,10 @@ being used to highlight the signature in a MIME part." ;;; Button Display ;; Shush compiler. -(defvar dots) ; XEmacs -(defvar type) ; XEmacs -(defvar ov) ; XEmacs +(when (featurep 'xemacs) + (defvar dots) + (defvar type) + (defvar ov)) (defun mh-insert-mime-button (handle index displayed) "Insert MIME button for HANDLE. @@ -1834,5 +1834,4 @@ initialized. Always use the command `mh-have-file-command'.") ;; sentence-end-double-space: nil ;; End: -;; arch-tag: 0dd36518-1b64-4a84-8f4e-59f422d3f002 ;;; mh-mime.el ends here diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index f8ea12f9e08..09dce2f32da 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -1,8 +1,7 @@ ;;; mh-seq.el --- MH-E sequences support -;; Copyright (C) 1993, 1995, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -819,7 +818,7 @@ that note messages to be refiled." "Return a list of message numbers from point to the end of the line. Expands ranges into set of individual numbers." (let ((msgs ()) - (end-of-line (save-excursion (end-of-line) (point))) + (end-of-line (point-at-eol)) num) (while (re-search-forward "[0-9]+" end-of-line t) (setq num (string-to-number (buffer-substring (match-beginning 0) @@ -1017,5 +1016,4 @@ removed." ;; sentence-end-double-space: nil ;; End: -;; arch-tag: 8e952711-01a2-485b-bf21-c9e3ad4de942 ;;; mh-seq.el ends here diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 98380f3926e..8d09d5d3f6d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -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 @@ -508,10 +508,11 @@ Moves point to the end of the new text." (setq suffix-len (1+ suffix-len))) (unless (zerop suffix-len) (setq end (- end suffix-len)) - (setq newtext (substring newtext 0 (- suffix-len))))) - (goto-char beg) - (insert newtext) - (delete-region (point) (+ (point) (- end beg)))) + (setq newtext (substring newtext 0 (- suffix-len)))) + (goto-char beg) + (insert newtext) + (delete-region (point) (+ (point) (- end beg))) + (forward-char suffix-len))) (defcustom completion-cycle-threshold nil "Number of completion candidates below which cycling is used. @@ -525,6 +526,13 @@ candidates than this number." (const :tag "Always cycle" t) (integer :tag "Threshold"))) +(defvar completion-all-sorted-completions nil) +(make-variable-buffer-local 'completion-all-sorted-completions) +(defvar completion-cycling nil) + +(defvar completion-fail-discreetly nil + "If non-nil, stay quiet when there is no match.") + (defun completion--do-completion (&optional try-completion-function) "Do the completion and return a summary of what happened. M = completion was performed, the text was Modified. @@ -553,11 +561,13 @@ E = after completion we now have an Exact match. (cond ((null comp) (minibuffer-hide-completions) - (ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil)) + (unless completion-fail-discreetly + (ding) (minibuffer-message "No match")) + (minibuffer--bitset nil nil nil)) ((eq t comp) (minibuffer-hide-completions) (goto-char (field-end)) - (minibuffer--bitset nil nil t)) ;Exact and unique match. + (minibuffer--bitset nil nil t)) ;Exact and unique match. (t ;; `completed' should be t if some completion was done, which doesn't ;; include simply changing the case of the entered string. However, @@ -577,11 +587,11 @@ E = after completion we now have an Exact match. (forward-char (- comp-pos (length completion))) (if (not (or unchanged completed)) - ;; The case of the string changed, but that's all. We're not sure - ;; whether this is a unique completion or not, so try again using - ;; the real case (this shouldn't recurse again, because the next - ;; time try-completion will return either t or the exact string). - (completion--do-completion try-completion-function) + ;; The case of the string changed, but that's all. We're not sure + ;; whether this is a unique completion or not, so try again using + ;; the real case (this shouldn't recurse again, because the next + ;; time try-completion will return either t or the exact string). + (completion--do-completion try-completion-function) ;; It did find a match. Do we match some possibility exactly now? (let ((exact (test-completion completion @@ -604,35 +614,34 @@ E = after completion we now have an Exact match. "")) comp-pos))) (completion-all-sorted-completions)))) - (setq completion-all-sorted-completions nil) + (completion--flush-all-sorted-completions) (cond - ((and (not (ignore-errors + ((and (consp (cdr comps)) ;; There's something to cycle. + (not (ignore-errors ;; This signal an (intended) error if comps is too ;; short or if completion-cycle-threshold is t. - (consp (nthcdr completion-cycle-threshold comps)))) - ;; More than 1, so there's something to cycle. - (consp (cdr comps))) + (consp (nthcdr completion-cycle-threshold comps))))) ;; Fewer than completion-cycle-threshold remaining ;; completions: let's cycle. (setq completed t exact t) (setq completion-all-sorted-completions comps) (minibuffer-force-complete)) (completed - ;; We could also decide to refresh the completions, - ;; if they're displayed (and assuming there are - ;; completions left). + ;; We could also decide to refresh the completions, + ;; if they're displayed (and assuming there are + ;; completions left). (minibuffer-hide-completions)) - ;; Show the completion table, if requested. - ((not exact) - (if (case completion-auto-help - (lazy (eq this-command last-command)) - (t completion-auto-help)) - (minibuffer-completion-help) - (minibuffer-message "Next char not unique"))) - ;; If the last exact completion and this one were the same, it - ;; means we've already given a "Next char not unique" message - ;; and the user's hit TAB again, so now we give him help. - ((eq this-command last-command) + ;; Show the completion table, if requested. + ((not exact) + (if (case completion-auto-help + (lazy (eq this-command last-command)) + (t completion-auto-help)) + (minibuffer-completion-help) + (minibuffer-message "Next char not unique"))) + ;; If the last exact completion and this one were the same, it + ;; means we've already given a "Next char not unique" message + ;; and the user's hit TAB again, so now we give him help. + ((eq this-command last-command) (if completion-auto-help (minibuffer-completion-help)))) (minibuffer--bitset completed t exact)))))))) @@ -647,7 +656,7 @@ scroll the window of possible completions." ;; If the previous command was not this, ;; mark the completion buffer obsolete. (unless (eq this-command last-command) - (setq completion-all-sorted-completions nil) + (completion--flush-all-sorted-completions) (setq minibuffer-scroll-window nil)) (cond @@ -663,7 +672,7 @@ scroll the window of possible completions." (scroll-other-window)) nil))) ;; If we're cycling, keep on cycling. - (completion-all-sorted-completions + ((and completion-cycling completion-all-sorted-completions) (minibuffer-force-complete) t) (t (case (completion--do-completion) @@ -674,10 +683,8 @@ scroll the window of possible completions." t) (t t))))) -(defvar completion-all-sorted-completions nil) -(make-variable-buffer-local 'completion-all-sorted-completions) - (defun completion--flush-all-sorted-completions (&rest ignore) + (setq completion-cycling nil) (setq completion-all-sorted-completions nil)) (defun completion-all-sorted-completions () @@ -719,6 +726,7 @@ Repeated uses step through the possible completions." (all (completion-all-sorted-completions))) (if (not (consp all)) (minibuffer-message (if all "No more completions" "No completions")) + (setq completion-cycling t) (goto-char end) (insert (car all)) (delete-region (+ start (cdr (last all))) end) @@ -1130,6 +1138,7 @@ variables.") (interactive) (message "Making completion list...") (lexical-let* ((start (field-beginning)) + (end (field-end)) (string (field-string)) (completions (completion-all-completions string @@ -1161,10 +1170,12 @@ variables.") 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 @@ -1240,31 +1251,23 @@ Currently supported properties are: `:predicate' a predicate that completion candidates need to satisfy. `:annotation-function' the value to use for `completion-annotate-function'.") -(defun completion-at-point (&optional arg) +(defun completion-at-point () "Perform completion on the text around point. -The completion method is determined by `completion-at-point-functions'. - -With a prefix argument, this command does completion within -the collection of symbols listed in the index of the manual for the -language you are using." - (interactive "P") - (if arg - (info-complete-symbol) - (let ((res (run-hook-with-args-until-success - 'completion-at-point-functions))) - (cond - ((functionp res) (funcall res)) - (res - (let* ((plist (nthcdr 3 res)) - (start (nth 0 res)) - (end (nth 1 res)) - (completion-annotate-function - (or (plist-get plist :annotation-function) - completion-annotate-function))) - (completion-in-region start end (nth 2 res) - (plist-get plist :predicate)))))))) - -(define-obsolete-function-alias 'complete-symbol 'completion-at-point "24.1") +The completion method is determined by `completion-at-point-functions'." + (interactive) + (let ((res (run-hook-with-args-until-success + 'completion-at-point-functions))) + (cond + ((functionp res) (funcall res)) + (res + (let* ((plist (nthcdr 3 res)) + (start (nth 0 res)) + (end (nth 1 res)) + (completion-annotate-function + (or (plist-get plist :annotation-function) + completion-annotate-function))) + (completion-in-region start end (nth 2 res) + (plist-get plist :predicate))))))) ;;; Key bindings. diff --git a/lisp/misc.el b/lisp/misc.el index 6f32a3eb90f..55b685fe2b7 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -1,7 +1,7 @@ ;;; misc.el --- some nonstandard basic editing commands for Emacs -;; Copyright (C) 1989, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1989, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: convenience @@ -54,7 +54,7 @@ The characters copied are inserted in the buffer before point." (setq string (concat string (buffer-substring (point) - (min (save-excursion (end-of-line) (point)) + (min (line-end-position) (+ n (point))))))) (insert string))) @@ -132,5 +132,4 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." (provide 'misc) -;; arch-tag: 908f7884-c19e-4388-920c-9cfa425e449b ;;; misc.el ends here diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index 4dc57529385..e024b2aa551 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -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 @@ Basically, we check for existing horizontal scrolling." 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 @@ To test this function, evaluate: (provide 'mouse-drag) -;; arch-tag: e47354ff-82f5-42c4-b3dc-88dd9c04b770 ;;; mouse-drag.el ends here diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el index f3875e24f07..9b4a048131e 100644 --- a/lisp/mouse-sel.el +++ b/lisp/mouse-sel.el @@ -1,7 +1,7 @@ -;;; mouse-sel.el --- multi-click selection support for Emacs 19 +;;; mouse-sel.el --- multi-click selection support -;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Mike Williams <mdub@bigfoot.com> ;; Keywords: mouse @@ -299,7 +299,7 @@ where SELECTION-NAME = name of selection SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored.") -(declare-function x-select-text "term/x-win" (text)) +(declare-function x-select-text "term/common-win" (text)) (defvar mouse-sel-set-selection-function (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) @@ -314,7 +314,7 @@ Called with two arguments: SELECTION, the name of the selection concerned, and VALUE, the text to store. -This sets the selection, unless `mouse-sel-default-bindings' +This sets the selection, unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.") (declare-function x-selection-value "term/x-win" ()) @@ -749,5 +749,4 @@ If `mouse-yank-at-point' is non-nil, insert at point instead." (provide 'mouse-sel) -;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7 ;;; mouse-sel.el ends here diff --git a/lisp/mouse.el b/lisp/mouse.el index b71df57556c..40e0c14c064 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1280,7 +1280,7 @@ regardless of where you click." (or mouse-yank-at-point (mouse-set-point click)) (let ((primary (cond - ((fboundp 'x-get-selection-value) ; MS-DOS and MS-Windows + ((fboundp 'x-get-selection-value) ; MS-DOS, MS-Windows and X. (or (x-get-selection-value) (x-get-selection 'PRIMARY))) ;; FIXME: What about xterm-mouse-mode etc.? diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 4b63dfd7535..07091663471 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4901,7 +4901,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; ;; This is the Unix dl version. ;; (let ((opoint (point)) ;; case-fold-search hidden) -;; (or eol (setq eol (save-excursion (end-of-line) (point)))) +;; (or eol (setq eol (line-end-position))) ;; (setq hidden (and selective-display ;; (save-excursion ;; (search-forward "\r" eol t)))) @@ -5300,7 +5300,7 @@ Other orders of $ and _ seem to all work just fine.") ;; ;; This is the VMS version. ;; (let (opoint hidden case-fold-search) ;; (setq opoint (point)) -;; (or eol (setq eol (save-excursion (end-of-line) (point)))) +;; (or eol (setq eol (line-end-position))) ;; (setq hidden (and selective-display ;; (save-excursion (search-forward "\r" eol t)))) ;; (if hidden @@ -5658,7 +5658,7 @@ Other orders of $ and _ seem to all work just fine.") ;; ;; This is the MTS version. ;; (let (opoint hidden case-fold-search) ;; (setq opoint (point) -;; eol (save-excursion (end-of-line) (point)) +;; eol (line-end-position) ;; hidden (and selective-display ;; (save-excursion (search-forward "\r" eol t)))) ;; (if hidden @@ -5879,7 +5879,7 @@ Other orders of $ and _ seem to all work just fine.") ;; ;; This is the CMS version. ;; (let ((opoint (point)) ;; case-fold-search hidden) -;; (or eol (setq eol (save-excursion (end-of-line) (point)))) +;; (or eol (setq eol (line-end-position))) ;; (setq hidden (and selective-display ;; (save-excursion ;; (search-forward "\r" eol t)))) @@ -6153,5 +6153,4 @@ be recognized automatically (they are all valid BS2000 hosts too)." (provide 'ange-ftp) -;; arch-tag: 2987ef88-cb56-4ec1-87a9-79132572e316 ;;; ange-ftp.el ends here diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 45dde6dba3c..f2af67458ac 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -219,8 +219,10 @@ (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)) + ((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,19 @@ regexp should probably be \".\" to specify a default browser." (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-mailto-function 'browse-url-mail + "Function to display mailto: links. +This variable uses the same syntax as the +`browse-url-browser-function' variable. If the +`browse-url-mailto-function' variable is nil, that variable will +be used instead." + :type '(choice + (function-item :tag "Emacs Mail" :value browse-url-mail) + (function-item :tag "None" nil)) + :version "24.1" :group 'browse-url) (defcustom browse-url-netscape-program "netscape" @@ -635,7 +649,6 @@ regarding its parameter treatment." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; URL input -;;;###autoload (defun browse-url-url-at-point () (let ((url (thing-at-point 'url))) (set-text-properties 0 (length url) nil url) @@ -778,22 +791,27 @@ narrowed." (defun browse-url (url &rest args) "Ask a WWW browser to load URL. Prompts for a URL, defaulting to the URL at or before point. Variable -`browse-url-browser-function' says which browser to use." +`browse-url-browser-function' says which browser to use. +If the URL is a mailto: URL, consult `browse-url-mailto-function' +first, if that exists." (interactive (browse-url-interactive-arg "URL: ")) (unless (called-interactively-p 'interactive) (setq args (or args (list browse-url-new-window-flag)))) - (let ((process-environment (copy-sequence process-environment))) + (let ((process-environment (copy-sequence process-environment)) + (function (or (and (string-match "\\`mailto:" url) + browse-url-mailto-function) + browse-url-browser-function))) ;; When connected to various displays, be careful to use the display of ;; the currently selected frame, rather than the original start display, ;; which may not even exist any more. (if (stringp (frame-parameter (selected-frame) 'display)) (setenv "DISPLAY" (frame-parameter (selected-frame) 'display))) - (if (and (consp browse-url-browser-function) - (not (functionp browse-url-browser-function))) + (if (and (consp function) + (not (functionp function))) ;; The `function' can be an alist; look down it for first match ;; and apply the function (which might be a lambda). (catch 'done - (dolist (bf browse-url-browser-function) + (dolist (bf function) (when (string-match (car bf) url) (apply (cdr bf) url args) (throw 'done t))) @@ -801,7 +819,7 @@ Prompts for a URL, defaulting to the URL at or before point. Variable url)) ;; Unbound symbols go down this leg, since void-function from ;; apply is clearer than wrong-type-argument from dolist. - (apply browse-url-browser-function url args)))) + (apply function url args)))) ;;;###autoload (defun browse-url-at-point (&optional arg) @@ -874,7 +892,6 @@ one showing the selected frame." (and (not (equal display (getenv "DISPLAY"))) display))) -;;;###autoload (defun browse-url-default-browser (url &rest args) "Find a suitable browser and ask it to load URL. Default to the URL around or before point. @@ -1479,20 +1496,27 @@ used instead of `browse-url-new-window-flag'." (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 --- diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 8d9512d6f9f..c9adec5d7b8 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -239,7 +239,7 @@ This handler is applied when a \"NameOwnerChanged\" signal has arrived. SERVICE is the object name for which the name owner has been changed. OLD-OWNER is the previous owner of SERVICE, or the empty string if SERVICE was not owned yet. NEW-OWNER is the new -owner of SERVICE, or the empty string if SERVICE looses any name owner. +owner of SERVICE, or the empty string if SERVICE loses any name owner. usage: (dbus-name-owner-changed-handler service old-owner new-owner)" (save-match-data @@ -1010,5 +1010,4 @@ It will be registered for all objects created by `dbus-register-object'." (provide 'dbus) -;; arch-tag: a47caf84-9162-4811-90cc-5d388e37b9bd ;;; dbus.el ends here diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 384ddbbecf2..282a60a8288 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -830,10 +830,7 @@ see `eudc-inline-expansion-servers'" (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 @@ This does nothing except loading eudc by autoload side-effect." (provide 'eudc) -;; arch-tag: e18872b6-db83-400b-869d-be54e9a4160c ;;; eudc.el ends here diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 00cdcd8ea9b..85c546ffd3f 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -1,4 +1,5 @@ ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS + ;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz@lifelogs.com> @@ -65,6 +66,8 @@ trust and key files, and priority string." (let ((proc (open-network-stream name buffer host service))) (gnutls-negotiate proc 'gnutls-x509pki))) +(declare-function gnutls-boot "gnutls.c" (proc type proplist)) + (defun gnutls-negotiate (proc type &optional priority-string trustfiles keyfiles) "Negotiate a SSL/TLS connection. @@ -95,6 +98,9 @@ KEYFILES is a list of client keys." proc)) +(declare-function gnutls-errorp "gnutls.c" (error)) +(declare-function gnutls-error-string "gnutls.c" (error)) + (defun gnutls-message-maybe (doit format &rest params) "When DOIT, message with the caller name followed by FORMAT on PARAMS." ;; (apply 'debug format (or params '(nil))) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 17f6acce0f4..066dbd8bea0 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -579,9 +579,7 @@ an alist of attribute/value pairs." (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 @@ an alist of attribute/value pairs." (provide 'ldap) -;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0 ;;; ldap.el ends here diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index e5c959d8f23..bfac633c580 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -748,7 +748,7 @@ VALUES may contain values for editable fields from current article." (define-key map [(e)] 'mairix-select-edit) (define-key map [(d)] 'mairix-select-delete) (define-key map [(s)] 'mairix-select-save) - (setq mairix-searches-mode-map map)) + map) "'mairix-searches-mode' keymap.") (defvar mairix-searches-mode-font-lock-keywords) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index b69c571ddf5..60829f300b5 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -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 @@ from SEARCH-STRING. With argument, prompt for whois server." (provide 'net-utils) -;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314 ;;; net-utils.el ends here diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 4a8625ae745..4e99f542b32 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -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 @@ TYPE dictates what will be inserted, options are: `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 @@ TYPE dictates what will be inserted, options are: (provide 'quickurl) -;; arch-tag: a8183ea5-80c2-4082-a7d1-b0fdf2da467e ;;; quickurl.el ends here diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index e6e1bc671e7..fac08defefb 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -298,8 +298,7 @@ buffer in your bug report. (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))) @@ -364,13 +363,5 @@ please ensure that the buffers are attached to your email.\n\n") ;; flavor) (Reiner Steib) ;; * Let the user edit the connection properties interactively. ;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer. -;; * It's just that when I come to Customize `tramp-default-user-alist' -;; I'm presented with a mismatch and raw lisp for a value. It is my -;; understanding that a variable declared with defcustom is a User -;; Option and should not be modified by the code. add-to-list is -;; called in several places. One way to handle that is to have a new -;; 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 diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 130e3122df9..852ee8fa45d 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -199,25 +199,6 @@ (ignore-errors (tramp-compat-funcall 'font-lock-add-keywords mode keywords how))) -(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))))) - -(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 @@ -529,5 +510,4 @@ EOL-TYPE can be one of `dos', `unix', or `mac'." ;;; TODO: -;; arch-tag: 0e724b18-6699-4f87-ad96-640b272e5c85 ;;; tramp-compat.el ends here diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 7f8b7454caf..a0db0199412 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -107,11 +107,11 @@ present for backward compatibility." (unless (featurep 'xemacs) (add-to-list 'tramp-methods (cons tramp-ftp-method nil))) -;; Add some defaults for `tramp-default-method-alist' +;; Add some defaults for `tramp-default-method-alist'. (add-to-list 'tramp-default-method-alist - (list "\\`ftp\\." "" tramp-ftp-method)) + (list "\\`ftp\\." nil tramp-ftp-method)) (add-to-list 'tramp-default-method-alist - (list "" "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)) + (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)) ;; Add completion function for FTP method. (tramp-set-completion-function @@ -221,5 +221,4 @@ pass to the OPERATION." ;; * There are no backup files on FTP hosts. -;; arch-tag: 759fb338-5c63-4b99-bd36-b4d59db91cff ;;; tramp-ftp.el ends here diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 32322680f14..a87b58a42c2 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -124,8 +124,7 @@ ;; Add a default for `tramp-default-user-alist'. Rule: For the SYNCE ;; method, no user is chosen. -(add-to-list 'tramp-default-user-alist - '("synce" nil nil)) +(add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil)) (defcustom tramp-gvfs-zeroconf-domain "local" "*Zeroconf domain to be used for discovering services, like host names." @@ -1432,5 +1431,4 @@ They are retrieved from the hal daemon." ;; capability. ;; * Implement obex for other serial communication but bluetooth. -;; arch-tag: f7f660ce-77f4-4132-9663-f5c25a47f7ed ;;; tramp-gvfs.el ends here diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index 71a23fd2d07..0fac3935d73 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -44,6 +44,9 @@ (when (featurep 'xemacs) (byte-compiler-options (warnings (- unused-vars))))) +;; We don't add the following methods to `tramp-methods', in order to +;; exclude them from file name completion. + ;; Define HTTP tunnel method ... ;;;###tramp-autoload (defconst tramp-gw-tunnel-method "tunnel" @@ -69,10 +72,12 @@ (list "Default server" "socks" tramp-gw-default-socks-port 5)) ;; Add a default for `tramp-default-user-alist'. Default is the local user. -(add-to-list 'tramp-default-user-alist - `(,tramp-gw-tunnel-method nil ,(user-login-name))) -(add-to-list 'tramp-default-user-alist - `(,tramp-gw-socks-method nil ,(user-login-name))) +(add-to-list + 'tramp-default-user-alist + (list (concat "\\`" + (regexp-opt (list tramp-gw-tunnel-method tramp-gw-socks-method)) + "\\'") + nil (user-login-name))) ;; Internal file name functions and variables. @@ -194,8 +199,8 @@ instead of the host name declared in TARGET-VEC." (setq tramp-gw-gw-proc (funcall socks-function - (tramp-buffer-name gw-vec) - (tramp-get-buffer gw-vec) + (tramp-get-connection-name gw-vec) + (tramp-get-connection-buffer gw-vec) (tramp-file-name-real-host target-vec) (tramp-file-name-port target-vec))) (set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel) @@ -324,5 +329,4 @@ password in password cache. This is done for the first try only." ;; * Provide descriptive Commentary. ;; * Enable it for several gateway processes in parallel. -;; arch-tag: 277e3a81-fdee-40cf-9e6b-59626292a5e0 ;;; tramp-gw.el ends here diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el index dade2052126..d71583bcd85 100644 --- a/lisp/net/tramp-imap.el +++ b/lisp/net/tramp-imap.el @@ -84,10 +84,6 @@ (add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143)))) -;; Add a default for `tramp-default-user-alist'. Default is the local user. -(add-to-list 'tramp-default-user-alist - `(,tramp-imap-method nil ,(user-login-name))) - ;; Define Tramp IMAPS method ... ;;;###tramp-autoload (defconst tramp-imaps-method "imaps" @@ -100,8 +96,12 @@ (list tramp-imaps-method '(tramp-default-port 993)))) ;; Add a default for `tramp-default-user-alist'. Default is the local user. -(add-to-list 'tramp-default-user-alist - `(,tramp-imaps-method nil ,(user-login-name))) +(add-to-list + 'tramp-default-user-alist + (list (concat "\\`" + (regexp-opt (list tramp-imap-method tramp-imaps-method)) + "\\'") + nil (user-login-name))) ;; Add completion function for IMAP method. ;; (tramp-set-completion-function @@ -746,8 +746,7 @@ With NEEDED-SUBJECT, alters the imap-hash test accordingly." (method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (ssl (string-equal method tramp-imaps-method)) - (port (or (tramp-file-name-port vec) - (tramp-get-method-parameter method 'tramp-default-port))) + (port (tramp-file-name-port vec)) (result (imap-hash-make server port mbox user nil ssl))) ;; Return the IHT with a test override to look for the subject ;; marker. @@ -842,5 +841,3 @@ With NEEDED-SUBJECT, alters the imap-hash test accordingly." ;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen")) ;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4")) ;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") "extra") - -;; arch-tag: f2723749-58fb-4f29-894e-39708096e850 diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 474c39adeed..1501868a6b5 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -67,7 +67,7 @@ files conditionalize this setup based on the TERM environment variable." :group 'tramp :type 'string) -;; ksh on OpenBSD 4.5 requires, that PS1 contains a `#' character for +;; ksh on OpenBSD 4.5 requires, that $PS1 contains a `#' character for ;; root users. It uses the `$' character for other users. In order ;; to guarantee a proper prompt, we use "#$" for the prompt. @@ -91,7 +91,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-login-args (("%h") ("-l" "%u"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rcp") - (tramp-copy-args (("-p" "%k") ("-r"))) + (tramp-copy-args (("%k" "-p") ("-r"))) (tramp-copy-keep-date t) (tramp-copy-recursive t))) ;;;###tramp-autoload @@ -101,17 +101,17 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-login-args (("%h") ("-l" "%u"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rcp") - (tramp-copy-args (("-p" "%k"))) + (tramp-copy-args (("%k" "-p"))) (tramp-copy-keep-date t))) ;;;###tramp-autoload -(add-to-list - 'tramp-methods - '("scp" (tramp-login-program "ssh") +(add-to-list 'tramp-methods + '("scp" + (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") - (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r"))) + (tramp-copy-args (("-P" "%p") ("%k" "-p") ("-q") ("-r"))) (tramp-copy-keep-date t) (tramp-copy-recursive t) (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") @@ -127,7 +127,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") - (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k") ("-q") ("-r"))) + (tramp-copy-args (("-1") ("-P" "%p") ("%k" "-p") ("-q") ("-r"))) (tramp-copy-keep-date t) (tramp-copy-recursive t) (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") @@ -143,7 +143,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") - (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k") ("-q") ("-r"))) + (tramp-copy-args (("-2") ("-P" "%p") ("%k" "-p") ("-q") ("-r"))) (tramp-copy-keep-date t) (tramp-copy-recursive t) (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") @@ -161,7 +161,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") - (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") + (tramp-copy-args (("-P" "%p") ("%k" "-p") ("-q") ("-o" "ControlPath=%t.%%r@%%h:%%p") ("-o" "ControlMaster=auto"))) (tramp-copy-keep-date t) @@ -179,7 +179,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") - (tramp-copy-args (("-p" "%k"))) + (tramp-copy-args (("%k" "-p"))) (tramp-copy-keep-date t) (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") ("-o" "UserKnownHostsFile=/dev/null") @@ -201,7 +201,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rsync") - (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r"))) + (tramp-copy-args (("-e" "ssh") ("%k" "-t") ("-r"))) (tramp-copy-keep-date t) (tramp-copy-keep-tmpfile t) (tramp-copy-recursive t))) @@ -216,7 +216,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rsync") - (tramp-copy-args (("-t" "%k") ("-r"))) + (tramp-copy-args (("%k" "-t") ("-r"))) (tramp-copy-env (("RSYNC_RSH") (,(concat "ssh" @@ -346,8 +346,10 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "pscp") - (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k"))) + (tramp-copy-args (("-P" "%p") ("-scp") ("%k" "-p") + ("-q") ("-r"))) (tramp-copy-keep-date t) + (tramp-copy-recursive t) (tramp-password-end-of-line "xy") ;see docstring for "xy" (tramp-default-port 22))) ;;;###tramp-autoload @@ -357,8 +359,10 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "pscp") - (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k"))) + (tramp-copy-args (("-P" "%p") ("-sftp") ("%k" "-p") + ("-q") ("-r"))) (tramp-copy-keep-date t) + (tramp-copy-recursive t) (tramp-password-end-of-line "xy"))) ;see docstring for "xy" ;;;###tramp-autoload (add-to-list 'tramp-methods @@ -367,7 +371,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i"))) (tramp-remote-sh "/bin/sh -i") (tramp-copy-program "fcp") - (tramp-copy-args (("-p" "%k"))) + (tramp-copy-args (("%k" "-p"))) (tramp-copy-keep-date t))) (add-to-list 'tramp-default-method-alist @@ -1189,8 +1193,7 @@ target of the symlink differ." ;; 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 @@ -1241,7 +1244,7 @@ target of the symlink differ." (format ;; On Opsware, pdksh (which is the true name of ksh there) doesn't ;; parse correctly the sequence "((". Therefore, we add a space. - "( (%s %s || %s -h %s) && %s -c '( (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s || echo nil)" + "( (%s %s || %s -h %s) && %s -c '((\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)' %s || echo nil)" (tramp-get-file-exists-command vec) (tramp-shell-quote-argument localname) (tramp-get-test-command vec) @@ -1438,7 +1441,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (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. @@ -1629,7 +1632,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." ;; but it does not work on all remote systems. Therefore, we ;; quote the filenames via sed. "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs " - "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); " + "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'); " "echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) @@ -1746,8 +1749,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (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 +1762,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (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 @@ -1946,7 +1946,7 @@ file names." ;; Try out-of-band operation. ((tramp-method-out-of-band-p - v1 (nth 7 (file-attributes filename))) + v1 (nth 7 (file-attributes (file-truename filename)))) (tramp-do-copy-or-rename-file-out-of-band op filename newname keep-date)) @@ -1974,7 +1974,8 @@ file names." ;; If the Tramp file has an out-of-band method, the ;; corresponding copy-program can be invoked. - ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename))) + ((tramp-method-out-of-band-p + v (nth 7 (file-attributes (file-truename filename)))) (tramp-do-copy-or-rename-file-out-of-band op filename newname keep-date)) @@ -2170,24 +2171,22 @@ the uid and gid from FILENAME." (list tmpfile localname2 ok-if-already-exists))))) ;; Save exit. - (condition-case nil - (delete-file tmpfile) - (error))))))))) + (ignore-errors (delete-file tmpfile))))))))) ;; Set the time and mode. Mask possible errors. - (condition-case nil + (ignore-errors (when keep-date (set-file-times newname file-times) - (set-file-modes newname file-modes)) - (error))))) + (set-file-modes newname file-modes)))))) (defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date) "Invoke rcp program to copy. The method used must be an out-of-band method." - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - copy-program copy-args copy-env copy-keep-date port spec - source target) + (let* ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (orig-vec (tramp-dissect-file-name (if t1 filename newname))) + copy-program copy-args copy-env copy-keep-date port spec + source target) (with-parsed-tramp-file-name (if t1 filename newname) nil (if (and t1 t2) @@ -2207,12 +2206,17 @@ The method used must be an out-of-band method." (tramp-do-copy-or-rename-file-out-of-band 'rename tmpfile newname keep-date)) ;; Save exit. - (condition-case nil - (if dir-flag - (tramp-compat-delete-directory - (expand-file-name ".." tmpfile) 'recursive) - (delete-file tmpfile)) - (error)))) + (ignore-errors + (if dir-flag + (tramp-compat-delete-directory + (expand-file-name ".." tmpfile) 'recursive) + (delete-file tmpfile))))) + + ;; Set variables for computing the prompt for reading + ;; password. + (setq tramp-current-method (tramp-file-name-method v) + tramp-current-user (tramp-file-name-user v) + tramp-current-host (tramp-file-name-host v)) ;; Expand hops. Might be necessary for gateway methods. (setq v (car (tramp-compute-multi-hops v))) @@ -2246,16 +2250,20 @@ The method used must be an out-of-band method." copy-keep-date (tramp-get-method-parameter method 'tramp-copy-keep-date) copy-args - (delq - nil - (mapcar - (lambda (x) - (setq - x - ;; " " is indication for keep-date argument. - (delete " " (mapcar (lambda (y) (format-spec y spec)) x))) - (unless (member "" x) (mapconcat 'identity x " "))) - (tramp-get-method-parameter method 'tramp-copy-args))) + (delete + ;; " " has either been a replacement of "%k" (when + ;; keep-date argument is non-nil), or a replacemtent + ;; for the whole keep-date sublist. + " " + (dolist + (x + (tramp-get-method-parameter method 'tramp-copy-args) + copy-args) + (setq copy-args + (append + copy-args + (let ((y (mapcar (lambda (z) (format-spec z spec)) x))) + (if (zerop (length (car y))) '(" ") y)))))) copy-env (delq nil @@ -2273,14 +2281,8 @@ The method used must be an out-of-band method." (tramp-error v 'file-error "Cannot find copy program: %s" copy-program)) - ;; Set variables for computing the prompt for reading - ;; password. - (setq tramp-current-method (tramp-file-name-method v) - tramp-current-user (tramp-file-name-user v) - tramp-current-host (tramp-file-name-host v)) - - (unwind-protect - (with-temp-buffer + (with-temp-buffer + (unwind-protect ;; The default directory must be remote. (let ((default-directory (file-name-directory (if t1 filename newname))) @@ -2291,7 +2293,8 @@ The method used must be an out-of-band method." (tramp-set-connection-property v "process-buffer" (current-buffer)) (while copy-env - (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env)) + (tramp-message + orig-vec 5 "%s=\"%s\"" (car copy-env) (cadr copy-env)) (setenv (pop copy-env) (pop copy-env))) ;; Use an asynchronous process. By this, password can @@ -2302,20 +2305,20 @@ The method used must be an out-of-band method." (let ((p (let ((default-directory (tramp-compat-temporary-file-directory))) (apply 'start-process - (tramp-get-connection-property - v "process-name" nil) - (tramp-get-connection-property - v "process-buffer" nil) + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) copy-program (append copy-args (list source target)))))) (tramp-message - v 6 "%s" (mapconcat 'identity (process-command p) " ")) + orig-vec 6 "%s" + (mapconcat 'identity (process-command p) " ")) (tramp-compat-set-process-query-on-exit-flag p nil) - (tramp-process-actions p v tramp-actions-copy-out-of-band)))) + (tramp-process-actions p v tramp-actions-copy-out-of-band))) - ;; Reset the transfer process properties. - (tramp-set-connection-property v "process-name" nil) - (tramp-set-connection-property v "process-buffer" nil)) + ;; Reset the transfer process properties. + (tramp-message orig-vec 6 "%s" (buffer-string)) + (tramp-set-connection-property v "process-name" nil) + (tramp-set-connection-property v "process-buffer" nil))) ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) @@ -2524,7 +2527,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (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 +2537,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." ;; 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 +2596,7 @@ the result will be a local, non-Tramp, filename." 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. @@ -2903,7 +2905,7 @@ the result will be a local, non-Tramp, filename." v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) - (let* ((size (nth 7 (file-attributes filename))) + (let* ((size (nth 7 (file-attributes (file-truename filename)))) (rem-enc (tramp-get-inline-coding v "remote-encoding" size)) (loc-dec (tramp-get-inline-coding v "local-decoding" size)) (tmpfile (tramp-compat-make-temp-file filename))) @@ -3496,8 +3498,7 @@ This function expects to be in the right *tramp* buffer." (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 +3648,7 @@ process to set up. VEC specifies the connection." ;; 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 +3859,11 @@ and end of region, and are expected to replace the region contents 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") @@ -4108,22 +4113,10 @@ Gateway hops are already opened." (let ((gw (pop target-alist)) (hop (pop target-alist))) ;; Is the method prepared for gateways? - (unless (tramp-get-method-parameter - (tramp-file-name-method hop) 'tramp-default-port) + (unless (tramp-file-name-port hop) (tramp-error vec 'file-error - "Method `%s' is not supported for gateway access." - (tramp-file-name-method hop))) - ;; Add default port if needed. - (unless - (string-match - tramp-host-with-port-regexp (tramp-file-name-host hop)) - (aset hop 2 - (concat - (tramp-file-name-host hop) tramp-prefix-port-format - (number-to-string - (tramp-get-method-parameter - (tramp-file-name-method hop) 'tramp-default-port))))) + "Connection `%s' is not supported for gateway access." hop)) ;; Open the gateway connection. (add-to-list 'target-alist @@ -4243,7 +4236,7 @@ connection if a previous connection has died for some reason." (p (let ((default-directory (tramp-compat-temporary-file-directory))) (start-process - (or process-name (tramp-buffer-name vec)) + (tramp-get-connection-name vec) (tramp-get-connection-buffer vec) tramp-encoding-shell)))) @@ -4359,6 +4352,11 @@ function waits for output unless NOOUTPUT is set." ;; We mark the command string that it can be erased in the output buffer. (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 to avoid + ;; multiple prompts. + (setq command (concat "(PS1= ; " command "\n)"))) + ;; Send the command. (tramp-message vec 6 "%s" command) (tramp-send-string vec command) (unless nooutput (tramp-wait-for-output p)))) @@ -4382,8 +4380,7 @@ function waits for output unless NOOUTPUT is set." ;; 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. @@ -4445,7 +4442,7 @@ In case there is no valid Lisp expression, it raises an error" (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 @@ -4897,54 +4894,57 @@ If no corresponding command is found, nil is returned. Otherwise, either a string is returned which contains a `%s' mark to be used for the respective input or output file; or a Lisp function cell is returned to be applied on a buffer." - (let ((coding - (with-connection-property vec prop - (tramp-find-inline-encoding vec) - (tramp-get-connection-property vec prop nil))) - (prop1 (if (string-match "encoding" prop) - "inline-compress" "inline-decompress")) - compress) - ;; The connection property might have been cached. So we must send - ;; the script to the remote side - maybe. - (when (and coding (symbolp coding) (string-match "remote" prop)) - (let ((name (symbol-name coding))) - (while (string-match (regexp-quote "-") name) - (setq name (replace-match "_" nil t name))) - (tramp-maybe-send-script vec (symbol-value coding) name) - (setq coding name))) - (when coding - ;; Check for the `compress' command. - (setq compress (tramp-get-inline-compress vec prop1 size)) - ;; Return the value. - (cond - ((and compress (symbolp coding)) - (if (string-match "decompress" prop1) + ;; We must catch the errors, because we want to return `nil', when + ;; no inline coding is found. + (ignore-errors + (let ((coding + (with-connection-property vec prop + (tramp-find-inline-encoding vec) + (tramp-get-connection-property vec prop nil))) + (prop1 (if (string-match "encoding" prop) + "inline-compress" "inline-decompress")) + compress) + ;; The connection property might have been cached. So we must + ;; send the script to the remote side - maybe. + (when (and coding (symbolp coding) (string-match "remote" prop)) + (let ((name (symbol-name coding))) + (while (string-match (regexp-quote "-") name) + (setq name (replace-match "_" nil t name))) + (tramp-maybe-send-script vec (symbol-value coding) name) + (setq coding name))) + (when coding + ;; Check for the `compress' command. + (setq compress (tramp-get-inline-compress vec prop1 size)) + ;; Return the value. + (cond + ((and compress (symbolp coding)) + (if (string-match "decompress" prop1) + `(lambda (beg end) + (,coding beg end) + (let ((coding-system-for-write 'binary) + (coding-system-for-read 'binary)) + (apply + 'call-process-region (point-min) (point-max) + (car (split-string ,compress)) t t nil + (cdr (split-string ,compress))))) `(lambda (beg end) - (,coding beg end) (let ((coding-system-for-write 'binary) (coding-system-for-read 'binary)) (apply - 'call-process-region (point-min) (point-max) + 'call-process-region beg end (car (split-string ,compress)) t t nil - (cdr (split-string ,compress))))) - `(lambda (beg end) - (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary)) - (apply - 'call-process-region beg end - (car (split-string ,compress)) t t nil - (cdr (split-string ,compress)))) - (,coding (point-min) (point-max))))) - ((symbolp coding) - coding) - ((and compress (string-match "decoding" prop)) - (format "(%s | %s >%%s)" coding compress)) - (compress - (format "(%s <%%s | %s)" compress coding)) - ((string-match "decoding" prop) - (format "%s >%%s" coding)) - (t - (format "%s <%%s" coding)))))) + (cdr (split-string ,compress)))) + (,coding (point-min) (point-max))))) + ((symbolp coding) + coding) + ((and compress (string-match "decoding" prop)) + (format "(%s | %s >%%s)" coding compress)) + (compress + (format "(%s <%%s | %s)" compress coding)) + ((string-match "decoding" prop) + (format "%s >%%s" coding)) + (t + (format "%s <%%s" coding))))))) ;;; Integration of eshell.el: diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index d2308216821..b54bbf1fa56 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -49,7 +49,7 @@ ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method, ;; the anonymous user is chosen. (add-to-list 'tramp-default-user-alist - `(,tramp-smb-method nil "")) + `(,(concat "\\`" tramp-smb-method "\\'") nil nil)) ;; Add completion function for SMB method. (tramp-set-completion-function @@ -1079,7 +1079,7 @@ If SHARE is result, entries are of type dir. Otherwise, shares are listed. 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 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (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 @@ Returns nil if an error message has appeared." ;; regular again. ;; * Make it multi-hop capable. -;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5 ;;; tramp-smb.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7b2d8a0a6e6..f7d3b81039e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -331,9 +331,9 @@ empty string for the user name. See `tramp-methods' for a list of possibilities for METHOD." :group 'tramp - :type '(repeat (list (regexp :tag "Host regexp") - (regexp :tag "User regexp") - (string :tag "Method")))) + :type '(repeat (list (choice :tag "Host regexp" regexp sexp) + (choice :tag "User regexp" regexp sexp) + (choice :tag "Method name" string (const nil))))) (defcustom tramp-default-user nil "*Default user to use for transferring files. @@ -355,9 +355,9 @@ matches, the variable `tramp-default-user' takes effect. If the file name does not specify the method, lookup is done using the empty string for the method name." :group 'tramp - :type '(repeat (list (regexp :tag "Method regexp") - (regexp :tag "Host regexp") - (string :tag "User")))) + :type '(repeat (list (choice :tag "Method regexp" regexp sexp) + (choice :tag " Host regexp" regexp sexp) + (choice :tag " User name" string (const nil))))) (defcustom tramp-default-host (system-name) "*Default host to use for transferring files. @@ -382,11 +382,14 @@ interpreted as a regular expression which always matches." :group 'tramp :type '(repeat (list (choice :tag "Host regexp" regexp sexp) (choice :tag "User regexp" regexp sexp) - (choice :tag "Proxy remote name" string (const nil))))) + (choice :tag " Proxy name" string (const nil))))) (defconst tramp-local-host-regexp (concat - "^" (regexp-opt (list "localhost" (system-name) "127\.0\.0\.1" "::1") t) "$") + "\\`" + (regexp-opt + (list "localhost" "localhost6" (system-name) "127\.0\.0\.1" "::1") t) + "\\'") "*Host names which are regarded as local host.") (defvar tramp-completion-function-alist nil @@ -1066,10 +1069,12 @@ calling HANDLER.") (defun tramp-file-name-port (vec) "Return the port number of VEC." (save-match-data - (let ((host (tramp-file-name-host vec))) - (and (stringp host) - (string-match tramp-host-with-port-regexp host) - (string-to-number (match-string 2 host)))))) + (let ((method (tramp-file-name-method vec)) + (host (tramp-file-name-host vec))) + (or (and (stringp host) + (string-match tramp-host-with-port-regexp host) + (string-to-number (match-string 2 host))) + (tramp-get-method-parameter method 'tramp-default-port))))) ;;;###tramp-autoload (defun tramp-tramp-file-p (name) @@ -1205,13 +1210,18 @@ from `tramp-get-buffer'." (or (tramp-get-connection-property vec "process-buffer" nil) (tramp-get-buffer vec))) +(defun tramp-get-connection-name (vec) + "Get the connection name to be used for VEC. +In case a second asynchronous communication has been started, it is different +from the default one." + (or (tramp-get-connection-property vec "process-name" nil) + (tramp-buffer-name vec))) + (defun tramp-get-connection-process (vec) "Get the connection process to be used for VEC. In case a second asynchronous communication has been started, it is different from the default one." - (get-process - (or (tramp-get-connection-property vec "process-name" nil) - (tramp-buffer-name vec)))) + (get-process (tramp-get-connection-name vec))) (defun tramp-debug-buffer-name (vec) "A name for the debug buffer for VEC." @@ -1284,7 +1294,7 @@ ARGS to actually emit the message (if applicable)." (setq fn (symbol-name btf)) (unless (and (string-match "^tramp" fn) (not (string-match - "^tramp\\(-debug\\)?\\(-message\\|-error\\|-compat-funcall\\)$" + "^tramp\\(-debug\\)?\\(-message\\|-error\\|-compat\\(-funcall\\|-with-temp-message\\)\\)$" fn))) (setq fn nil))) (setq btn (1+ btn)))) @@ -1454,7 +1464,7 @@ progress reporter." (if (memq system-type '(cygwin windows-nt)) (defun tramp-drop-volume-letter (name) "Cut off unnecessary drive letter from file NAME. -The function `tramp-handle-expand-file-name' calls `expand-file-name' +The functions `tramp-*-handle-expand-file-name' call `expand-file-name' locally on a remote file name. When the local system is a W32 system but the remote system is Unix, this introduces a superfluous drive letter into the file name. This function removes it." @@ -2352,7 +2362,7 @@ Either user or host may be nil." (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 +2389,7 @@ User is always nil." 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 +2418,7 @@ User is always nil." 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 +2479,7 @@ User is always nil." (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 +2514,7 @@ Host is always \"localhost\"." 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 +2544,7 @@ User may be nil." (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 +2570,7 @@ User is always nil." 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) @@ -3659,7 +3669,6 @@ Only works for Bourne-like shells." ;; 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 @@ -3671,7 +3680,6 @@ Only works for Bourne-like shells." ;; 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: diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 7690e859310..005fbb932a2 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -32,7 +32,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.0-pre" +(defconst tramp-version "2.2.1-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -45,7 +45,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.0-pre is not fit for %s" + (format "Tramp 2.2.1-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) @@ -56,7 +56,6 @@ (provide 'trampver) -;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1 ;;; trampver.el ends here ;; Local Variables: diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 8daf24d549f..3227d2ac539 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -187,21 +187,58 @@ This should generally stay 0, except for a few modes like Lisp where it is 1 so that regions are commented with two or three semi-colons.") (defconst comment-styles - '((plain . (nil nil nil nil)) - (indent . (nil nil nil t)) - (indent-or-triple - . (nil nil nil multi-char)) - (aligned . (nil t nil t)) - (multi-line . (t nil nil t)) - (extra-line . (t nil t t)) - (box . (nil t t t)) - (box-multi . (t t t t))) - "Comment region styles of the form (STYLE . (MULTI ALIGN EXTRA INDENT)). + '((plain nil nil nil nil + "Start in column 0 (do not indent), as in Emacs-20") + (indent-or-triple nil nil nil multi-char + "Start in column 0, but only for single-char starters") + (indent nil nil nil t + "Full comment per line, ends not aligned") + (aligned nil t nil t + "Full comment per line, ends aligned") + (box nil t t t + "Full comment per line, ends aligned, + top and bottom") + (extra-line t nil t t + "One comment for all lines, end on a line by itself") + (multi-line t nil nil t + "One comment for all lines, end on last commented line") + (box-multi t t t t + "One comment for all lines, + top and bottom")) + "Comment region style definitions. +Each style is defined with a form (STYLE . (MULTI ALIGN EXTRA INDENT DOC)). +DOC should succinctly describe the style. STYLE should be a mnemonic symbol. MULTI specifies that comments are allowed to span multiple lines. + e.g. in C it comments regions as + /* blabla + * bli */ + rather than + /* blabla */ + /* bli */ + if `comment-end' is empty, this has no effect. + ALIGN specifies that the `comment-end' markers should be aligned. + e.g. in C it comments regions as + /* blabla */ + /* bli */ + rather than + /* blabla */ + /* bli */ + if `comment-end' is empty, this has no effect, unless EXTRA is also set, + in which case the comment gets wrapped in a box. + EXTRA specifies that an extra line should be used before and after the region to comment (to put the `comment-end' and `comment-start'). + e.g. in C it comments regions as + /* + * blabla + * bli + */ + rather than + /* blabla + * bli */ + if the comment style is not multi line, this has no effect, unless ALIGN + is also set, in which case the comment gets wrapped in a box. + INDENT specifies that the `comment-start' markers should not be put at the left margin but at the current indentation of the region to comment. If INDENT is `multi-char', that means indent multi-character @@ -212,8 +249,11 @@ If INDENT is `multi-char', that means indent multi-character "Style to be used for `comment-region'. See `comment-styles' for a list of available styles." :type (if (boundp 'comment-styles) - `(choice ,@(mapcar (lambda (s) `(const ,(car s))) - comment-styles)) + `(choice + ,@(mapcar (lambda (s) + `(const :tag ,(format "%s: %s" (car s) (nth 5 s)) + ,(car s))) + comment-styles)) 'symbol) :version "23.1" :group 'comment) @@ -1164,8 +1204,8 @@ is passed on to the respective function." (defun comment-dwim (arg) "Call the comment command you want (Do What I Mean). If the region is active and `transient-mark-mode' is on, call - `comment-region' (unless it only consists of comments, in which - case it calls `uncomment-region'). +`comment-region' (unless it only consists of comments, in which +case it calls `uncomment-region'). Else, if the current line is empty, call `comment-insert-comment-function' if it is defined, otherwise insert a comment and indent it. Else if a prefix ARG is specified, call `comment-kill'. diff --git a/lisp/novice.el b/lisp/novice.el index c7cbccfa02c..47b32fcde8a 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -1,7 +1,7 @@ ;;; novice.el --- handling of disabled commands ("novice mode") for Emacs -;; Copyright (C) 1985, 1986, 1987, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1994, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal, help @@ -110,9 +110,9 @@ SPC to try the command just this once, but leave it disabled. (not (string= "" user-init-file)) (y-or-n-p "Enable command for future editing sessions also? ")) (enable-command cmd) - (put cmd 'disabled nil))) - (?n nil) - (t (call-interactively cmd))))) + (put cmd 'disabled nil)))) + (or (char-equal char ?n) + (call-interactively cmd)))) (defun en/disable-command (command disable) (unless (commandp command) @@ -169,5 +169,4 @@ to future sessions." (provide 'novice) -;; arch-tag: f83c0f96-497e-4db6-a430-8703716c6dd9 ;;; novice.el ends here diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el index 5062da5cff9..a10ad2b21ac 100644 --- a/lisp/nxml/nxml-maint.el +++ b/lisp/nxml/nxml-maint.el @@ -1,6 +1,7 @@ ;;; nxml-maint.el --- commands for maintainers of nxml-*.el -;; Copyright (C) 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML @@ -78,7 +79,7 @@ (goto-char (point-min)) (while (re-search-forward "^ *\\([a-FA-F0-9]\\{2\\}\\)[ \t]+" nil t) (let ((row (match-string 1)) - (eol (save-excursion (end-of-line) (point)))) + (eol (line-end-position))) (while (re-search-forward "\\([a-FA-F0-9]\\{2\\}\\)-\\([a-FA-F0-9]\\{2\\}\\)\\|\\([a-FA-F0-9]\\{2\\}\\)" eol t) (setq lst (cons (if (match-beginning 3) @@ -102,5 +103,4 @@ (provide 'nxml-maint) -;; arch-tag: 2cff6b55-12af-47db-90da-a91f782f435a ;;; nxml-maint.el ends here diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index b428d8bf224..d1cffdd38a2 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -1,6 +1,7 @@ ;;; nxml-mode.el --- a new XML mode -;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML @@ -37,9 +38,10 @@ (require 'nxml-util) (require 'nxml-rap) (require 'nxml-outln) - -(declare-function rng-nxml-mode-init "rng-nxml") -(declare-function nxml-enable-unicode-char-name-sets "nxml-uchnm") +;; nxml-mode calls rng-nxml-mode-init, which is autoloaded from rng-nxml. +;; So we might as well just require it and silence the compiler. +(provide 'nxml-mode) ; avoid recursive require +(require 'rng-nxml) ;;; Customization @@ -52,38 +54,33 @@ :group 'nxml) (defcustom nxml-char-ref-display-glyph-flag t - "*Non-nil means display glyph following character reference. + "Non-nil means display glyph following character reference. The glyph is displayed in face `nxml-glyph'. The hook `nxml-glyph-set-hook' can be used to customize for which characters glyphs are displayed." :group 'nxml :type 'boolean) -(defcustom nxml-mode-hook nil - "Hook run by command `nxml-mode'." - :group 'nxml - :type 'hook) - (defcustom nxml-sexp-element-flag nil - "*Non-nil means sexp commands treat an element as a single expression." + "Non-nil means sexp commands treat an element as a single expression." :group 'nxml :type 'boolean) (defcustom nxml-slash-auto-complete-flag nil - "*Non-nil means typing a slash automatically completes the end-tag. + "Non-nil means typing a slash automatically completes the end-tag. This is used by `nxml-electric-slash'." :group 'nxml :type 'boolean) (defcustom nxml-child-indent 2 - "*Indentation for the children of an element relative to the start-tag. + "Indentation for the children of an element relative to the start-tag. This only applies when the line or lines containing the start-tag contains nothing else other than that start-tag." :group 'nxml :type 'integer) (defcustom nxml-attribute-indent 4 - "*Indentation for the attributes of an element relative to the start-tag. + "Indentation for the attributes of an element relative to the start-tag. This only applies when the first attribute of a tag starts a line. In other cases, the first attribute on one line is indented the same as the first attribute on the previous line." @@ -91,7 +88,7 @@ as the first attribute on the previous line." :type 'integer) (defcustom nxml-bind-meta-tab-to-complete-flag (not window-system) - "*Non-nil means bind M-TAB in `nxml-mode-map' to `nxml-complete'. + "Non-nil means bind M-TAB in `nxml-mode-map' to `nxml-complete'. C-return will be bound to `nxml-complete' in any case. M-TAB gets swallowed by many window systems/managers, and `documentation' will show M-TAB rather than C-return as the @@ -105,7 +102,7 @@ to bind M-TAB only when it will work." :type 'boolean) (defcustom nxml-prefer-utf-16-to-utf-8-flag nil - "*Non-nil means prefer UTF-16 to UTF-8 when saving a buffer. + "Non-nil means prefer UTF-16 to UTF-8 when saving a buffer. This is used only when a buffer does not contain an encoding declaration and when its current `buffer-file-coding-system' specifies neither UTF-16 nor UTF-8." @@ -114,7 +111,7 @@ nor UTF-8." (defcustom nxml-prefer-utf-16-little-to-big-endian-flag (eq system-type 'windows-nt) - "*Non-nil means prefer little-endian to big-endian byte-order for UTF-16. + "Non-nil means prefer little-endian to big-endian byte-order for UTF-16. This is used only for saving a buffer; when reading the byte-order is auto-detected. It may be relevant both when there is no encoding declaration and when the encoding declaration specifies `UTF-16'." @@ -122,14 +119,14 @@ and when the encoding declaration specifies `UTF-16'." :type 'boolean) (defcustom nxml-default-buffer-file-coding-system nil - "*Default value for `buffer-file-coding-system' for a buffer for a new file. + "Default value for `buffer-file-coding-system' for a buffer for a new file. A value of nil means use the default value of `buffer-file-coding-system' as normal. A buffer's `buffer-file-coding-system' affects what \\[nxml-insert-xml-declaration] inserts." :group 'nxml :type 'coding-system) (defcustom nxml-auto-insert-xml-declaration-flag nil - "*Non-nil means automatically insert an XML declaration in a new file. + "Non-nil means automatically insert an XML declaration in a new file. The XML declaration is inserted using `nxml-insert-xml-declaration'." :group 'nxml :type 'boolean) @@ -354,6 +351,12 @@ The delimiters are <! and >." ;;; Global variables +(defvar nxml-parent-document nil + "The parent document for a part of a modular document. +Use `nxml-parent-document-set' to set it.") +(make-variable-buffer-local 'nxml-parent-document) +(put 'nxml-parent-document 'safe-local-variable 'stringp) + (defvar nxml-prolog-regions nil "List of regions in the prolog to be fontified. See the function `xmltok-forward-prolog' for more information.") @@ -404,6 +407,7 @@ reference.") (define-key map "\M-}" 'nxml-forward-paragraph) (define-key map "\M-h" 'nxml-mark-paragraph) (define-key map "\C-c\C-f" 'nxml-finish-element) + (define-key map "\C-c]" 'nxml-finish-element) (define-key map "\C-c/" 'nxml-finish-element) (define-key map "\C-c\C-m" 'nxml-split-element) (define-key map "\C-c\C-b" 'nxml-balanced-close-start-tag-block) @@ -429,8 +433,40 @@ reference.") (when (and face (< start end)) (font-lock-append-text-property start end 'face face))) +(defun nxml-parent-document-set (parent-document) + "Set `nxml-parent-document' and inherit the DTD &c." + ;; FIXME: this does not work. + ;; the idea is that by inheriting some variables from the parent, + ;; `rng-validate-mode' will validate entities declared in the parent. + ;; alas, the most interesting variables (`rng-compile-table' et al) + ;; are circular and cannot be printed even with `print-circle'. + (interactive "fParent document") + (let (dtd current-schema current-schema-file-name compile-table + ipattern-table last-ipattern-index) + (when (string= (file-truename parent-document) + (file-truename buffer-file-name)) + (error "Parent document cannot be the same as the document")) + (with-current-buffer (find-file-noselect parent-document) + (setq dtd rng-dtd + current-schema rng-current-schema + current-schema-file-name rng-current-schema-file-name + compile-table rng-compile-table + ipattern-table rng-ipattern-table + last-ipattern-index rng-last-ipattern-index + parent-document buffer-file-name)) + (setq rng-dtd dtd + rng-current-schema current-schema + rng-current-schema-file-name current-schema-file-name + rng-compile-table compile-table + rng-ipattern-table ipattern-table + rng-last-ipattern-index last-ipattern-index + nxml-parent-document parent-document) + (message "Set parent document to %s" parent-document) + (when rng-validate-mode + (rng-validate-while-idle (current-buffer))))) + ;;;###autoload -(defun nxml-mode () +(define-derived-mode nxml-mode text-mode "nXML" ;; We use C-c C-i instead of \\[nxml-balanced-close-start-tag-inline] ;; because Emacs turns C-c C-i into C-c TAB which is hard to type and ;; not mnemonic. @@ -484,10 +520,7 @@ be treated as a single markup item, set the variable Many aspects this mode can be customized using \\[customize-group] nxml RET." - (interactive) - (kill-all-local-variables) - (setq major-mode 'nxml-mode) - (setq mode-name "nXML") + ;; (kill-all-local-variables) (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded"))) ;; We'll determine the fill prefix ourselves (make-local-variable 'adaptive-fill-mode) @@ -551,8 +584,7 @@ Many aspects this mode can be customized using (font-lock-unfontify-region-function . nxml-unfontify-region))) (rng-nxml-mode-init) - (nxml-enable-unicode-char-name-sets) - (run-mode-hooks 'nxml-mode-hook)) + (nxml-enable-unicode-char-name-sets)) (defun nxml-cleanup () "Clean up after nxml-mode." @@ -2663,5 +2695,4 @@ With a prefix argument, inserts the character directly." (provide 'nxml-mode) -;; arch-tag: 8603bc5f-1ef9-4021-b223-322fb2ca708e ;;; nxml-mode.el ends here diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index d9c340eb22d..1afc4e9e5e8 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -1,6 +1,7 @@ ;;; nxml-outln.el --- outline support for nXML mode -;; Copyright (C) 2004, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML @@ -82,7 +83,7 @@ (defcustom nxml-section-element-name-regexp "article\\|\\(sub\\)*section\\|chapter\\|div\\|appendix\\|part\\|preface\\|reference\\|simplesect\\|bibliography\\|bibliodiv\\|glossary\\|glossdiv" - "*Regular expression matching the name of elements used as sections. + "Regular expression matching the name of elements used as sections. An XML element is treated as a section if: - its local name (that is, the name without the prefix) matches @@ -97,7 +98,7 @@ element has a local name matching the variable :type 'regexp) (defcustom nxml-heading-element-name-regexp "title\\|head" - "*Regular expression matching the name of elements used as headings. + "Regular expression matching the name of elements used as headings. An XML element is only recognized as a heading if it occurs as or within the first child of an element that is recognized as a section. See the variable `nxml-section-element-name-regexp' for more details." @@ -105,7 +106,7 @@ See the variable `nxml-section-element-name-regexp' for more details." :type 'regexp) (defcustom nxml-outline-child-indent 2 - "*Indentation in an outline for child element relative to parent element." + "Indentation in an outline for child element relative to parent element." :group 'nxml :type 'integer) @@ -1037,5 +1038,4 @@ immediately after the section's start-tag." (provide 'nxml-outln) -;; arch-tag: 1f1b7454-e573-4cd7-a505-d9dc64eef828 ;;; nxml-outln.el ends here diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el index 5ba52c3e123..35ec87a8c45 100644 --- a/lisp/nxml/rng-loc.el +++ b/lisp/nxml/rng-loc.el @@ -1,6 +1,7 @@ ;;; rng-loc.el --- locate the schema to use for validation -;; Copyright (C) 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML, RelaxNG @@ -48,7 +49,7 @@ It is nil if using a vacuous schema.") "Schema for schema locating files or nil if not yet loaded.") (defcustom rng-schema-locating-files rng-schema-locating-files-default - "*List of schema locating files." + "List of schema locating files." :type '(repeat file) :group 'relax-ng) @@ -546,5 +547,4 @@ saved to the first writable file in `rng-schema-locating-files'." (provide 'rng-loc) -;; arch-tag: 725cf968-37a2-418b-b47b-d5209871a9ab ;;; rng-loc.el ends here diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index 858d9206e64..96e3525410a 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -1,6 +1,7 @@ ;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode -;; Copyright (C) 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML, RelaxNG @@ -35,7 +36,7 @@ (require 'rng-loc) (defcustom rng-nxml-auto-validate-flag t - "*Non-nil means automatically turn on validation with nxml-mode." + "Non-nil means automatically turn on validation with nxml-mode." :type 'boolean :group 'relax-ng) @@ -47,7 +48,7 @@ ("http://www.w3.org/2001/XMLSchema-instance" . "xsi") ("http://purl.org/dc/elements/1.1/" . "dc") ("http://purl.org/dc/terms/" . "dcterms")) - "*Alist of namespaces vs preferred prefixes." + "Alist of namespaces vs preferred prefixes." :type '(repeat (cons :tag "With" (string :tag "this namespace URI") (string :tag "use this prefix"))) @@ -591,5 +592,4 @@ set `xmltok-dtd'. Returns the position of the end of the token." (provide 'rng-nxml) -;; arch-tag: bec0d6ed-6be1-4540-9c2c-6f56e8e55d8b ;;; rng-nxml.el ends here diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 4756b50dcc7..f55601b3224 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -1,6 +1,7 @@ ;;; rng-valid.el --- real-time validation of XML using RELAX NG -;; Copyright (C) 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML, RelaxNG @@ -110,12 +111,12 @@ :group 'relax-ng) (defcustom rng-state-cache-distance 2000 - "*Distance in characters between each parsing and validation state cache." + "Distance in characters between each parsing and validation state cache." :type 'integer :group 'relax-ng) (defcustom rng-validate-chunk-size 8000 - "*Number of characters in a RELAX NG validation chunk. + "Number of characters in a RELAX NG validation chunk. A validation chunk will be the smallest chunk that is at least this size and ends with a tag. After validating a chunk, validation will continue only if Emacs is still idle." @@ -123,14 +124,14 @@ continue only if Emacs is still idle." :group 'relax-ng) (defcustom rng-validate-delay 1.5 - "*Time in seconds that Emacs must be idle before starting a full validation. + "Time in seconds that Emacs must be idle before starting a full validation. A full validation continues until either validation is up to date or Emacs is no longer idle." :type 'number :group 'relax-ng) (defcustom rng-validate-quick-delay 0.3 - "*Time in seconds that Emacs must be idle before starting a quick validation. + "Time in seconds that Emacs must be idle before starting a quick validation. A quick validation validates at most one chunk." :type 'number :group 'relax-ng) @@ -518,6 +519,9 @@ Return t if there is work to do, nil otherwise." (goto-char pos)) (t (rng-set-initial-state)))))))))) +(defun rng-dtd-trivial-p (dtd) + "Check whether the current dtd is different from the trivial default." + (or (null dtd) (eq dtd xmltok-predefined-entity-alist))) (defun rng-do-some-validation-1 (&optional continue-p-function) (let ((limit (+ rng-validate-up-to-date-end @@ -1461,5 +1465,4 @@ string between START and END." (provide 'rng-valid) -;; arch-tag: 7dd846d3-519d-4a6d-8107-4ff0024a60ef ;;; rng-valid.el ends here diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el index ae1f32537b0..b425498e182 100644 --- a/lisp/obsolete/lazy-lock.el +++ b/lisp/obsolete/lazy-lock.el @@ -310,7 +310,7 @@ until TEST returns nil." ;; User Variables: (defcustom lazy-lock-minimum-size 25600 - "*Minimum size of a buffer for demand-driven fontification. + "Minimum size of a buffer for demand-driven fontification. On-demand fontification occurs if the buffer size is greater than this value. If nil, means demand-driven fontification is never performed. If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), @@ -334,7 +334,7 @@ The value of this variable is used when Lazy Lock mode is turned on." :group 'lazy-lock) (defcustom lazy-lock-defer-on-the-fly t - "*If non-nil, means fontification after a change should be deferred. + "If non-nil, means fontification after a change should be deferred. If nil, means on-the-fly fontification is performed. This means when changes occur in the buffer, those areas are immediately fontified. If a list, it should be a list of `major-mode' symbol names for which deferred @@ -354,7 +354,7 @@ The value of this variable is used when Lazy Lock mode is turned on." :group 'lazy-lock) (defcustom lazy-lock-defer-on-scrolling nil - "*If non-nil, means fontification after a scroll should be deferred. + "If non-nil, means fontification after a scroll should be deferred. If nil, means demand-driven fontification is performed. This means when scrolling into unfontified areas of the buffer, those areas are immediately fontified. Thus scrolling never presents unfontified areas. However, since @@ -379,7 +379,7 @@ The value of this variable is used when Lazy Lock mode is turned on." :group 'lazy-lock) (defcustom lazy-lock-defer-contextually 'syntax-driven - "*If non-nil, means deferred fontification should be syntactically true. + "If non-nil, means deferred fontification should be syntactically true. If nil, means deferred fontification occurs only on those lines modified. This means where modification on a line causes syntactic change on subsequent lines, those subsequent lines are not refontified to reflect their new context. @@ -396,9 +396,8 @@ The value of this variable is used when Lazy Lock mode is turned on." (other :tag "syntax-driven" syntax-driven)) :group 'lazy-lock) -(defcustom lazy-lock-defer-time - (if (featurep 'lisp-float-type) (/ (float 1) (float 4)) 1) - "*Time in seconds to delay before beginning deferred fontification. +(defcustom lazy-lock-defer-time 0.25 + "Time in seconds to delay before beginning deferred fontification. Deferred fontification occurs if there is no input within this time. If nil, means fontification is never deferred, regardless of the values of the variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and @@ -410,7 +409,7 @@ The value of this variable is used when Lazy Lock mode is turned on." :group 'lazy-lock) (defcustom lazy-lock-stealth-time 30 - "*Time in seconds to delay before beginning stealth fontification. + "Time in seconds to delay before beginning stealth fontification. Stealth fontification occurs if there is no input within this time. If nil, means stealth fontification is never performed. @@ -420,7 +419,7 @@ The value of this variable is used when Lazy Lock mode is turned on." :group 'lazy-lock) (defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250) - "*Maximum size of a chunk of stealth fontification. + "Maximum size of a chunk of stealth fontification. Each iteration of stealth fontification can fontify this number of lines. To speed up input response during stealth fontification, at the cost of stealth taking longer to fontify, you could reduce the value of this variable." @@ -429,7 +428,7 @@ taking longer to fontify, you could reduce the value of this variable." (defcustom lazy-lock-stealth-load (if (condition-case nil (load-average) (error)) 200) - "*Load in percentage above which stealth fontification is suspended. + "Load in percentage above which stealth fontification is suspended. Stealth fontification pauses when the system short-term load average (as returned by the function `load-average' if supported) goes above this level, thus reducing the demand that stealth fontification makes on the system. @@ -443,9 +442,8 @@ See also `lazy-lock-stealth-nice'." '(const :format "%t: unsupported\n" nil)) :group 'lazy-lock) -(defcustom lazy-lock-stealth-nice - (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1) - "*Time in seconds to pause between chunks of stealth fontification. +(defcustom lazy-lock-stealth-nice 0.125 + "Time in seconds to pause between chunks of stealth fontification. Each iteration of stealth fontification is separated by this amount of time, thus reducing the demand that stealth fontification makes on the system. If nil, means stealth fontification is never paused. @@ -457,9 +455,8 @@ See also `lazy-lock-stealth-load'." :group 'lazy-lock) (defcustom lazy-lock-stealth-verbose - (if (featurep 'lisp-float-type) - (and (not lazy-lock-defer-contextually) (not (null font-lock-verbose)))) - "*If non-nil, means stealth fontification should show status messages." + (and (not lazy-lock-defer-contextually) (not (null font-lock-verbose))) + "If non-nil, means stealth fontification should show status messages." :type 'boolean :group 'lazy-lock) @@ -1058,5 +1055,4 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'." ;; byte-compile-warnings: (not obsolete) ;; End: -;; arch-tag: c1776846-f046-4a45-9684-54b951b12fc9 ;;; lazy-lock.el ends here diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el index a83d6f2164b..a35cde02290 100644 --- a/lisp/obsolete/lucid.el +++ b/lisp/obsolete/lucid.el @@ -234,5 +234,8 @@ This is an XEmacs compatibility function." (provide 'lucid) -;; arch-tag: 80f9ab46-0b36-4151-86ed-3edb6d449c9e +;; Local Variables: +;; byte-compile-warnings: (not cl-functions) +;; End: + ;;; lucid.el ends here diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 0cef225770d..29295d67d17 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,3338 @@ +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 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): @@ -362,11 +3697,6 @@ 2010-07-19 Eric Schulte <schulte.eric@gmail.com> - * Makefile (lisp/org-install.el): Replace babel files in - construction of org-install.el. - -2010-07-19 Eric Schulte <schulte.eric@gmail.com> - * org-table.el (orgtbl-to-generic): Add the :remove-newlines option which will strip newline characters from the text of table cells and replace then with "\n". @@ -513,10 +3843,6 @@ * org-html.el (org-export-html-close-lists-maybe): Check if raw HTML stuff was actually made from an example. -2010-07-19 Eric Schulte <schulte.eric@gmail.com> - - * Makefile (LISPF): Let's not compile files that won't often be used. - 2010-07-19 Bastien Guerry <bzg@altern.org> * org-latex.el: Items are no longer skipped when their first line @@ -7798,7 +11124,7 @@ 2008-10-26 James TD Smith <ahktenzero@mohorovi.cc> - * org.el (org-add-log-setup): Only skip drawers if the are + * org.el (org-add-log-setup): Only skip drawers if they are immediately after the scheduling keywords. * org-clock.el (org-clock-in-switch-to-state): Allow this to be a diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 086079f9082..1c8eac65ace 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -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 @@ is currently being evaluated.") 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 @@ or `org-babel-execute:c++'." (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 @@ it's header arguments." ;; 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))) diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index d990d69b357..81d628e4206 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -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 @@ This function is called by `org-babel-execute-src-block'." ;; 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 @@ This function is called by `org-babel-execute-src-block'." (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 @@ This function is called by `org-babel-execute-src-block'." (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 @@ This function is called by `org-babel-execute-src-block'." (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. diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index 043bc4c5ff7..43d65462612 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -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 @@ This function is called by `org-babel-execute-src-block'." 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 diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el new file mode 100644 index 00000000000..426aafd154f --- /dev/null +++ b/lisp/org/ob-calc.el @@ -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 diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index c42d9b4db38..0a76e827125 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -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 @@ code specifying a variable of the same value." "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 @@ repl buffer." " ")))) (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 @@ return the value of the last statement in BODY as elisp." (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) diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 732f2766b28..d05b7fbfa40 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -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 @@ statement (not large blocks of code)." "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 diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index 0a279b24573..d93f28dcebc 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -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'." diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index 336eaa93f12..a9b6b3ceaf1 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -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) diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index 4657fb80ba0..c78f3dbee0d 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -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) diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index 2ec729f7dcd..f1d41b3db0d 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -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) diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index dea39f12089..57f4dc509aa 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -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 @@ STDERR with `org-babel-eval-error-notify'." (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 @@ specifies the value of ERROR-BUFFER." ;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d -;;; ob-comint.el ends here +;;; ob-eval.el ends here diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 4c074887ef1..52da00103f6 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -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 @@ be indented by this many characters. See `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 @@ none ----- do not display either code or results upon export" (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 @@ options are taken from `org-babel-default-header-args'." (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 @@ options are taken from `org-babel-default-header-args'." 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 @@ The function respects the value of the :exports header argument." (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 @@ Results are prepared in a manner suitable for export by org-mode. 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) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 40543d720b0..053d154610b 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -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 @@ code." (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 @@ code." ;; 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 @@ This function is called by `org-babel-execute-src-block'." (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 @@ This function is called by `org-babel-execute-src-block'." (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 @@ This function is called by `org-babel-execute-src-block'." (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. diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index e0803347a64..1ae8fba66b6 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -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 @@ then create one. Return the initialized session." (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 @@ constructs (header arguments, no-web syntax etc...) are ignored." (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 diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el new file mode 100644 index 00000000000..dc652a95c96 --- /dev/null +++ b/lisp/org/ob-js.el @@ -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 diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el index 3f8e83b4f91..e04d9ade6bc 100644 --- a/lisp/org/ob-keys.el +++ b/lisp/org/ob-keys.el @@ -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 @@ functions which are assigned key bindings, and see ("\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 @@ functions which are assigned key bindings, and see ("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 diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index e5b01463a51..f4cf0802de6 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -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")) +(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 @@ This function is called by `org-babel-execute-src-block'." 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) diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el new file mode 100644 index 00000000000..33ec9d3a898 --- /dev/null +++ b/lisp/org/ob-ledger.el @@ -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 diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el new file mode 100644 index 00000000000..3f9ac673279 --- /dev/null +++ b/lisp/org/ob-lisp.el @@ -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 diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index f806668e2e8..243666c0a1b 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -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 @@ To add files to this list use the `org-babel-lob-ingest' command." ;;;###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 @@ If you change the value of this variable then your files may 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 @@ if so then run the appropriate source block from the Library." (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))))) diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el index 0728edf49dc..c75d806cc62 100644 --- a/lisp/org/ob-matlab.el +++ b/lisp/org/ob-matlab.el @@ -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. diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index a78e0b6bd68..119d28cfba0 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -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'. diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index f5add5c5754..2217118e537 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -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) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index 2cdbaa0468c..d6affecd74d 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -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 @@ delete('%s') (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 @@ end") (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 @@ specifying a variable of the same value." "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 @@ create. Return the initialized session." (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 @@ value of the last statement in BODY, as elisp." 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 @@ value of the last statement in BODY, as elisp." (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 @@ value of the last statement in BODY, as elisp." (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 @@ value of the last statement in BODY, as elisp." "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" diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el new file mode 100644 index 00000000000..86abbabfb13 --- /dev/null +++ b/lisp/org/ob-org.el @@ -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 diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index bfba158d4a8..23c0353fcb0 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -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 @@ return the value of the last statement in BODY, as elisp." (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) diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el new file mode 100644 index 00000000000..37561020cb0 --- /dev/null +++ b/lisp/org/ob-plantuml.el @@ -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 diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index c082188bea7..22cb5337d7a 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -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 @@ This function is called by `org-babel-execute-src-block'." ;; 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 @@ Emacs-lisp table, otherwise return the results as a string." (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 @@ then create. Return the initialized session." (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 @@ def main(): 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" diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 4c344e6761e..e104d6bd693 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -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 @@ return nil." 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 @@ return nil." (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 @@ return nil." (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 @@ return nil." (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 @@ return nil." (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 @@ to \"0:-1\"." (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))) diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index e557c80ef1a..70b46411086 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -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 @@ This function is called by `org-babel-execute-src-block'." ;; 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 @@ return the value of the last statement in BODY, as elisp." ;; 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 @@ return the value of the last statement in BODY, as elisp." (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 @@ return the value of the last statement in BODY, as elisp." (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))))))) diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el index 87f9ff46ecc..7f241e0320d 100644 --- a/lisp/org/ob-sass.el +++ b/lisp/org/ob-sass.el @@ -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) diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el new file mode 100644 index 00000000000..c0e0a3fb6f9 --- /dev/null +++ b/lisp/org/ob-scheme.el @@ -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 diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 7e575aa02ec..206e51b19fe 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -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 @@ In case you want to use a different screen than one selected by your $PATH") '((: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 ")"))) diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el index 072bc91af1c..e86386426cd 100644 --- a/lisp/org/ob-sh.el +++ b/lisp/org/ob-sh.el @@ -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 @@ This function is called by `org-babel-execute-src-block'." ;; 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 @@ var of the same value." (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 @@ 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." ((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." diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 184c755f7b8..78e8a3b4377 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -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) diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 7d6930abd4b..d1fa9ac4c5f 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -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 @@ This function is called by `org-babel-execute-src-block'." (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 @@ This function is called by `org-babel-execute-src-block'." 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) diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index f1506550829..cdc7a6250fe 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -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 @@ references to source-code blocks, to force interpretation of a 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 @@ example above." (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) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 85f69ede357..e197ff37d36 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -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 @@ then the name of the language is used." :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 @@ TARGET-FILE can be used to specify a default export file for all 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 @@ exported source code blocks by language." (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 @@ exported source code blocks by language." (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 @@ references." (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 @@ code blocks by language." (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 @@ source code file. This function uses `comment-region' which 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) diff --git a/lisp/org/ob.el b/lisp/org/ob.el index a58fb4eca8a..fe068de549f 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -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 @@ remove code block execution from the C-c C-c keybinding." "^[ \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 @@ remove code block execution from the C-c C-c keybinding." "{\\([^\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 @@ confirmation from the user. 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 @@ then run `org-babel-pop-to-session'." (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 @@ specific header arguments as well.") '((: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 @@ can not be resolved.") ;;; 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 @@ Optionally supply a value for PARAMS which will be merged with 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)))) - -(defun org-babel-expand-body:generic (body params &optional processed-params) + (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 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 @@ arguments and pop open the results in a preview buffer." (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 @@ session." (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 @@ session." (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 @@ of the source block to the kill ring." (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 @@ results already exist." 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 @@ the current subtree." (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 @@ portions of results lines." ;; 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 @@ may be specified in the properties of the current outline entry." (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 @@ may be specified at the top of the current buffer." "\\([^ \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 @@ Return a cons cell, the `car' of which contains the TABLE less 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 @@ names. Note: this function removes any hlines in TABLE." 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 @@ If the point is not on a source block then return nil." (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 @@ org-babel-named-src-block-regexp." (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 @@ buffer or nil if no such result exists." 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 @@ With optional prefix argument ARG, jump forward ARG many source blocks." "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 @@ following the source block." (if indent (mapconcat (lambda (el) " ") - (number-sequence 1 indent) "") + (org-number-sequence 1 indent) "") "") "#+results" (when hash (concat "["hash"]")) @@ -1130,7 +1353,12 @@ raw ----- results are added directly to the org-mode file. This 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 @@ code ---- the results are extracted in the syntax of the source (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 @@ file's directory then expand relative links." (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 @@ file's directory then expand relative links." (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 @@ parameters when merging lists." ("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 @@ parameters when merging lists." 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 @@ block but are passed literally to the \"example-block\"." #'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 @@ This is taken almost directly from `org-read-prop'." 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 @@ If the table is trivial, then return it as a scalar." (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,22 +1807,78 @@ Fixes a bug in `tramp-handle-call-process-region'." ;; 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." - (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)) +(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) + (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) ;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 68a592b5fae..1c9d6d4a3de 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -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 @@ N days, just insert a special line indicating the size of the gap." :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 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour." "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 @@ the lower-case version of all tags." (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 @@ The following commands are available: (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 @@ Pressing `<' twice means to restrict to the current subtree or region (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 @@ s Search for keywords C Configure custom agenda commands (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 @@ higher priority settings." (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 @@ higher priority settings." ((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 @@ higher priority settings." (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 @@ Drawers will be excluded, also the line with scheduling/deadline info." (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 @@ removed from the entry content. Currently only `planning' is allowed here." 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 @@ bind it in the options section.") (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 @@ dates." (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 @@ dates." (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 @@ in `org-agenda-text-search-extra-files'." (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 @@ The remainder is either a list of TODO keywords, or a state symbol "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 @@ MATCH is being ignored." "\\)\\>")) (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 @@ the documentation of `org-diary'." 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 @@ Any match of REMOVE-RE will be removed from TXT." (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 @@ Any match of REMOVE-RE will be removed from TXT." 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 @@ The modified list may contain inherited tags, and tags matched by (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 @@ HH:MM." (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 @@ HH:MM." (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 the line does not have an effort defined, return nil." (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 @@ Negative selection means regexp must not match for selection of an entry." (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 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (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 @@ The cursor may be at a date in the calendar, or in the Org agenda." (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 @@ The cursor may be at a date in the calendar, or in the Org agenda." (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 @@ the resulting entry will not be shown. When TEXT is empty, switch to (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)))) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index 31ae488d4d8..8c1f9a13a12 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -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 @@ information." ((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 @@ this heading." (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 diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index 730f8bdfa41..b48f8efa1cd 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -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 @@ publishing directory." :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 @@ publishing directory." (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 @@ publishing directory." (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 @@ publishing directory." ;; 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 @@ publishing directory." (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 @@ publishing directory." (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 @@ publishing directory." (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 @@ publishing directory." (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 @@ publishing directory." (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))) diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 573244beed4..d98254cb659 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -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. ;; diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index 0d7b5fa086a..d5a09cab63b 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -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 @@ This is used by Org to re-create the anniversary hash table." (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 @@ This is used by Org to re-create the anniversary hash table." (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." diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el index 06853b8bd63..d3f0f47e45c 100644 --- a/lisp/org/org-beamer.el +++ b/lisp/org/org-beamer.el @@ -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 @@ The need to be after the begin statement of the environment." (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 @@ The need to be after the begin statement of the environment." (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." diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index f7f6595f5a1..b9018b023ba 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -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. ;; diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index c6197d69fb3..2abe5c72bf6 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -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 @@ properties are: 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 @@ Furthermore, the following %-escapes will be replaced with content: 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 @@ calendar | %:type %:date" (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 @@ calendar | %:type %:date" ((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 @@ bypassed." (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 @@ bypassed." (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 @@ bypassed." ;; 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 @@ already gone." (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 @@ already gone." (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 @@ already gone." (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 @@ already gone." ((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 @@ already gone." (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 @@ already gone." (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 @@ already gone." (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 @@ Point will be after the empty lines, so insertion can directly be done." (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 @@ Point will remain at the first line after the inserted text." (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 @@ Point will remain at the first line after the inserted text." (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 @@ Use PREFIX as a prefix for the name of the indirect buffer." (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 @@ The template may still contain \"%?\" for cursor positioning." (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 @@ The template may still contain \"%?\" for cursor positioning." (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 @@ The template may still contain \"%?\" for cursor positioning." "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 @@ The template may still contain \"%?\" for cursor positioning." '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) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index f451cf80792..457a4dcb2f0 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -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 @@ use libnotify if available, or fall back on a message." ((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 @@ the clocking selection, associated with the letter `d'." ;; 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 @@ the clocking selection, associated with the letter `d'." (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 @@ the clocking selection, associated with the letter `d'." (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 @@ the currently selected interval size." (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 @@ the currently selected interval size." (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 @@ the currently selected interval size." (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)) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 8e45fdf3e3c..15dc7b37a62 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -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 @@ This is the compiled version of the format.") (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 @@ This is the compiled version of the format.") (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 @@ Where possible, use the standard interface for changing this line." (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 @@ Where possible, use the standard interface for changing this line." (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 @@ around it." ("@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 @@ Don't set this, this is meant for dynamic scoping.") (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 @@ Don't set this, this is meant for dynamic scoping.") (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 @@ This will add overlays to the date lines, to show the summary for each day." (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) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 1b96b8d0535..324464803f2 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -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 @@ If DELETE is non-nil, delete all those overlays." (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 @@ ignored in this case." (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 @@ TIME defaults to the current time." (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) diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index d93981227e5..693f3ac6a87 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -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> diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index fc6b192e566..71e1b1b6a7e 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -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. ;; diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 331d6d6a1d1..286cdc9a1ae 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -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. ;; diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index 12ab96deff9..7d90ec32fbe 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -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 @@ publishing directory." (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 @@ publishing directory." (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 @@ publishing directory." 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 @@ publishing directory." 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 @@ publishing directory." (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 @@ publishing directory." (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 @@ publishing directory." ;; ``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 @@ publishing directory." (push item-type local-list-type) (push ind local-list-indent) (setq in-local-list t)) - (starter ;; Continue current list + (starter + ;; 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 @@ publishing directory." "???")))))) ;; 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 @@ publishing directory." (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 @@ publishing directory." (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 @@ When TITLE is nil, just close all open levels." ;; 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 @@ When TITLE is nil, just close all open levels." 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) diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index 0ef5df0fda6..0c77b690765 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -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 diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 70c88afa6a2..5ce5fd7531c 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -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. ;; diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index 4676f5b1aaf..3751e68e057 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -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 @@ which defaults to the value of `org-export-blocks-witheld'." (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 diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index c3f27cf0e15..73e0951334d 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -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 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." ("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 just before backend-specific blocks get selected.") 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 @@ This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." :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 @@ modified) list.") (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 @@ modified) list.") (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 @@ modified) list.") (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 @@ on this string to produce the exported version." (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 @@ on this string to produce the exported version." ;; 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 @@ on this string to produce the exported version." (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 @@ on this string to produce the exported version." 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 @@ Also find all ID and CUSTOM_ID properties and store them." (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 @@ the current file." (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 @@ the current file." (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 @@ from the buffer." (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 @@ These special cookies will later be interpreted by the backend." (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 @@ When it is nil, all comments will be removed." (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 @@ When it is nil, all comments will be removed." (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 @@ When it is nil, all comments will be removed." (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 @@ When it is nil, all comments will be removed." 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 @@ can work correctly." (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 @@ TYPE must be a string, any of: (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 @@ in the list) and remove property and value from the list in LISTVAR." (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 @@ INDENT was the original indentation of the block." (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 @@ command." (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 @@ If yes remove the column and the special lines." (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) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 740f2629f2b..e4e17f15c5d 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -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. ;; diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 9d14daea9df..8bda3098e0a 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -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 @@ have been saved." (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 @@ If that property is already present, nothing changes." (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 @@ containing the properties `:guid' and `:item-full-text'." (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 @@ containing the properties `:guid' and `:item-full-text'." 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 @@ formatted as a string, not the original XML data." '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 @@ formatted as a string, not the original XML data." ((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. diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 2a2c4c0f426..2a97b54db6f 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -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 @@ with start and label of the footnote if there is a definition at point." (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 @@ or new, let the user edit the definition of the footnote." (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 @@ ENTRY is (fn-label num-mark definition)." (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. diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index 06285e4b7d1..736cc577ce7 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el @@ -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 @@ NOT READY YET." (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 @@ NOT READY YET." (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 @@ The characters \"&<> will be escaped." (dolist (cc chars) (setq fm-str (concat fm-str - (if (< cc 256) + (if (< cc 160) (cond ((= cc ?\") """) ((= cc ?\&) "&") @@ -265,52 +296,84 @@ will also unescape &#nn;." ))) 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 @@ will also unescape &#nn;." ;;(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 @@ DRAWERS-REGEXP are converted to freemind notes." "<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 @@ DRAWERS-REGEXP are converted to freemind notes." "</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 @@ DRAWERS-REGEXP are converted to freemind notes." (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 @@ Otherwise give an error say the file exists." (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 @@ Otherwise give an error say the file exists." 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 @@ Otherwise give an error say the file exists." ;;;###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 @@ Otherwise give an error say the file exists." ".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 @@ Otherwise give an error say the file exists." ".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 @@ Otherwise give an error say the file exists." "-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 @@ Otherwise give an error say the file exists." (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 @@ PATH should be a list of steps, where each step has the form (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 @@ PATH should be a list of steps, where each step has the form (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 @@ PATH should be a list of steps, where each step has the form (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 @@ PATH should be a list of steps, where each step has the form (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 @@ PATH should be a list of steps, where each step has the form (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 @@ PATH should be a list of steps, where each step has the form (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 diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index f2fca8c29f4..6d782759a75 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -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 @@ negates this setting for the duration of the command." :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 @@ negates this setting for the duration of the command." ;; 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 @@ If `org-store-link' was called with a prefix arg the meaning of (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 @@ If `org-store-link' was called with a prefix arg the meaning of (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 @@ If `org-store-link' was called with a prefix arg the meaning of (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 @@ If `org-store-link' was called with a prefix arg the meaning of (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)) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 71e0a9583f1..394b4fb05db 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -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 @@ This list represents a \"habit\" for the rest of this module." (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) diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index e20b92147fc..68fee5b8df5 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -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 @@ not be modified." .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 @@ not be modified." 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 @@ settings with <style>...</style> tags." ;;;###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 @@ be linked only." (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 @@ borders and spacing." :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 @@ will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"." (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 @@ with a link to this URL." "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 @@ This may also be a function, building and inserting the postamble.") (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 @@ See variable `org-export-html-link-org-files-as-html'" (string-match "\\.org$" path) (progn (list - "http" + "file" (concat (substring path 0 (match-beginning 0)) "." @@ -579,13 +711,10 @@ description. See variables `org-export-html-inline-images' and (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 @@ MAY-INLINE-P allows inlining it as an image." ;;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 @@ MAY-INLINE-P allows inlining it as an image." ((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 @@ MAY-INLINE-P allows inlining it as an image." (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 @@ PUB-DIR is set, use this as the publishing directory." (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 @@ PUB-DIR is set, use this as the publishing directory." (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 @@ PUB-DIR is set, use this as the publishing directory." :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 @@ lang=\"%s\" xml:lang=\"%s\"> <meta name=\"description\" content=\"%s\"/> <meta name=\"keywords\" content=\"%s\"/> %s +%s </head> <body> <div id=\"content\"> @@ -925,6 +1066,7 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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) - - (setq org-last-level level)) - ))) - line) + (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) lines)) (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) @@ -1059,7 +1201,16 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> 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))) + 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)))) + (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)))) + ;; 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 @@ lang=\"%s\" xml:lang=\"%s\"> (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))) - - ;;The proper path, without a fragment - (path-1 - (first 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))) - - (setq rpl - (if + ;; 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 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))) + + (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> 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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> 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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ lang=\"%s\" xml:lang=\"%s\"> (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 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (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 @@ that uses these same face definitions." "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 @@ If there are links in the string, don't modify these." (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 is nil, just close all open levels." (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 diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index 1c4d7d6ac5b..fe6e97c72dd 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -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 @@ The file name should be absolute, the file will be overwritten without warning." :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 @@ When nil of the empty string, use the abbreviation retrieved from Emacs." (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 @@ When COMBINE is non nil, add the category to each line." "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 @@ When COMBINE is non nil, add the category to each line." 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 @@ When COMBINE is non nil, add the category to each line." (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 @@ When COMBINE is non nil, add the category to each line." ";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 @@ UID: %s %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 @@ END:VEVENT\n" (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 @@ END:VEVENT\n" (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 @@ END:VEVENT\n" ((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 @@ a time), or the day by one (if it does not contain a time)." (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) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index d16e5d81c8e..fcca58831d1 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -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 @@ optional argument MARKERP, return the position as a new marker." ;; 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) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index d88688d19ba..39ba445eb93 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -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 @@ FIXME: How to update when broken?" ((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 @@ useful to make it ever so slightly different." (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 @@ useful to make it ever so slightly different." "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) diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 3c6bf7d2ca4..6ea192b1765 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -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. ;; diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 43d59b0b558..29d8c40eed2 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -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 @@ or to a number smaller than this one. In fact, when `org-cycle-max-level' is 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 @@ When nil, they will not be exported." (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 @@ default, or nil of no state should be assigned." (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 () diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 3e3631ae979..3dd9680c8ff 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -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. ;; diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index de0f46d5293..d435d814679 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -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. ;; diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 55444c08bbe..2cf947312d8 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -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 @@ markup defined, the first one in the association list will be used." (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 @@ for example using customize, or with something like (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 @@ hurt if it is present." (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 @@ allowed. The default we use here encompasses both." :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 @@ when PUB-DIR is set, use this as the publishing directory." (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 @@ when PUB-DIR is set, use this as the publishing directory." (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 @@ OPT-PLIST is the options plist for current buffer." (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 @@ If END is non-nil, it is the end of the region." '(: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 @@ links, keywords, lists, tables, fixed-width" (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 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (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 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." 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 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (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 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (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 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "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}" diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 19ba1a96395..4ea466f379d 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -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 @@ the safe choice." (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-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." +(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 'boolean) + :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-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-empty-line-terminates-plain-lists nil + "Non-nil means an empty line ends all plain list levels. +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-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]." +(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: + +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 @@ When the indentation would be larger than this, it will become :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, obtained by prompting the user." (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 @@ If GENERAL is non-nil, return the general regexp independent of the value 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 @@ of `org-plain-list-ordered-item-terminator'." (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-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))) +(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]+")) -;;; 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 @@ A checkbox is blocked if all of the following conditions are fulfilled: (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 + +;; 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. + +;; 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-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-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))) -(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.") +(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) + (if (org-in-item-p) + (goto-char (org-get-item-beginning)) + (error "Not in an item"))) -(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)) +(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-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-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"))) -(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-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-beginning-of-item () - "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error." +(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) - (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 (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"))))) + (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")))) - -(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." + (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 - (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)))))) + (if (org-search-forward-unenclosed org-item-beginning-re bottom t) + (point-at-bol) + (org-get-end-of-item bottom)))) -(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-end-of-item-before-blank (bottom) + "Return point at end of item, before any blank line. +Point returned is at eol. + +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 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 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) - (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"))))) - -(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")) + (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. +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) + (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. + +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")))) - -(defun org-move-item-up (arg) + (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 () "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) - - (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))) - - (org-maybe-renumber-ordered-list) - (move-to-column col)) - (goto-char pos) - (move-to-column col) - (error "Cannot move this item further up")))) - -(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)))) - -(defun org-maybe-renumber-ordered-list-safe () - (condition-case nil - (save-excursion - (org-maybe-renumber-ordered-list)) - (error nil))) + (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-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: +(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. - `-' -> `+' -> `*' -> `1.' -> `1)' +If CHECKBOX is non-nil, add a checkbox next to the bullet. -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)))) +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. + +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'. + +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'. + +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-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'. + +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))) + +(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'. + +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 @@ If WHICH is a string, use that as the new bullet. If WHICH is an integer, (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))) - -(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." +(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) - (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)))) - -(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)))))) + (org-list-indent-item-generic + -1 t (org-list-top-point) (org-list-bottom-point))) -(defun org-beginning-of-item-list () - "Go to the beginning of the current item list. -I.e. to the first item in this list." +(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-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))) + (org-list-indent-item-generic + 1 t (org-list-top-point) (org-list-bottom-point))) -(defun org-end-of-item-list () - "Go to the end of the current item list. -I.e. to the text after the last item." +(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-beginning-of-item) - (let ((pos (point-at-bol)) + (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. + +Return t at each successful move." + (let ((org-adapt-indentation nil) (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))) + (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 -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) +(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* ((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-outdent-item (arg) - "Outdent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree (- arg) 'no-subtree)) +(defun org-cycle-list-bullet (&optional which) + "Cycle through the different itemize/enumerate bullets. +This cycle the entire list level through the sequence: -(defun org-indent-item (arg) - "Indent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree arg 'no-subtree)) + `-' -> `+' -> `*' -> `1.' -> `1)' -(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)) +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))) -(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)) +;;; 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. + +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 - (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-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)) + (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-reset-checkbox-state-subtree () + "Reset all checkboxes in an entry subtree." + (interactive "*") + (save-restriction (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)))) - -(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)))) + (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))) -(defun org-get-bullet () +(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-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-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 - (goto-char (point-at-bol)) - (and (looking-at - "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)") - (or (match-string 2) (match-string 4))))) + (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-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))) + +;;; 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. + +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 @@ Assumes cursor in item line." "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 @@ cdr is the indentation string." (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 @@ With argument MAYBE, fail quietly if no transformation is defined for 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 @@ this list." (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 @@ Valid parameters PARAMS are (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 @@ Valid parameters PARAMS are (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)))) diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index 06591703da9..afac5ca71b1 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -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. diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 212fae4fcc9..5a5612387fd 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -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 @@ This is in contrast to merely setting it to 0." (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 @@ point nowhere." (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) diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 92ac2342dae..efedef8ec5c 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -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 diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 91551cd828f..b1024a000e2 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -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 @@ supported by MH-E." "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 @@ you have a better idea of how to do this then please let us know." (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. diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el index 4a567614af3..2d429a79152 100644 --- a/lisp/org/org-mks.el +++ b/lisp/org/org-mks.el @@ -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. ;; diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index e9c1ad2bf3f..a278fb16d0a 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -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 @@ You might want to put this file into a directory where only you have access." 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 @@ list a list of selection key(s) as string." (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 @@ agenda view showing the flagged items." (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 @@ agenda view showing the flagged items." (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 @@ agenda view showing the flagged items." (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 @@ agenda view showing the flagged items." (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 @@ agenda view showing the flagged items." (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 @@ agenda view showing the flagged items." (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 @@ The table of checksums is written to the file mobile-checksums." (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 @@ The table of checksums is written to the file mobile-checksums." (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 @@ encryption program does not understand them." "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 @@ encryption program does not understand them." "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 @@ If nothing new has been added, return nil." (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 @@ If nothing new has been added, return nil." (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) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 12a7dcb85af..4a341d4272d 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -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 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (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. diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index c6953f11d37..274d3f94c8a 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -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. ;; diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 2c6345ab817..3a20c5f729c 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -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 @@ Here is an example: :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) diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 943bbca6b7b..51db9f652d1 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -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 of the alist is a publishing 'project.' The CAR of 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 @@ Most properties are optional, but some should always be set: :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 @@ sitemap of files or summary page for a given project. 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 @@ matching filenames." (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 @@ PUB-DIR is the publishing directory." (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." 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 @@ See `org-publish-projects'." (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 @@ directory and force publishing all files." (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))) diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index d8252b65c3d..a15825a51ec 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -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 @@ Furthermore, the following %-escapes will be replaced with content: 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 @@ 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 +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 @@ to be run from that hook to function properly." '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 ":")) diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 4ddfadaafa5..5574bf77ac4 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -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)) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 453f3b0b534..c4f0065ec34 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -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 @@ editing it with \\[org-edit-src-code]. Has no effect if :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 @@ but which mess up the display of a snippet in Org exported files.") (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 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (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 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is 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 @@ This minor mode is turned on in two situations: 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 @@ the edited version. Optional argument CONTEXT is used by 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 @@ the edited version. Optional argument CONTEXT is used by (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 @@ the edited version. Optional argument CONTEXT is used by (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 @@ the edited version. Optional argument CONTEXT is used by (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 @@ the edited version. Optional argument CONTEXT is used by (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 @@ the edited version. Optional argument CONTEXT is used by (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 @@ the language, a switch telling if the content should be in a single line." (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 @@ the language, a switch telling if the content should be in a single line." (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 diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 6a7120e0e55..0d61a782270 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -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 @@ available parameters." (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 @@ and table.el tables." (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 @@ nil When nil, the command tries to be smart and figure out the (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 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (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 @@ is always the old value." (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 @@ so you cannot specify parameters for it." (lambda (x) (if (eq x 'hline) "|----+----|" - (concat "| " (mapconcat 'identity x " | ") " |"))) + (concat "| " (mapconcat 'org-html-expand x " | ") " |"))) table) splicep)) (if (string-match "\n+\\'" html) diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el index da9e156870e..d03cd591b81 100644 --- a/lisp/org/org-taskjuggler.el +++ b/lisp/org/org-taskjuggler.el @@ -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 @@ finally add more underscore characters (\"_\")." (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) diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index b773274e93b..6c1f4984cf1 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -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 @@ With prefix arg STOP, stop it entirely." (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 @@ that was not started at the correct moment." (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 @@ VALUE can be `on', `off', or `pause'." (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 @@ VALUE can be `on', `off', or `pause'." (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 @@ replace any running timer." (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 @@ replace any running timer." (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 @@ replace any running timer." 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) diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index 4a28df6caa0..629258dec94 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -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 diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index b457156f573..072020a65e7 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -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. ;; diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index 4d2f8ec1280..54d35c98f2f 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -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 @@ googlegroups otherwise." (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 @@ googlegroups otherwise." (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 @@ folder name determines the the folder type." "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 @@ ENTITY is a message entity." 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 @@ ENTITY is a message entity." 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 @@ ENTITY is a message entity." (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 @@ for namazu index." ;; 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) diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index af501058e86..b5656d9406f 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -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. ;; diff --git a/lisp/org/org.el b/lisp/org/org.el index 19759371023..f7e7c9fd2f4 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -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 @@ requirements) is loaded." (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 @@ requirements) is loaded." (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 @@ identifier." ;;; 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 @@ to add the symbol `xyz', and the package must have a call to (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 @@ to add the symbol `xyz', and the package must have a call to (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 @@ the following lines anywhere in the buffer: :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 @@ for the duration of the command." (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 @@ type. In principle, it does not hurt to turn on most link types - there may 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 @@ footnote Footnote labels. 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 @@ Changing this requires a restart of Emacs to work correctly." :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 @@ This is list of cons cells. Each cell contains: - 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 @@ will work: 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 @@ points to a file, `org-agenda-diary-entry' will be used instead." (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 @@ will be appended." ("" "float" nil) ("" "wrapfig" nil) ("" "soul" t) - ("" "t1enc" t) ("" "textcomp" t) ("" "marvosym" t) ("" "wasysym" t) @@ -3177,7 +3219,7 @@ with another package you are using. 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 @@ When nil, the \\name form remains in the buffer." (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 @@ Normal means no org-mode-specific context." (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 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." ;; 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 @@ collapsed state." (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 3: Priority cookie 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 @@ After a match, the following groups carry important information: ("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 @@ means to push this value onto the list in the variable.") ((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 @@ means to push this value onto the list in the variable.") (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 @@ means to push this value onto the list in the variable.") "\\(?:[ \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 @@ means to push this value onto the list in the variable.") (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 @@ The following commands are available: (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 @@ The following commands are available: (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 @@ This should be called after the variable `org-link-types' has changed." 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 @@ will be prompted for." '(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 @@ will be prompted for." '(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 @@ will be prompted for." (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 @@ will be prompted for." 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 @@ between words." "\\)\\>"))) (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 @@ For plain list items, if they are matched by `outline-regexp', this returns (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 @@ For plain list items, if they are matched by `outline-regexp', this returns '("^[ \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 @@ For plain list items, if they are matched by `outline-regexp', this returns '(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 @@ For plain list items, if they are matched by `outline-regexp', this returns '(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 @@ For plain list items, if they are matched by `outline-regexp', this returns (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 @@ If KWD is a number, get the corresponding match group." (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 @@ in special contexts. `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 @@ in special contexts. (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 @@ in special contexts. (cond ((equal arg '(16)) + (setq last-command 'dummy) (org-set-startup-visibility) (message "Startup visibility, plus VISIBILITY properties")) @@ -5847,7 +5924,6 @@ in special contexts. (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 @@ in special contexts. (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 @@ in special contexts. ;; 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 @@ With a numeric prefix, show all headlines up to that level." (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 @@ Optional argument N means put the headline into the Nth line of the window." (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 @@ the headline hierarchy above." (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 @@ frame is not changed." "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 @@ This is important for non-interactive uses of the command." (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 @@ This is important for non-interactive uses of the command." (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 @@ This is important for non-interactive uses of the command." (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 @@ Works for outline headings and for plain lists alike." (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 @@ Works for outline headings and for plain lists alike." (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 @@ and still retain the repeater to cover future instances of the task." ;;; 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 @@ When children are sorted, the cursor is in the parent line when this 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 @@ n Numerically, by converting the beginning of the entry/item to a number. 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 @@ WITH-CASE, the sorting considers case as well." (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 @@ WITH-CASE, the sorting considers case as well." (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 @@ WITH-CASE, the sorting considers case as well." (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 @@ WITH-CASE, the sorting considers case as well." (/= 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 @@ It should be a function accepting three arguments: 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 @@ For file links, arg negates `org-context-in-file-links'." (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 @@ For file links, arg negates `org-context-in-file-links'." (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 @@ For file links, arg negates `org-context-in-file-links'." (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 @@ For file links, arg negates `org-context-in-file-links'." (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 @@ For file links, arg negates `org-context-in-file-links'." "::#" 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 @@ according to FMT (default from `org-email-link-description-format')." ;; 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 @@ according to FMT (default from `org-email-link-description-format')." (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 @@ according to FMT (default from `org-email-link-description-format')." (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-mode syntax." 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 @@ application the system uses for this file type." (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 @@ application the system uses for this file type." (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 @@ the window configuration before `org-open-at-point' was called using: (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 @@ in all files. If AVOID-POS is given, ignore matches near that position." (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 @@ in all files. If AVOID-POS is given, ignore matches near that position." ;;((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 @@ in all files. If AVOID-POS is given, ignore matches near that position." ) (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 @@ on the system \"/user@host:\"." (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 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (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 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (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 @@ This function can be used in a hook." "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 @@ At all other locations, this simply calls the value of (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 @@ At all other locations, this simply calls the value of (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 @@ At all other locations, this simply calls the value of (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 @@ this is nil.") (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 @@ This function is run automatically after each state change to a DONE state." (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 @@ This function is run automatically after each state change to a DONE state." (- (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 @@ This is done in the same way as adding a state change note." (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 @@ EXTRA is additional text that will be inserted into the notes buffer." (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 @@ EXTRA is additional text that will be inserted into the notes buffer." "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 @@ EXTRA is additional text that will be inserted into the notes buffer." (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 @@ ACTION can be `set', `up', `down', or a character." (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 @@ only lines with a TODO keyword are included in the output." (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 @@ also TODO lines." ;; 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 @@ also TODO lines." (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 @@ ignore inherited ones." (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 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (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 @@ If ONOFF is `on' or `off', don't toggle but set to this state." ;; 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 @@ If DATA is nil or the empty string, any tags will be removed." (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 @@ With prefix ARG, realign all tags in headings in the current buffer." (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 @@ With prefix ARG, realign all tags in headings in the current buffer." (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 @@ With prefix ARG, realign all tags in headings in the current buffer." (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 @@ With prefix ARG, realign all tags in headings in the current buffer." ;; 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 @@ With prefix ARG, realign all tags in headings in the current buffer." (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 @@ This works in the agenda, and also in an org-mode buffer." (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 @@ Returns the new tags string, or nil to not change the current settings." (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 @@ Returns the new tags string, or nil to not change the current settings." (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 @@ Returns the new tags string, or nil to not change the current settings." (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 @@ Returns the new tags string, or nil to not change the current settings." (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 @@ only headings." (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 @@ user." (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 @@ user function argument order change dependent on argument order." (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 @@ The command returns the inserted time stamp." 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 @@ The command returns the inserted time stamp." (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 @@ D may be an absolute day number, or a calendar-type list (month day year)." (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 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (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 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." ("$$" "\\$\\$[^\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 @@ Some of the options can be changed using the variable (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 @@ Some of the options can be changed using the variable (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 @@ Some of the options can be changed using the variable (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 @@ Some of the options can be changed using the variable (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 @@ BEG and END default to the buffer boundaries." (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 @@ BEG and END default to the buffer boundaries." (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 @@ BEG and END default to the buffer boundaries." (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 @@ BEG and END default to the buffer boundaries." ("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 @@ If not, return to the original position and throw an error." (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 @@ overwritten, and the table is not marked as requiring realignment." (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 @@ because, in this case the deletion might narrow the column." (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 @@ This command does many different things, depending on context: - 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 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 <<<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 @@ This command does many different things, depending on context: (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 @@ See the individual commands for more information." (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 @@ If the first line is normal text, add an item bullet to each line." ;; 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 @@ See the individual commands for more information." (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 @@ really on, so that the block visually is on the match." (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))) +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 - (and (or (org-at-regexp-p start-re) - (re-search-backward start-re nil t)) - (re-search-forward end-re nil t) - (>= (point) p))))) + ;; 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 @@ which make use of the date at the cursor." (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 @@ beyond the end of the headline." (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 @@ depending on context." (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 @@ move point." (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 @@ If there is no such heading, return nil." (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 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." ;; 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." diff --git a/lisp/paren.el b/lisp/paren.el index 783a783338b..bdc15a66cc0 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -52,8 +52,7 @@ otherwise)." :type '(choice (const parenthesis) (const expression) (const mixed)) :group 'paren-showing) -(defcustom show-paren-delay - (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1) +(defcustom show-paren-delay 0.125 "Time in seconds to delay before showing a matching paren." :type '(number :tag "seconds") :group 'paren-showing) @@ -253,5 +252,4 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." (provide 'paren) -;; arch-tag: d0969b88-7ac0-4bd0-bd53-e73b892b86a9 ;;; paren.el ends here diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 34119a77a75..f0a602be70b 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -487,7 +487,7 @@ The most useful commands are: (let ((font-lock-fontify-region-function 'ignore)) ;; insert-and-inherit will pick the right face automatically (while (search-forward-regexp "^:" nil t) - (setq bound (save-excursion (end-of-line) (point))) + (setq bound (point-at-eol)) (while (search-forward cipher-string bound 'end) (decipher-insert plain-char))))))) @@ -1062,5 +1062,4 @@ if it can't, it signals an error." ;; (delete-char -1) ;; (insert ")\n")))))) -;; arch-tag: 8f094d88-ffe1-4f99-afe3-a5e81dd939d9 ;;; decipher.el ends here diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 4d4dfa70c55..e892c5dcfbb 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -29,40 +29,94 @@ ;;; Code: -(defvar **mad**) (defvar *debug*) (defvar *print-space*) -(defvar *print-upcase*) (defvar abuselst) (defvar abusewords) -(defvar account) (defvar afraidof) (defvar arerelated) -(defvar areyou) (defvar bak) (defvar beclst) -(defvar bother) (defvar bye) (defvar canyou) -(defvar chatlst) (defvar continue) (defvar deathlst) -(defvar describe) (defvar drnk) (defvar drugs) -(defvar eliza-flag) (defvar elizalst) (defvar famlst) -(defvar feared) (defvar fears) (defvar feelings-about) -(defvar foullst) (defvar found) (defvar hello) -(defvar history) (defvar howareyoulst) (defvar howdyflag) -(defvar huhlst) (defvar ibelieve) (defvar improve) -(defvar inter) (defvar isee) (defvar isrelated) -(defvar lincount) (defvar longhuhlst) (defvar lover) -(defvar machlst) (defvar mathlst) (defvar maybe) -(defvar moods) (defvar neglst) (defvar obj) -(defvar object) (defvar owner) (defvar please) -(defvar problems) (defvar qlist) (defvar random-adjective) -(defvar relation) (defvar remlst) (defvar repetitive-shortness) -(defvar replist) (defvar rms-flag) (defvar schoollst) -(defvar sent) (defvar sexlst) (defvar shortbeclst) -(defvar shortlst) (defvar something) (defvar sportslst) -(defvar stallmanlst) (defvar states) (defvar subj) -(defvar suicide-flag) (defvar sure) (defvar thing) -(defvar things) (defvar thlst) (defvar toklst) -(defvar typos) (defvar verb) (defvar want) -(defvar whatwhen) (defvar whereoutp) (defvar whysay) -(defvar whywant) (defvar zippy-flag) (defvar zippylst) +(defvar doctor--**mad**) +(defvar doctor--*print-space*) +(defvar doctor--*print-upcase*) +(defvar doctor--abuselst) +(defvar doctor--abusewords) +(defvar doctor--afraidof) +(defvar doctor--arerelated) +(defvar doctor--areyou) +(defvar doctor--bak) +(defvar doctor--beclst) +(defvar doctor--bother) +(defvar doctor--bye) +(defvar doctor--canyou) ; unused? +(defvar doctor--chatlst) +(defvar doctor--continue) +(defvar doctor--deathlst) +(defvar doctor--describe) +(defvar doctor--drnk) +(defvar doctor--drugs) +(defvar doctor--eliza-flag) +(defvar doctor--elizalst) +(defvar doctor--famlst) +(defvar doctor--feared) +(defvar doctor--fears) +(defvar doctor--feelings-about) +(defvar doctor--foullst) +(defvar doctor-found) +(defvar doctor--hello) +(defvar doctor--history) +(defvar doctor--howareyoulst) +(defvar doctor--howdyflag) +(defvar doctor--huhlst) +(defvar doctor--ibelieve) +(defvar doctor--improve) +(defvar doctor--inter) +(defvar doctor--isee) +(defvar doctor--isrelated) +(defvar doctor--lincount) +(defvar doctor--longhuhlst) +(defvar doctor--lover) +(defvar doctor--machlst) +(defvar doctor--mathlst) +(defvar doctor--maybe) +(defvar doctor--moods) +(defvar doctor--neglst) +(defvar doctor-obj) +(defvar doctor-object) +(defvar doctor-owner) +(defvar doctor--please) +(defvar doctor--problems) +(defvar doctor--qlist) +(defvar doctor--random-adjective) +(defvar doctor--relation) +(defvar doctor--remlst) +(defvar doctor--repetitive-shortness) +(defvar doctor--replist) +(defvar doctor--rms-flag) +(defvar doctor--schoollst) +(defvar doctor-sent) +(defvar doctor--sexlst) +(defvar doctor--shortbeclst) +(defvar doctor--shortlst) +(defvar doctor--something) +(defvar doctor--sportslst) +(defvar doctor--stallmanlst) +(defvar doctor--states) +(defvar doctor-subj) +(defvar doctor--suicide-flag) +(defvar doctor--sure) +(defvar doctor--thing) +(defvar doctor--things) +(defvar doctor--thlst) +(defvar doctor--toklst) +(defvar doctor--typos) +(defvar doctor-verb) +(defvar doctor--want) +(defvar doctor--whatwhen) +(defvar doctor--whereoutp) +(defvar doctor--whysay) +(defvar doctor--whywant) +(defvar doctor--zippy-flag) +(defvar doctor--zippylst) (defun doc// (x) x) (defmacro doc$ (what) "quoted arg form of doctor-$" - (list 'doctor-$ (list 'quote what))) + `(doctor-$ ',what)) (defun doctor-$ (what) "Return the car of a list, rotating the list each time" @@ -86,484 +140,411 @@ reads the sentence before point, and prints the Doctor's answer." (make-doctor-variables) (turn-on-auto-fill) (doctor-type '(i am the psychotherapist \. - (doc$ please) (doc$ describe) your (doc$ problems) \. + (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \. each time you are finished talking, type \R\E\T twice \.)) (insert "\n")) (defun make-doctor-variables () - (make-local-variable 'typos) - (setq typos - (mapcar (function (lambda (x) - (put (car x) 'doctor-correction (cadr x)) - (put (cadr x) 'doctor-expansion (car (cddr x))) - (car x))) - '((theyll they\'ll (they will)) - (theyre they\'re (they are)) - (hes he\'s (he is)) - (he7s he\'s (he is)) - (im i\'m (you are)) - (i7m i\'m (you are)) - (isa is\ a (is a)) - (thier their (their)) - (dont don\'t (do not)) - (don7t don\'t (do not)) - (you7re you\'re (i am)) - (you7ve you\'ve (i have)) - (you7ll you\'ll (i will))))) - (make-local-variable 'found) - (setq found nil) - (make-local-variable 'owner) - (setq owner nil) - (make-local-variable 'history) - (setq history nil) - (make-local-variable '*debug*) - (setq *debug* nil) - (make-local-variable 'inter) - (setq inter - '((well\,) - (hmmm \.\.\.\ so\,) - (so) - (\.\.\.and) - (then))) - (make-local-variable 'continue) - (setq continue - '((continue) - (proceed) - (go on) - (keep going) )) - (make-local-variable 'relation) - (setq relation - '((your relationship with) - (something you remember about) - (your feelings toward) - (some experiences you have had with) - (how you feel about))) - (make-local-variable 'fears) - (setq fears '( ((doc$ whysay) you are (doc$ afraidof) (doc// feared) \?) - (you seem terrified by (doc// feared) \.) - (when did you first feel (doc$ afraidof) (doc// feared) \?) )) - (make-local-variable 'sure) - (setq sure '((sure)(positive)(certain)(absolutely sure))) - (make-local-variable 'afraidof) - (setq afraidof '( (afraid of) (frightened by) (scared of) )) - (make-local-variable 'areyou) - (setq areyou '( (are you)(have you been)(have you been) )) - (make-local-variable 'isrelated) - (setq isrelated '( (has something to do with)(is related to) - (could be the reason for) (is caused by)(is because of))) - (make-local-variable 'arerelated) - (setq arerelated '((have something to do with)(are related to) - (could have caused)(could be the reason for) (are caused by) - (are because of))) - (make-local-variable 'moods) - (setq moods '( ((doc$ areyou)(doc// found) often \?) - (what causes you to be (doc// found) \?) - ((doc$ whysay) you are (doc// found) \?) )) - (make-local-variable 'maybe) - (setq maybe - '((maybe) - (perhaps) - (possibly))) - (make-local-variable 'whatwhen) - (setq whatwhen - '((what happened when) - (what would happen if))) - (make-local-variable 'hello) - (setq hello - '((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.))) - (make-local-variable 'drnk) - (setq drnk - '((do you drink a lot of (doc// found) \?) - (do you get drunk often \?) - ((doc$ describe) your drinking habits \.) )) - (make-local-variable 'drugs) - (setq drugs '( (do you use (doc// found) often \?)((doc$ areyou) - addicted to (doc// found) \?)(do you realize that drugs can - be very harmful \?)((doc$ maybe) you should try to quit using (doc// found) - \.))) - (make-local-variable 'whywant) - (setq whywant '( ((doc$ whysay) (doc// subj) might (doc$ want) (doc// obj) \?) - (how does it feel to want \?) - (why should (doc// subj) get (doc// obj) \?) - (when did (doc// subj) first (doc$ want) (doc// obj) \?) - ((doc$ areyou) obsessed with (doc// obj) \?) - (why should i give (doc// obj) to (doc// subj) \?) - (have you ever gotten (doc// obj) \?) )) - (make-local-variable 'canyou) - (setq canyou '((of course i can \.) - (why should i \?) - (what makes you think i would even want to \?) - (i am the doctor\, i can do anything i damn please \.) - (not really\, it\'s not up to me \.) - (depends\, how important is it \?) - (i could\, but i don\'t think it would be a wise thing to do \.) - (can you \?) - (maybe i can\, maybe i can\'t \.\.\.) - (i don\'t think i should do that \.))) - (make-local-variable 'want) - (setq want '( (want) (desire) (wish) (want) (hope) )) - (make-local-variable 'shortlst) - (setq shortlst - '((can you elaborate on that \?) - ((doc$ please) continue \.) - (go on\, don\'t be afraid \.) - (i need a little more detail please \.) - (you\'re being a bit brief\, (doc$ please) go into detail \.) - (can you be more explicit \?) - (and \?) - ((doc$ please) go into more detail \?) - (you aren\'t being very talkative today\!) - (is that all there is to it \?) - (why must you respond so briefly \?))) - - (make-local-variable 'famlst) - (setq famlst - '((tell me (doc$ something) about (doc// owner) family \.) - (you seem to dwell on (doc// owner) family \.) - ((doc$ areyou) hung up on (doc// owner) family \?))) - (make-local-variable 'huhlst) - (setq huhlst - '(((doc$ whysay)(doc// sent) \?) - (is it because of (doc$ things) that you say (doc// sent) \?) )) - (make-local-variable 'longhuhlst) - (setq longhuhlst - '(((doc$ whysay) that \?) - (i don\'t understand \.) - ((doc$ thlst)) - ((doc$ areyou) (doc$ afraidof) that \?))) - (make-local-variable 'feelings-about) - (setq feelings-about - '((feelings about) - (apprehensions toward) - (thoughts on) - (emotions toward))) - (make-local-variable 'random-adjective) - (setq random-adjective - '((vivid) - (emotionally stimulating) - (exciting) - (boring) - (interesting) - (recent) - (random) ;How can we omit this? - (unusual) - (shocking) - (embarrassing))) - (make-local-variable 'whysay) - (setq whysay - '((why do you say) - (what makes you believe) - (are you sure that) - (do you really think) - (what makes you think) )) - (make-local-variable 'isee) - (setq isee - '((i see \.\.\.) - (yes\,) - (i understand \.) - (oh \.) )) - (make-local-variable 'please) - (setq please - '((please\,) - (i would appreciate it if you would) - (perhaps you could) - (please\,) - (would you please) - (why don\'t you) - (could you))) - (make-local-variable 'bye) - (setq bye - '((my secretary will send you a bill \.) - (bye bye \.) - (see ya \.) - (ok\, talk to you some other time \.) - (talk to you later \.) - (ok\, have fun \.) - (ciao \.))) - (make-local-variable 'something) - (setq something - '((something) - (more) - (how you feel))) - (make-local-variable 'thing) - (setq thing - '((your life) - (your sex life))) - (make-local-variable 'things) - (setq things - '((your plans) - (the people you hang around with) - (problems at school) - (any hobbies you have) - (hangups you have) - (your inhibitions) - (some problems in your childhood) - (some problems at home))) - (make-local-variable 'describe) - (setq describe - '((describe) - (tell me about) - (talk about) - (discuss) - (tell me more about) - (elaborate on))) - (make-local-variable 'ibelieve) - (setq ibelieve - '((i believe) (i think) (i have a feeling) (it seems to me that) - (it looks like))) - (make-local-variable 'problems) - (setq problems '( (problems) - (inhibitions) - (hangups) - (difficulties) - (anxieties) - (frustrations) )) - (make-local-variable 'bother) - (setq bother - '((does it bother you that) - (are you annoyed that) - (did you ever regret) - (are you sorry) - (are you satisfied with the fact that))) - (make-local-variable 'machlst) - (setq machlst - '((you have your mind on (doc// found) \, it seems \.) - (you think too much about (doc// found) \.) - (you should try taking your mind off of (doc// found)\.) - (are you a computer hacker \?))) - (make-local-variable 'qlist) - (setq qlist - '((what do you think \?) - (i\'ll ask the questions\, if you don\'t mind!) - (i could ask the same thing myself \.) - ((doc$ please) allow me to do the questioning \.) - (i have asked myself that question many times \.) - ((doc$ please) try to answer that question yourself \.))) - (make-local-variable 'foullst) - (setq foullst - '(((doc$ please) watch your tongue!) - ((doc$ please) avoid such unwholesome thoughts \.) - ((doc$ please) get your mind out of the gutter \.) - (such lewdness is not appreciated \.))) - (make-local-variable 'deathlst) - (setq deathlst - '((this is not a healthy way of thinking \.) - ((doc$ bother) you\, too\, may die someday \?) - (i am worried by your obsession with this topic!) - (did you watch a lot of crime and violence on television as a child \?)) - ) - (make-local-variable 'sexlst) - (setq sexlst - '(((doc$ areyou) (doc$ afraidof) sex \?) - ((doc$ describe)(doc$ something) about your sexual history \.) - ((doc$ please)(doc$ describe) your sex life \.\.\.) - ((doc$ describe) your (doc$ feelings-about) your sexual partner \.) - ((doc$ describe) your most (doc$ random-adjective) sexual experience \.) - ((doc$ areyou) satisfied with (doc// lover) \.\.\. \?))) - (make-local-variable 'neglst) - (setq neglst - '((why not \?) - ((doc$ bother) i ask that \?) - (why not \?) - (why not \?) - (how come \?) - ((doc$ bother) i ask that \?))) - (make-local-variable 'beclst) - (setq beclst '( - (is it because (doc// sent) that you came to me \?) - ((doc$ bother)(doc// sent) \?) - (when did you first know that (doc// sent) \?) - (is the fact that (doc// sent) the real reason \?) - (does the fact that (doc// sent) explain anything else \?) - ((doc$ areyou)(doc$ sure)(doc// sent) \? ) )) - (make-local-variable 'shortbeclst) - (setq shortbeclst '( - ((doc$ bother) i ask you that \?) - (that\'s not much of an answer!) - ((doc$ inter) why won\'t you talk about it \?) - (speak up!) - ((doc$ areyou) (doc$ afraidof) talking about it \?) - (don\'t be (doc$ afraidof) elaborating \.) - ((doc$ please) go into more detail \.))) - (make-local-variable 'thlst) - (setq thlst '( - ((doc$ maybe)(doc$ thing)(doc$ isrelated) this \.) - ((doc$ maybe)(doc$ things)(doc$ arerelated) this \.) - (is it because of (doc$ things) that you are going through all this \?) - (how do you reconcile (doc$ things) \? ) - ((doc$ maybe) this (doc$ isrelated)(doc$ things) \?) )) - (make-local-variable 'remlst) - (setq remlst '( (earlier you said (doc$ history) \?) - (you mentioned that (doc$ history) \?) - ((doc$ whysay)(doc$ history) \? ) )) - (make-local-variable 'toklst) - (setq toklst - '((is this how you relax \?) - (how long have you been smoking grass \?) - ((doc$ areyou) (doc$ afraidof) of being drawn to using harder stuff \?))) - (make-local-variable 'states) - (setq states - '((do you get (doc// found) often \?) - (do you enjoy being (doc// found) \?) - (what makes you (doc// found) \?) - (how often (doc$ areyou)(doc// found) \?) - (when were you last (doc// found) \?))) - (make-local-variable 'replist) - (setq replist - '((i . (you)) - (my . (your)) - (me . (you)) - (you . (me)) - (your . (my)) - (mine . (yours)) - (yours . (mine)) - (our . (your)) - (ours . (yours)) - (we . (you)) - (dunno . (do not know)) -;; (yes . ()) - (no\, . ()) - (yes\, . ()) - (ya . (i)) - (aint . (am not)) - (wanna . (want to)) - (gimme . (give me)) - (gotta . (have to)) - (gonna . (going to)) - (never . (not ever)) - (doesn\'t . (does not)) - (don\'t . (do not)) - (aren\'t . (are not)) - (isn\'t . (is not)) - (won\'t . (will not)) - (can\'t . (cannot)) - (haven\'t . (have not)) - (i\'m . (you are)) - (ourselves . (yourselves)) - (myself . (yourself)) - (yourself . (myself)) - (you\'re . (i am)) - (you\'ve . (i have)) - (i\'ve . (you have)) - (i\'ll . (you will)) - (you\'ll . (i shall)) - (i\'d . (you would)) - (you\'d . (i would)) - (here . (there)) - (please . ()) - (eh\, . ()) - (eh . ()) - (oh\, . ()) - (oh . ()) - (shouldn\'t . (should not)) - (wouldn\'t . (would not)) - (won\'t . (will not)) - (hasn\'t . (has not)))) - (make-local-variable 'stallmanlst) - (setq stallmanlst '( - ((doc$ describe) your (doc$ feelings-about) him \.) - ((doc$ areyou) a friend of Stallman \?) - ((doc$ bother) Stallman is (doc$ random-adjective) \?) - ((doc$ ibelieve) you are (doc$ afraidof) him \.))) - (make-local-variable 'schoollst) - (setq schoollst '( - ((doc$ describe) your (doc// found) \.) - ((doc$ bother) your grades could (doc$ improve) \?) - ((doc$ areyou) (doc$ afraidof) (doc// found) \?) - ((doc$ maybe) this (doc$ isrelated) to your attitude \.) - ((doc$ areyou) absent often \?) - ((doc$ maybe) you should study (doc$ something) \.))) - (make-local-variable 'improve) - (setq improve '((improve) (be better) (be improved) (be higher))) - (make-local-variable 'elizalst) - (setq elizalst '( - ((doc$ areyou) (doc$ sure) \?) - ((doc$ ibelieve) you have (doc$ problems) with (doc// found) \.) - ((doc$ whysay) (doc// sent) \?))) - (make-local-variable 'sportslst) - (setq sportslst '( - (tell me (doc$ something) about (doc// found) \.) - ((doc$ describe) (doc$ relation) (doc// found) \.) - (do you find (doc// found) (doc$ random-adjective) \?))) - (make-local-variable 'mathlst) - (setq mathlst '( - ((doc$ describe) (doc$ something) about math \.) - ((doc$ maybe) your (doc$ problems) (doc$ arerelated) (doc// found) \.) - (i don\'t know much (doc// found) \, but (doc$ continue) - anyway \.))) - (make-local-variable 'zippylst) - (setq zippylst '( - ((doc$ areyou) Zippy \?) - ((doc$ ibelieve) you have some serious (doc$ problems) \.) - ((doc$ bother) you are a pinhead \?))) - (make-local-variable 'chatlst) - (setq chatlst '( - ((doc$ maybe) we could chat \.) - ((doc$ please) (doc$ describe) (doc$ something) about chat mode \.) - ((doc$ bother) our discussion is so (doc$ random-adjective) \?))) - (make-local-variable 'abuselst) - (setq abuselst '( - ((doc$ please) try to be less abusive \.) - ((doc$ describe) why you call me (doc// found) \.) - (i\'ve had enough of you!))) - (make-local-variable 'abusewords) - (setq abusewords '(boring bozo clown clumsy cretin dumb dummy - fool foolish gnerd gnurd idiot jerk - lose loser louse lousy luse luser - moron nerd nurd oaf oafish reek - stink stupid tool toolish twit)) - (make-local-variable 'howareyoulst) - (setq howareyoulst '((how are you) (hows it going) (hows it going eh) - (how\'s it going) (how\'s it going eh) (how goes it) - (whats up) (whats new) (what\'s up) (what\'s new) - (howre you) (how\'re you) (how\'s everything) - (how is everything) (how do you do) - (how\'s it hanging) (que pasa) - (how are you doing) (what do you say))) - (make-local-variable 'whereoutp) - (setq whereoutp '( huh remem rthing ) ) - (make-local-variable 'subj) - (setq subj nil) - (make-local-variable 'verb) - (setq verb nil) - (make-local-variable 'obj) - (setq obj nil) - (make-local-variable 'feared) - (setq feared nil) - (make-local-variable 'repetitive-shortness) - (setq repetitive-shortness '(0 . 0)) - (make-local-variable '**mad**) - (setq **mad** nil) - (make-local-variable 'rms-flag) - (setq rms-flag nil) - (make-local-variable 'eliza-flag) - (setq eliza-flag nil) - (make-local-variable 'zippy-flag) - (setq zippy-flag nil) - (make-local-variable 'suicide-flag) - (setq suicide-flag nil) - (make-local-variable 'lover) - (setq lover '(your partner)) - (make-local-variable 'bak) - (setq bak nil) - (make-local-variable 'lincount) - (setq lincount 0) - (make-local-variable '*print-upcase*) - (setq *print-upcase* nil) - (make-local-variable '*print-space*) - (setq *print-space* nil) - (make-local-variable 'howdyflag) - (setq howdyflag nil) - (make-local-variable 'object) - (setq object nil)) + (set (make-local-variable 'doctor--typos) + (mapcar (lambda (x) + (put (car x) 'doctor-correction (cadr x)) + (put (cadr x) 'doctor-expansion (car (cddr x))) + (car x)) + '((theyll they\'ll (they will)) + (theyre they\'re (they are)) + (hes he\'s (he is)) + (he7s he\'s (he is)) + (im i\'m (you are)) + (i7m i\'m (you are)) + (isa is\ a (is a)) + (thier their (their)) + (dont don\'t (do not)) + (don7t don\'t (do not)) + (you7re you\'re (i am)) + (you7ve you\'ve (i have)) + (you7ll you\'ll (i will))))) + (set (make-local-variable 'doctor-found) nil) + (set (make-local-variable 'doctor-owner) nil) + (set (make-local-variable 'doctor--history) nil) + (set (make-local-variable 'doctor--inter) '((well\,) + (hmmm \.\.\.\ so\,) + (so) + (\.\.\.and) + (then))) + (set (make-local-variable 'doctor--continue) '((continue) + (proceed) + (go on) + (keep going))) + (set (make-local-variable 'doctor--relation) + '((your relationship with) + (something you remember about) + (your feelings toward) + (some experiences you have had with) + (how you feel about))) + (set (make-local-variable 'doctor--fears) + '(((doc$ doctor--whysay) you are (doc$ doctor--afraidof) (doc// doctor--feared) \?) + (you seem terrified by (doc// doctor--feared) \.) + (when did you first feel (doc$ doctor--afraidof) (doc// doctor--feared) \?))) + (set (make-local-variable 'doctor--sure) '((sure) + (positive) + (certain) + (absolutely sure))) + (set (make-local-variable 'doctor--afraidof) '((afraid of) + (frightened by) + (scared of))) + (set (make-local-variable 'doctor--areyou) '((are you) + (have you been) + (have you been))) + (set (make-local-variable 'doctor--isrelated) + '((has something to do with) + (is related to) + (could be the reason for) + (is caused by) + (is because of))) + (set (make-local-variable 'doctor--arerelated) '((have something to do with) + (are related to) + (could have caused) + (could be the reason for) + (are caused by) + (are because of))) + (set (make-local-variable 'doctor--moods) + '(((doc$ doctor--areyou) (doc// doctor-found) often \?) + (what causes you to be (doc// doctor-found) \?) + ((doc$ doctor--whysay) you are (doc// doctor-found) \?))) + (set (make-local-variable 'doctor--maybe) '((maybe) + (perhaps) + (possibly))) + (set (make-local-variable 'doctor--whatwhen) '((what happened when) + (what would happen if))) + (set (make-local-variable 'doctor--hello) '((how do you do \?) + (hello \.) + (howdy!) + (hello \.) + (hi \.) + (hi there \.))) + (set (make-local-variable 'doctor--drnk) + '((do you drink a lot of (doc// doctor-found) \?) + (do you get drunk often \?) + ((doc$ doctor--describe) your drinking habits \.))) + (set (make-local-variable 'doctor--drugs) + '((do you use (doc// doctor-found) often \?) + ((doc$ doctor--areyou) addicted to (doc// doctor-found) \?) + (do you realize that drugs can be very harmful \?) + ((doc$ doctor--maybe) you should try to quit using (doc// doctor-found) \.))) + (set (make-local-variable 'doctor--whywant) + '(((doc$ doctor--whysay) (doc// doctor-subj) might (doc$ doctor--want) (doc// doctor-obj) \?) + (how does it feel to want \?) + (why should (doc// doctor-subj) get (doc// doctor-obj) \?) + (when did (doc// doctor-subj) first (doc$ doctor--want) (doc// doctor-obj) \?) + ((doc$ doctor--areyou) obsessed with (doc// doctor-obj) \?) + (why should i give (doc// doctor-obj) to (doc// doctor-subj) \?) + (have you ever gotten (doc// doctor-obj) \?))) + (set (make-local-variable 'doctor--canyou) + '((of course i can \.) + (why should i \?) + (what makes you think i would even want to \?) + (i am the doctor\, i can do anything i damn please \.) + (not really\, it\'s not up to me \.) + (depends\, how important is it \?) + (i could\, but i don\'t think it would be a wise thing to do \.) + (can you \?) + (maybe i can\, maybe i can\'t \.\.\.) + (i don\'t think i should do that \.))) + (set (make-local-variable 'doctor--want) '((want) (desire) (wish) (want) (hope))) + (set (make-local-variable 'doctor--shortlst) + '((can you elaborate on that \?) + ((doc$ doctor--please) continue \.) + (go on\, don\'t be afraid \.) + (i need a little more detail please \.) + (you\'re being a bit brief\, (doc$ doctor--please) go into detail \.) + (can you be more explicit \?) + (and \?) + ((doc$ doctor--please) go into more detail \?) + (you aren\'t being very talkative today\!) + (is that all there is to it \?) + (why must you respond so briefly \?))) + (set (make-local-variable 'doctor--famlst) + '((tell me (doc$ doctor--something) about (doc// doctor-owner) family \.) + (you seem to dwell on (doc// doctor-owner) family \.) + ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?))) + (set (make-local-variable 'doctor--huhlst) + '(((doc$ doctor--whysay)(doc// doctor-sent) \?) + (is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?))) + (set (make-local-variable 'doctor--longhuhlst) + '(((doc$ doctor--whysay) that \?) + (i don\'t understand \.) + ((doc$ doctor--thlst)) + ((doc$ doctor--areyou) (doc$ doctor--afraidof) that \?))) + (set (make-local-variable 'doctor--feelings-about) '((feelings about) + (apprehensions toward) + (thoughts on) + (emotions toward))) + (set (make-local-variable 'doctor--random-adjective) + '((vivid) + (emotionally stimulating) + (exciting) + (boring) + (interesting) + (recent) + (random) ; how can we omit this? + (unusual) + (shocking) + (embarrassing))) + (set (make-local-variable 'doctor--whysay) '((why do you say) + (what makes you believe) + (are you sure that) + (do you really think) + (what makes you think))) + (set (make-local-variable 'doctor--isee) '((i see \.\.\.) + (yes\,) + (i understand \.) + (oh \.) )) + (set (make-local-variable 'doctor--please) '((please\,) + (i would appreciate it if you would) + (perhaps you could) + (please\,) + (would you please) + (why don\'t you) + (could you))) + (set (make-local-variable 'doctor--bye) + '((my secretary will send you a bill \.) + (bye bye \.) + (see ya \.) + (ok\, talk to you some other time \.) + (talk to you later \.) + (ok\, have fun \.) + (ciao \.))) + (set (make-local-variable 'doctor--something) '((something) + (more) + (how you feel))) + (set (make-local-variable 'doctor--thing) '((your life) + (your sex life))) + (set (make-local-variable 'doctor--things) '((your plans) + (the people you hang around with) + (problems at school) + (any hobbies you have) + (hangups you have) + (your inhibitions) + (some problems in your childhood) + (some problems at home))) + (set (make-local-variable 'doctor--describe) '((describe) + (tell me about) + (talk about) + (discuss) + (tell me more about) + (elaborate on))) + (set (make-local-variable 'doctor--ibelieve) + '((i believe) (i think) (i have a feeling) (it seems to me that) + (it looks like))) + (set (make-local-variable 'doctor--problems) '((problems) + (inhibitions) + (hangups) + (difficulties) + (anxieties) + (frustrations))) + (set (make-local-variable 'doctor--bother) '((does it bother you that) + (are you annoyed that) + (did you ever regret) + (are you sorry) + (are you satisfied with the fact that))) + (set (make-local-variable 'doctor--machlst) + '((you have your mind on (doc// doctor-found) \, it seems \.) + (you think too much about (doc// doctor-found) \.) + (you should try taking your mind off of (doc// doctor-found)\.) + (are you a computer hacker \?))) + (set (make-local-variable 'doctor--qlist) + '((what do you think \?) + (i\'ll ask the questions\, if you don\'t mind!) + (i could ask the same thing myself \.) + ((doc$ doctor--please) allow me to do the questioning \.) + (i have asked myself that question many times \.) + ((doc$ doctor--please) try to answer that question yourself \.))) + (set (make-local-variable 'doctor--foullst) + '(((doc$ doctor--please) watch your tongue!) + ((doc$ doctor--please) avoid such unwholesome thoughts \.) + ((doc$ doctor--please) get your mind out of the gutter \.) + (such lewdness is not appreciated \.))) + (set (make-local-variable 'doctor--deathlst) + '((this is not a healthy way of thinking \.) + ((doc$ doctor--bother) you\, too\, may die someday \?) + (i am worried by your obsession with this topic!) + (did you watch a lot of crime and violence on television as a child \?))) + (set (make-local-variable 'doctor--sexlst) + '(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?) + ((doc$ doctor--describe)(doc$ doctor--something) about your sexual history \.) + ((doc$ doctor--please)(doc$ doctor--describe) your sex life \.\.\.) + ((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.) + ((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.) + ((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?))) + (set (make-local-variable 'doctor--neglst) '((why not \?) + ((doc$ doctor--bother) i ask that \?) + (why not \?) + (why not \?) + (how come \?) + ((doc$ doctor--bother) i ask that \?))) + (set (make-local-variable 'doctor--beclst) + '((is it because (doc// doctor-sent) that you came to me \?) + ((doc$ doctor--bother)(doc// doctor-sent) \?) + (when did you first know that (doc// doctor-sent) \?) + (is the fact that (doc// doctor-sent) the real reason \?) + (does the fact that (doc// doctor-sent) explain anything else \?) + ((doc$ doctor--areyou)(doc$ doctor--sure)(doc// doctor-sent) \? ))) + (set (make-local-variable 'doctor--shortbeclst) + '(((doc$ doctor--bother) i ask you that \?) + (that\'s not much of an answer!) + ((doc$ doctor--inter) why won\'t you talk about it \?) + (speak up!) + ((doc$ doctor--areyou) (doc$ doctor--afraidof) talking about it \?) + (don\'t be (doc$ doctor--afraidof) elaborating \.) + ((doc$ doctor--please) go into more detail \.))) + (set (make-local-variable 'doctor--thlst) + '(((doc$ doctor--maybe)(doc$ doctor--thing)(doc$ doctor--isrelated) this \.) + ((doc$ doctor--maybe)(doc$ doctor--things)(doc$ doctor--arerelated) this \.) + (is it because of (doc$ doctor--things) that you are going through all this \?) + (how do you reconcile (doc$ doctor--things) \? ) + ((doc$ doctor--maybe) this (doc$ doctor--isrelated)(doc$ doctor--things) \?))) + (set (make-local-variable 'doctor--remlst) + '((earlier you said (doc$ doctor--history) \?) + (you mentioned that (doc$ doctor--history) \?) + ((doc$ doctor--whysay)(doc$ doctor--history) \? ))) + (set (make-local-variable 'doctor--toklst) + '((is this how you relax \?) + (how long have you been smoking grass \?) + ((doc$ doctor--areyou) (doc$ doctor--afraidof) of being drawn to using harder stuff \?))) + (set (make-local-variable 'doctor--states) + '((do you get (doc// doctor-found) often \?) + (do you enjoy being (doc// doctor-found) \?) + (what makes you (doc// doctor-found) \?) + (how often (doc$ doctor--areyou)(doc// doctor-found) \?) + (when were you last (doc// doctor-found) \?))) + (set (make-local-variable 'doctor--replist) '((i . (you)) + (my . (your)) + (me . (you)) + (you . (me)) + (your . (my)) + (mine . (yours)) + (yours . (mine)) + (our . (your)) + (ours . (yours)) + (we . (you)) + (dunno . (do not know)) + ;; (yes . ()) + (no\, . ()) + (yes\, . ()) + (ya . (i)) + (aint . (am not)) + (wanna . (want to)) + (gimme . (give me)) + (gotta . (have to)) + (gonna . (going to)) + (never . (not ever)) + (doesn\'t . (does not)) + (don\'t . (do not)) + (aren\'t . (are not)) + (isn\'t . (is not)) + (won\'t . (will not)) + (can\'t . (cannot)) + (haven\'t . (have not)) + (i\'m . (you are)) + (ourselves . (yourselves)) + (myself . (yourself)) + (yourself . (myself)) + (you\'re . (i am)) + (you\'ve . (i have)) + (i\'ve . (you have)) + (i\'ll . (you will)) + (you\'ll . (i shall)) + (i\'d . (you would)) + (you\'d . (i would)) + (here . (there)) + (please . ()) + (eh\, . ()) + (eh . ()) + (oh\, . ()) + (oh . ()) + (shouldn\'t . (should not)) + (wouldn\'t . (would not)) + (won\'t . (will not)) + (hasn\'t . (has not)))) + (set (make-local-variable 'doctor--stallmanlst) + '(((doc$ doctor--describe) your (doc$ doctor--feelings-about) him \.) + ((doc$ doctor--areyou) a friend of Stallman \?) + ((doc$ doctor--bother) Stallman is (doc$ doctor--random-adjective) \?) + ((doc$ doctor--ibelieve) you are (doc$ doctor--afraidof) him \.))) + (set (make-local-variable 'doctor--schoollst) + '(((doc$ doctor--describe) your (doc// doctor-found) \.) + ((doc$ doctor--bother) your grades could (doc$ doctor--improve) \?) + ((doc$ doctor--areyou) (doc$ doctor--afraidof) (doc// doctor-found) \?) + ((doc$ doctor--maybe) this (doc$ doctor--isrelated) to your attitude \.) + ((doc$ doctor--areyou) absent often \?) + ((doc$ doctor--maybe) you should study (doc$ doctor--something) \.))) + (set (make-local-variable 'doctor--improve) + '((improve) (be better) (be improved) (be higher))) + (set (make-local-variable 'doctor--elizalst) + '(((doc$ doctor--areyou) (doc$ doctor--sure) \?) + ((doc$ doctor--ibelieve) you have (doc$ doctor--problems) with (doc// doctor-found) \.) + ((doc$ doctor--whysay) (doc// doctor-sent) \?))) + (set (make-local-variable 'doctor--sportslst) + '((tell me (doc$ doctor--something) about (doc// doctor-found) \.) + ((doc$ doctor--describe) (doc$ doctor--relation) (doc// doctor-found) \.) + (do you find (doc// doctor-found) (doc$ doctor--random-adjective) \?))) + (set (make-local-variable 'doctor--mathlst) + '(((doc$ doctor--describe) (doc$ doctor--something) about math \.) + ((doc$ doctor--maybe) your (doc$ doctor--problems) (doc$ doctor--arerelated) (doc// doctor-found) \.) + (i don\'t know much (doc// doctor-found) \, but (doc$ doctor--continue) + anyway \.))) + (set (make-local-variable 'doctor--zippylst) + '(((doc$ doctor--areyou) Zippy \?) + ((doc$ doctor--ibelieve) you have some serious (doc$ doctor--problems) \.) + ((doc$ doctor--bother) you are a pinhead \?))) + (set (make-local-variable 'doctor--chatlst) + '(((doc$ doctor--maybe) we could chat \.) + ((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--something) about chat mode \.) + ((doc$ doctor--bother) our discussion is so (doc$ doctor--random-adjective) \?))) + (set (make-local-variable 'doctor--abuselst) + '(((doc$ doctor--please) try to be less abusive \.) + ((doc$ doctor--describe) why you call me (doc// doctor-found) \.) + (i\'ve had enough of you!))) + (set (make-local-variable 'doctor--abusewords) + '(boring bozo clown clumsy cretin dumb dummy + fool foolish gnerd gnurd idiot jerk + lose loser louse lousy luse luser + moron nerd nurd oaf oafish reek + stink stupid tool toolish twit)) + (set (make-local-variable 'doctor--howareyoulst) + '((how are you) (hows it going) (hows it going eh) + (how\'s it going) (how\'s it going eh) (how goes it) + (whats up) (whats new) (what\'s up) (what\'s new) + (howre you) (how\'re you) (how\'s everything) + (how is everything) (how do you do) + (how\'s it hanging) (que pasa) + (how are you doing) (what do you say))) + (set (make-local-variable 'doctor--whereoutp) '(huh remem rthing)) + (set (make-local-variable 'doctor-subj) nil) + (set (make-local-variable 'doctor-verb) nil) + (set (make-local-variable 'doctor-obj) nil) + (set (make-local-variable 'doctor--feared) nil) + (set (make-local-variable 'doctor--repetitive-shortness) '(0 . 0)) + (set (make-local-variable 'doctor--**mad**) nil) + (set (make-local-variable 'doctor--rms-flag) nil) + (set (make-local-variable 'doctor--eliza-flag) nil) + (set (make-local-variable 'doctor--zippy-flag) nil) + (set (make-local-variable 'doctor--suicide-flag) nil) + (set (make-local-variable 'doctor--lover) '(your partner)) + (set (make-local-variable 'doctor--bak) nil) + (set (make-local-variable 'doctor--lincount) 0) + (set (make-local-variable 'doctor--*print-upcase*) nil) + (set (make-local-variable 'doctor--*print-space*) nil) + (set (make-local-variable 'doctor--howdyflag) nil) + (set (make-local-variable 'doctor-object) nil)) ;; Define equivalence classes of words that get treated alike. (defun doctor-meaning (x) (get x 'doctor-meaning)) (defmacro doctor-put-meaning (symb val) - "Store the base meaning of a word on the property list." - (list 'put (list 'quote symb) ''doctor-meaning val)) + "Store the base meaning of a word on the property list." + `(put ',symb 'doctor-meaning ,val)) (doctor-put-meaning howdy 'howdy) (doctor-put-meaning hi 'howdy) @@ -855,10 +836,10 @@ Otherwise call the Doctor to parse preceding sentence." (interactive) (let ((sent (doctor-readin))) (insert "\n") - (setq lincount (1+ lincount)) + (setq doctor--lincount (1+ doctor--lincount)) (doctor-doc sent) (insert "\n") - (setq bak sent))) + (setq doctor--bak sent))) (defun doctor-readin nil "Read a sentence. Return it as a list of words." @@ -878,70 +859,70 @@ Otherwise call the Doctor to parse preceding sentence." ;; Main processing function for sentences that have been read. -(defun doctor-doc (sent) +(defun doctor-doc (doctor-sent) (cond - ((equal sent '(foo)) - (doctor-type '(bar! (doc$ please)(doc$ continue) \.))) - ((member sent howareyoulst) - (doctor-type '(i\'m ok \. (doc$ describe) yourself \.))) - ((or (member sent '((good bye) (see you later) (i quit) (so long) + ((equal doctor-sent '(foo)) + (doctor-type '(bar! (doc$ doctor--please)(doc$ doctor--continue) \.))) + ((member doctor-sent doctor--howareyoulst) + (doctor-type '(i\'m ok \. (doc$ doctor--describe) yourself \.))) + ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long) (go away) (get lost))) - (memq (car sent) + (memq (car doctor-sent) '(bye halt break quit done exit goodbye bye\, stop pause goodbye\, stop pause))) - (doctor-type (doc$ bye))) - ((and (eq (car sent) 'you) - (memq (cadr sent) abusewords)) - (setq found (cadr sent)) - (doctor-type (doc$ abuselst))) - ((eq (car sent) 'whatmeans) - (doctor-def (cadr sent))) - ((equal sent '(parse)) - (doctor-type (list 'subj '= subj ", " - 'verb '= verb "\n" - 'object 'phrase '= obj "," - 'noun 'form '= object "\n" - 'current 'keyword 'is found + (doctor-type (doc$ doctor--bye))) + ((and (eq (car doctor-sent) 'you) + (memq (cadr doctor-sent) doctor--abusewords)) + (setq doctor-found (cadr doctor-sent)) + (doctor-type (doc$ doctor--abuselst))) + ((eq (car doctor-sent) 'whatmeans) + (doctor-def (cadr doctor-sent))) + ((equal doctor-sent '(parse)) + (doctor-type (list 'subj '= doctor-subj ", " + 'verb '= doctor-verb "\n" + 'object 'phrase '= doctor-obj "," + 'noun 'form '= doctor-object "\n" + 'current 'keyword 'is doctor-found ", " 'most 'recent 'possessive - 'is owner "\n" + 'is doctor-owner "\n" 'sentence 'used 'was "..." - '(doc// bak)))) - ((memq (car sent) '(are is do has have how when where who why)) - (doctor-type (doc$ qlist))) - ;; ((eq (car sent) 'forget) - ;; (set (cadr sent) nil) - ;; (doctor-type '((doc$ isee)(doc$ please) - ;; (doc$ continue)\.))) + '(doc// doctor--bak)))) + ((memq (car doctor-sent) '(are is do has have how when where who why)) + (doctor-type (doc$ doctor--qlist))) + ;; ((eq (car doctor-sent) 'forget) + ;; (set (cadr doctor-sent) nil) + ;; (doctor-type '((doc$ doctor--isee)(doc$ doctor--please) + ;; (doc$ doctor--continue)\.))) (t - (if (doctor-defq sent) (doctor-define sent found)) - (if (> (length sent) 12)(setq sent (doctor-shorten sent))) - (setq sent (doctor-correct-spelling (doctor-replace sent replist))) - (cond ((and (not (memq 'me sent))(not (memq 'i sent)) - (memq 'am sent)) - (setq sent (doctor-replace sent '((am . (are))))))) - (cond ((equal (car sent) 'yow) (doctor-zippy)) - ((< (length sent) 2) - (cond ((eq (doctor-meaning (car sent)) 'howdy) + (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found)) + (if (> (length doctor-sent) 12)(setq doctor-sent (doctor-shorten doctor-sent))) + (setq doctor-sent (doctor-correct-spelling (doctor-replace doctor-sent doctor--replist))) + (cond ((and (not (memq 'me doctor-sent))(not (memq 'i doctor-sent)) + (memq 'am doctor-sent)) + (setq doctor-sent (doctor-replace doctor-sent '((am . (are))))))) + (cond ((equal (car doctor-sent) 'yow) (doctor-zippy)) + ((< (length doctor-sent) 2) + (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy) (doctor-howdy)) (t (doctor-short)))) (t - (if (memq 'am sent) - (setq sent (doctor-replace sent '((me . (i)))))) - (setq sent (doctor-fixup sent)) - (if (and (eq (car sent) 'do) (eq (cadr sent) 'not)) + (if (memq 'am doctor-sent) + (setq doctor-sent (doctor-replace doctor-sent '((me . (i)))))) + (setq doctor-sent (doctor-fixup doctor-sent)) + (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not)) (cond ((zerop (random 3)) - (doctor-type '(are you (doc$ afraidof) that \?))) + (doctor-type '(are you (doc$ doctor--afraidof) that \?))) ((zerop (random 2)) (doctor-type '(don\'t tell me what to do \. i am the doctor here!)) (doctor-rthing)) (t - (doctor-type '((doc$ whysay) that i shouldn\'t - (cddr sent) + (doctor-type '((doc$ doctor--whysay) that i shouldn\'t + (cddr doctor-sent) \?)))) - (doctor-go (doctor-wherego sent)))))))) + (doctor-go (doctor-wherego doctor-sent)))))))) ;; Things done to process sentences once read. @@ -949,8 +930,9 @@ Otherwise call the Doctor to parse preceding sentence." "Correct the spelling and expand each word in sentence." (if sent (apply 'append (mapcar (lambda (word) - (if (memq word typos) - (get (get word 'doctor-correction) 'doctor-expansion) + (if (memq word doctor--typos) + (get (get word 'doctor-correction) + 'doctor-expansion) (list word))) sent)))) @@ -972,33 +954,32 @@ Otherwise call the Doctor to parse preceding sentence." (defun doctor-define (sent found) (doctor-svo sent found 1 nil) (and - (doctor-nounp subj) - (not (doctor-pronounp subj)) - subj - (doctor-meaning object) - (put subj 'doctor-meaning (doctor-meaning object)) + (doctor-nounp doctor-subj) + (not (doctor-pronounp doctor-subj)) + doctor-subj + (doctor-meaning doctor-object) + (put doctor-subj 'doctor-meaning (doctor-meaning doctor-object)) t)) (defun doctor-defq (sent) - "Set global var FOUND to first keyword found in sentence SENT." - (setq found nil) + "Set global var DOCTOR-FOUND to first keyword found in sentence SENT." + (setq doctor-found nil) (let ((temp '(means applies mean refers refer related similar defined associated linked like same))) (while temp (if (memq (car temp) sent) - (setq found (car temp) + (setq doctor-found (car temp) temp nil) (setq temp (cdr temp))))) - found) + doctor-found) (defun doctor-def (x) - (progn - (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me)) - nil)) + (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me)) + nil) (defun doctor-forget () "Delete the last element of the history list." - (setq history (reverse (cdr (reverse history))))) + (setq doctor--history (reverse (cdr (reverse doctor--history))))) (defun doctor-query (x) "Prompt for a line of input from the minibuffer until a noun or verb is seen. @@ -1026,16 +1007,16 @@ Put dialogue in buffer." (defun doctor-subjsearch (sent key type) "Search for the subject of a sentence SENT, looking for the noun closest -to and preceding KEY by at least TYPE words. Set global variable subj to +to and preceding KEY by at least TYPE words. Set global variable doctor-subj to the subject noun, and return the portion of the sentence following it." (let ((i (- (length sent) (length (memq key sent)) type))) (while (and (> i -1) (not (doctor-nounp (nth i sent)))) (setq i (1- i))) (cond ((> i -1) - (setq subj (nth i sent)) + (setq doctor-subj (nth i sent)) (nthcdr (1+ i) sent)) (t - (setq subj 'you) + (setq doctor-subj 'you) nil)))) (defun doctor-nounp (x) @@ -1149,12 +1130,12 @@ the subject noun, and return the portion of the sentence following it." (t 'something)))) (defun doctor-getnoun (x) - (cond ((null x)(setq object 'something)) - ((atom x)(setq object x)) + (cond ((null x)(setq doctor-object 'something)) + ((atom x)(setq doctor-object x)) ((eq (length x) 1) - (setq object (cond - ((doctor-nounp (setq object (car x))) object) - (t (doctor-query object))))) + (setq doctor-object (cond + ((doctor-nounp (setq doctor-object (car x))) doctor-object) + (t (doctor-query doctor-object))))) ((eq (car x) 'to) (doctor-build 'to\ (doctor-getnoun (cdr x)))) ((doctor-prepp (car x)) @@ -1170,7 +1151,7 @@ the subject noun, and return the portion of the sentence following it." (car x) (car x)))))) " ") (doctor-getnoun (cdr x)))) - (t (setq object (car x)) + (t (setq doctor-object (car x)) (doctor-build (doctor-build (car x) " ") (doctor-getnoun (cdr x)))) )) @@ -1238,9 +1219,9 @@ the subject noun, and return the portion of the sentence following it." under underneath with without))) (defun doctor-remember (thing) - (cond ((null history) - (setq history (list thing))) - (t (setq history (append history (list thing)))))) + (cond ((null doctor--history) + (setq doctor--history (list thing))) + (t (setq doctor--history (append doctor--history (list thing)))))) (defun doctor-type (x) (setq x (doctor-fix-2 x)) @@ -1317,57 +1298,58 @@ the subject noun, and return the portion of the sentence following it." element pair in RLIST." (apply 'append (mapcar - (function (lambda (x) (cdr (or (assq x rlist) ; either find a replacement - (list x x))))) ; or fake an identity mapping - sent))) + (list x x)))) ; or fake an identity mapping + sent))) (defun doctor-wherego (sent) - (cond ((null sent)(doc$ whereoutp)) + (cond ((null sent)(doc$ doctor--whereoutp)) ((null (doctor-meaning (car sent))) (doctor-wherego (cond ((zerop (random 2)) (reverse (cdr sent))) (t (cdr sent))))) (t - (setq found (car sent)) + (setq doctor-found (car sent)) (doctor-meaning (car sent))))) (defun doctor-svo (sent key type mem) "Find subject, verb and object in sentence SENT with focus on word KEY. TYPE is number of words preceding KEY to start looking for subject. MEM is t if results are to be put on Doctor's memory stack. -Return in the global variables SUBJ, VERB and OBJECT." +Return in the global variables DOCTOR-SUBJ, DOCTOR-VERB, DOCTOR-OBJECT, +and DOCTOR-OBJ." (let ((foo (doctor-subjsearch sent key type))) (or foo (setq foo sent mem nil)) (while (and (null (doctor-verbp (car foo))) (cdr foo)) (setq foo (cdr foo))) - (setq verb (car foo)) - (setq obj (doctor-getnoun (cdr foo))) - (cond ((eq object 'i)(setq object 'me)) - ((eq subj 'me)(setq subj 'i))) - (cond (mem (doctor-remember (list subj verb obj)))))) + (setq doctor-verb (car foo)) + (setq doctor-obj (doctor-getnoun (cdr foo))) + (cond ((eq doctor-object 'i)(setq doctor-object 'me)) + ((eq doctor-subj 'me)(setq doctor-subj 'i))) + (cond (mem (doctor-remember (list doctor-subj doctor-verb doctor-obj)))))) (defun doctor-possess (sent key) "Set possessive in SENT for keyword KEY. -Hack on previous word, setting global variable OWNER to correct result." +Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (let* ((i (- (length sent) (length (memq key sent)) 1)) (prev (if (< i 0) 'your (nth i sent)))) - (setq owner (if (or (doctor-possessivepronounp prev) - (string-equal "s" - (substring (doctor-make-string prev) - -1))) - prev - 'your)))) + (setq doctor-owner + (if (or (doctor-possessivepronounp prev) + (string-equal "s" + (substring (doctor-make-string prev) + -1))) + prev + 'your)))) ;; Output of replies. (defun doctor-txtype (ans) "Output to buffer a list of symbols or strings as a sentence." - (setq *print-upcase* t *print-space* nil) + (setq doctor--*print-upcase* t doctor--*print-space* nil) (mapc 'doctor-type-symbol ans) (insert "\n")) @@ -1375,20 +1357,18 @@ Hack on previous word, setting global variable OWNER to correct result." "Output a symbol to the buffer with some fancy case and spacing hacks." (setq word (doctor-make-string word)) (if (string-equal word "i") (setq word "I")) - (if *print-upcase* - (progn - (setq word (capitalize word)) - (if *print-space* - (insert " ")))) + (when doctor--*print-upcase* + (setq word (capitalize word)) + (if doctor--*print-space* (insert " "))) (cond ((or (string-match "^[.,;:?! ]" word) - (not *print-space*)) + (not doctor--*print-space*)) (insert word)) (t (insert ?\s word))) (and auto-fill-function (> (current-column) fill-column) (apply auto-fill-function nil)) - (setq *print-upcase* (string-match "[.?!]$" word) - *print-space* t)) + (setq doctor--*print-upcase* (string-match "[.?!]$" word) + doctor--*print-space* t)) (defun doctor-build (str1 str2) "Make a symbol out of the concatenation of the two non-list arguments." @@ -1426,220 +1406,219 @@ Hack on previous word, setting global variable OWNER to correct result." (funcall (intern (concat "doctor-" (doctor-make-string destination))))) (defun doctor-desire1 () - (doctor-go (doc$ whereoutp))) + (doctor-go (doc$ doctor--whereoutp))) (defun doctor-huh () - (cond ((< (length sent) 9) (doctor-type (doc$ huhlst))) - (t (doctor-type (doc$ longhuhlst))))) + (cond ((< (length doctor-sent) 9) (doctor-type (doc$ doctor--huhlst))) + (t (doctor-type (doc$ doctor--longhuhlst))))) -(defun doctor-rthing () (doctor-type (doc$ thlst))) +(defun doctor-rthing () (doctor-type (doc$ doctor--thlst))) -(defun doctor-remem () (cond ((null history)(doctor-huh)) - ((doctor-type (doc$ remlst))))) +(defun doctor-remem () (cond ((null doctor--history)(doctor-huh)) + ((doctor-type (doc$ doctor--remlst))))) (defun doctor-howdy () - (cond ((not howdyflag) - (doctor-type '((doc$ hello) what brings you to see me \?)) - (setq howdyflag t)) + (cond ((not doctor--howdyflag) + (doctor-type '((doc$ doctor--hello) what brings you to see me \?)) + (setq doctor--howdyflag t)) (t - (doctor-type '((doc$ ibelieve) we\'ve introduced ourselves already \.)) - (doctor-type '((doc$ please) (doc$ describe) (doc$ things) \.))))) + (doctor-type '((doc$ doctor--ibelieve) we\'ve introduced ourselves already \.)) + (doctor-type '((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--things) \.))))) (defun doctor-when () - (cond ((< (length (memq found sent)) 3)(doctor-short)) + (cond ((< (length (memq doctor-found doctor-sent)) 3)(doctor-short)) (t - (setq sent (cdr (memq found sent))) - (setq sent (doctor-fixup sent)) - (doctor-type '((doc$ whatwhen)(doc// sent) \?))))) + (setq doctor-sent (cdr (memq doctor-found doctor-sent))) + (setq doctor-sent (doctor-fixup doctor-sent)) + (doctor-type '((doc$ doctor--whatwhen)(doc// doctor-sent) \?))))) (defun doctor-conj () - (cond ((< (length (memq found sent)) 4)(doctor-short)) + (cond ((< (length (memq doctor-found doctor-sent)) 4)(doctor-short)) (t - (setq sent (cdr (memq found sent))) - (setq sent (doctor-fixup sent)) - (cond ((eq (car sent) 'of) - (doctor-type '(are you (doc$ sure) that is the real reason \?)) - (setq things (cons (cdr sent) things))) + (setq doctor-sent (cdr (memq doctor-found doctor-sent))) + (setq doctor-sent (doctor-fixup doctor-sent)) + (cond ((eq (car doctor-sent) 'of) + (doctor-type '(are you (doc$ doctor--sure) that is the real reason \?)) + (setq doctor--things (cons (cdr doctor-sent) doctor--things))) (t - (doctor-remember sent) - (doctor-type (doc$ beclst))))))) + (doctor-remember doctor-sent) + (doctor-type (doc$ doctor--beclst))))))) (defun doctor-short () - (cond ((= (car repetitive-shortness) (1- lincount)) - (rplacd repetitive-shortness - (1+ (cdr repetitive-shortness)))) + (cond ((= (car doctor--repetitive-shortness) (1- doctor--lincount)) + (rplacd doctor--repetitive-shortness + (1+ (cdr doctor--repetitive-shortness)))) (t - (rplacd repetitive-shortness 1))) - (rplaca repetitive-shortness lincount) - (cond ((> (cdr repetitive-shortness) 6) - (cond ((not **mad**) - (doctor-type '((doc$ areyou) + (rplacd doctor--repetitive-shortness 1))) + (rplaca doctor--repetitive-shortness doctor--lincount) + (cond ((> (cdr doctor--repetitive-shortness) 6) + (cond ((not doctor--**mad**) + (doctor-type '((doc$ doctor--areyou) just trying to see what kind of things i have in my vocabulary \? please try to carry on a reasonable conversation!)) - (setq **mad** t)) + (setq doctor--**mad** t)) (t (doctor-type '(i give up \. you need a lesson in creative writing \.\.\.)) ))) (t - (cond ((equal sent (doctor-assm '(yes))) - (doctor-type '((doc$ isee) (doc$ inter) (doc$ whysay) this is so \?))) - ((equal sent (doctor-assm '(because))) - (doctor-type (doc$ shortbeclst))) - ((equal sent (doctor-assm '(no))) - (doctor-type (doc$ neglst))) - (t (doctor-type (doc$ shortlst))))))) + (cond ((equal doctor-sent (doctor-assm '(yes))) + (doctor-type '((doc$ doctor--isee) (doc$ doctor--inter) (doc$ doctor--whysay) this is so \?))) + ((equal doctor-sent (doctor-assm '(because))) + (doctor-type (doc$ doctor--shortbeclst))) + ((equal doctor-sent (doctor-assm '(no))) + (doctor-type (doc$ doctor--neglst))) + (t (doctor-type (doc$ doctor--shortlst))))))) -(defun doctor-alcohol () (doctor-type (doc$ drnk))) +(defun doctor-alcohol () (doctor-type (doc$ doctor--drnk))) (defun doctor-desire () - (let ((foo (memq found sent))) + (let ((foo (memq doctor-found doctor-sent))) (cond ((< (length foo) 2) - (doctor-go (doctor-build (doctor-meaning found) 1))) + (doctor-go (doctor-build (doctor-meaning doctor-found) 1))) ((memq (cadr foo) '(a an)) (rplacd foo (append '(to have) (cdr foo))) - (doctor-svo sent found 1 nil) - (doctor-remember (list subj 'would 'like obj)) - (doctor-type (doc$ whywant))) + (doctor-svo doctor-sent doctor-found 1 nil) + (doctor-remember (list doctor-subj 'would 'like doctor-obj)) + (doctor-type (doc$ doctor--whywant))) ((not (eq (cadr foo) 'to)) - (doctor-go (doctor-build (doctor-meaning found) 1))) + (doctor-go (doctor-build (doctor-meaning doctor-found) 1))) (t - (doctor-svo sent found 1 nil) - (doctor-remember (list subj 'would 'like obj)) - (doctor-type (doc$ whywant)))))) + (doctor-svo doctor-sent doctor-found 1 nil) + (doctor-remember (list doctor-subj 'would 'like doctor-obj)) + (doctor-type (doc$ doctor--whywant)))))) (defun doctor-drug () - (doctor-type (doc$ drugs)) - (doctor-remember (list 'you 'used found))) + (doctor-type (doc$ doctor--drugs)) + (doctor-remember (list 'you 'used doctor-found))) (defun doctor-toke () - (doctor-type (doc$ toklst))) + (doctor-type (doc$ doctor--toklst))) (defun doctor-state () - (doctor-type (doc$ states))(doctor-remember (list 'you 'were found))) + (doctor-type (doc$ doctor--states))(doctor-remember (list 'you 'were doctor-found))) (defun doctor-mood () - (doctor-type (doc$ moods))(doctor-remember (list 'you 'felt found))) + (doctor-type (doc$ doctor--moods))(doctor-remember (list 'you 'felt doctor-found))) (defun doctor-fear () - (setq feared (doctor-setprep sent found)) - (doctor-type (doc$ fears)) - (doctor-remember (list 'you 'were 'afraid 'of feared))) + (setq doctor--feared (doctor-setprep doctor-sent doctor-found)) + (doctor-type (doc$ doctor--fears)) + (doctor-remember (list 'you 'were 'afraid 'of doctor--feared))) (defun doctor-hate () - (doctor-svo sent found 1 t) - (cond ((memq 'not sent) (doctor-forget) (doctor-huh)) - ((equal subj 'you) - (doctor-type '(why do you (doc// verb)(doc// obj) \?))) - (t (doctor-type '((doc$ whysay)(list subj verb obj)))))) + (doctor-svo doctor-sent doctor-found 1 t) + (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh)) + ((equal doctor-subj 'you) + (doctor-type '(why do you (doc// doctor-verb)(doc// doctor-obj) \?))) + (t (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj)))))) (defun doctor-symptoms () - (doctor-type '((doc$ maybe) you should consult a medical doctor\; + (doctor-type '((doc$ doctor--maybe) you should consult a medical doctor\; i am a psychotherapist. \.))) (defun doctor-hates () - (doctor-svo sent found 1 t) + (doctor-svo doctor-sent doctor-found 1 t) (doctor-hates1)) (defun doctor-hates1 () - (doctor-type '((doc$ whysay)(list subj verb obj) \?))) + (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj) \?))) (defun doctor-loves () - (doctor-svo sent found 1 t) + (doctor-svo doctor-sent doctor-found 1 t) (doctor-qloves)) (defun doctor-qloves () - (doctor-type '((doc$ bother)(list subj verb obj) \?))) + (doctor-type '((doc$ doctor--bother)(list doctor-subj doctor-verb doctor-obj) \?))) (defun doctor-love () - (doctor-svo sent found 1 t) - (cond ((memq 'not sent) (doctor-forget) (doctor-huh)) - ((memq 'to sent) (doctor-hates1)) + (doctor-svo doctor-sent doctor-found 1 t) + (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh)) + ((memq 'to doctor-sent) (doctor-hates1)) (t - (cond ((equal object 'something) - (setq object '(this person you love)))) - (cond ((equal subj 'you) - (setq lover obj) - (cond ((equal lover '(this person you love)) - (setq lover '(your partner)) + (cond ((equal doctor-object 'something) + (setq doctor-object '(this person you love)))) + (cond ((equal doctor-subj 'you) + (setq doctor--lover doctor-obj) + (cond ((equal doctor--lover '(this person you love)) + (setq doctor--lover '(your partner)) (doctor-forget) (doctor-type '(with whom are you in love \?))) - ((doctor-type '((doc$ please) - (doc$ describe) - (doc$ relation) - (doc// lover) + ((doctor-type '((doc$ doctor--please) + (doc$ doctor--describe) + (doc$ doctor--relation) + (doc// doctor--lover) \.))))) - ((equal subj 'i) + ((equal doctor-subj 'i) (doctor-txtype '(we were discussing you!))) (t (doctor-forget) - (setq obj 'someone) - (setq verb (doctor-build verb 's)) + (setq doctor-obj 'someone) + (setq doctor-verb (doctor-build doctor-verb 's)) (doctor-qloves)))))) (defun doctor-mach () - (setq found (doctor-plural found)) - (doctor-type (doc$ machlst))) + (setq doctor-found (doctor-plural doctor-found)) + (doctor-type (doc$ doctor--machlst))) (defun doctor-sexnoun () (doctor-sexverb)) (defun doctor-sexverb () - (if (or (memq 'me sent)(memq 'myself sent)(memq 'i sent)) + (if (or (memq 'me doctor-sent)(memq 'myself doctor-sent)(memq 'i doctor-sent)) (doctor-foul) - (doctor-type (doc$ sexlst)))) + (doctor-type (doc$ doctor--sexlst)))) (defun doctor-death () - (cond (suicide-flag (doctor-type (doc$ deathlst))) - ((or (equal found 'suicide) - (and (or (equal found 'kill) - (equal found 'killing)) - (memq 'yourself sent))) - (setq suicide-flag t) + (cond (doctor--suicide-flag (doctor-type (doc$ doctor--deathlst))) + ((or (equal doctor-found 'suicide) + (and (or (equal doctor-found 'kill) + (equal doctor-found 'killing)) + (memq 'yourself doctor-sent))) + (setq doctor--suicide-flag t) (doctor-type '(If you are really suicidal, you might want to contact the Samaritans via E-mail: jo@samaritans.org or, at your option, anonymous E-mail: samaritans@anon.twwells.com\ \. or find a Befrienders crisis center at http://www.befrienders.org/\ \. - (doc$ please) (doc$ continue) \.))) - (t (doctor-type (doc$ deathlst))))) + (doc$ doctor--please) (doc$ doctor--continue) \.))) + (t (doctor-type (doc$ doctor--deathlst))))) (defun doctor-foul () - (doctor-type (doc$ foullst))) + (doctor-type (doc$ doctor--foullst))) (defun doctor-family () - (doctor-possess sent found) - (doctor-type (doc$ famlst))) + (doctor-possess doctor-sent doctor-found) + (doctor-type (doc$ doctor--famlst))) ;; I did not add this -- rms. ;; But he might have removed it. I put it back. --roland (defun doctor-rms () - (cond (rms-flag (doctor-type (doc$ stallmanlst))) - (t (setq rms-flag t) (doctor-type '(do you know Stallman \?))))) + (cond (doctor--rms-flag (doctor-type (doc$ doctor--stallmanlst))) + (t (setq doctor--rms-flag t) (doctor-type '(do you know Stallman \?))))) -(defun doctor-school nil (doctor-type (doc$ schoollst))) +(defun doctor-school nil (doctor-type (doc$ doctor--schoollst))) (defun doctor-eliza () - (cond (eliza-flag (doctor-type (doc$ elizalst))) - (t (setq eliza-flag t) - (doctor-type '((doc// found) \? hah ! - (doc$ please) (doc$ continue) \.))))) + (cond (doctor--eliza-flag (doctor-type (doc$ doctor--elizalst))) + (t (setq doctor--eliza-flag t) + (doctor-type '((doc// doctor-found) \? hah ! + (doc$ doctor--please) (doc$ doctor--continue) \.))))) -(defun doctor-sports () (doctor-type (doc$ sportslst))) +(defun doctor-sports () (doctor-type (doc$ doctor--sportslst))) -(defun doctor-math () (doctor-type (doc$ mathlst))) +(defun doctor-math () (doctor-type (doc$ doctor--mathlst))) (defun doctor-zippy () - (cond (zippy-flag (doctor-type (doc$ zippylst))) - (t (setq zippy-flag t) + (cond (doctor--zippy-flag (doctor-type (doc$ doctor--zippylst))) + (t (setq doctor--zippy-flag t) (doctor-type '(yow! are we interactive yet \?))))) -(defun doctor-chat () (doctor-type (doc$ chatlst))) +(defun doctor-chat () (doctor-type (doc$ doctor--chatlst))) (random t) (provide 'doctor) -;; arch-tag: 579380f6-4902-4ea5-bccb-6339e30e1257 ;;; doctor.el ends here diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index 10bf05b2201..e7bd013b2ab 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -1,7 +1,7 @@ ;;; fortune.el --- use fortune to create signatures -;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Holger Schauer <Holger.Schauer@gmx.de> ;; Keywords: games utils mail @@ -285,48 +285,41 @@ and choose the directory as the fortune-file." ;;; Display fortune (defun fortune-in-buffer (interactive &optional file) "Put a fortune cookie in the *fortune* buffer. - -INTERACTIVE is ignored. Optional argument FILE, -when supplied, specifies the file to choose the fortune from." +INTERACTIVE is ignored. Optional argument FILE, when supplied, +specifies the file to choose the fortune from." (let ((fortune-buffer (or (get-buffer fortune-buffer-name) (generate-new-buffer fortune-buffer-name))) (fort-file (expand-file-name (substitute-in-file-name (or file fortune-file))))) (with-current-buffer fortune-buffer - (toggle-read-only 0) - (erase-buffer) - - (if fortune-always-compile - (fortune-compile fort-file)) - - (apply 'call-process - fortune-program ; program to call - nil fortune-buffer nil ; INFILE BUFFER DISPLAY - (append (if (stringp fortune-program-options) - (split-string fortune-program-options) - fortune-program-options) (list fort-file)))))) + (let ((inhibit-read-only t)) + (erase-buffer) + (if fortune-always-compile + (fortune-compile fort-file)) + (apply 'call-process + fortune-program ; program to call + nil fortune-buffer nil ; INFILE BUFFER DISPLAY + (append (if (stringp fortune-program-options) + (split-string fortune-program-options) + fortune-program-options) (list fort-file))))))) ;;;###autoload (defun fortune (&optional file) "Display a fortune cookie. - If called with a prefix asks for the FILE to choose the fortune from, otherwise uses the value of `fortune-file'. If you want to have fortune choose from a set of files in a directory, call interactively with prefix and choose the directory as the fortune-file." - (interactive - (list - (if current-prefix-arg - (fortune-ask-file) - fortune-file))) + (interactive (list (if current-prefix-arg + (fortune-ask-file) + fortune-file))) (fortune-in-buffer t file) (switch-to-buffer (get-buffer fortune-buffer-name)) - (toggle-read-only 1)) + (setq buffer-read-only t)) ;;; Provide ourselves. (provide 'fortune) -;; arch-tag: a1e4cb8a-3792-40e7-86a7-fc75ce094bcc ;;; fortune.el ends here diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 6fcc3136d07..215d95db341 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -201,7 +201,7 @@ should be no leading white space." (let ((boundary (concat "[ \t]*\\([1-9][0-9]*\\)\\(" gametree-full-ply-regexp "\\|" gametree-half-ply-regexp "\\)")) - (limit (save-excursion (beginning-of-line 1) (point)))) + (limit (line-beginning-position 1))) (if (looking-at boundary) (+ (* 2 (string-to-number (match-string 1))) (if (string-match gametree-half-ply-regexp (match-string 2)) 1 0)) @@ -617,5 +617,4 @@ shogi, etc.) players, it is a slightly modified version of Outline mode. (provide 'gametree) -;; arch-tag: aaa30943-9ae4-4cc1-813d-a46f96b7e4f1 ;;; gametree.el ends here diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index dbe3317a020..2c77aa62df1 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -1,7 +1,7 @@ ;;; gomoku.el --- Gomoku game between you and Emacs -;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1994, 1996, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> ;; Maintainer: FSF @@ -195,8 +195,8 @@ Other useful commands:\n \\{gomoku-mode-map}" (gomoku-display-statistics) (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(gomoku-font-lock-keywords t)) - (toggle-read-only t)) + (setq font-lock-defaults '(gomoku-font-lock-keywords t) + buffer-read-only t)) ;;; ;;; THE BOARD. @@ -278,7 +278,7 @@ Other useful commands:\n ;; its contents as a set, i.e. not considering the order of its elements. The ;; highest score is given to the "OOOO" qtuples because playing in such a ;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because -;; not playing in it is just loosing the game, and so on. Note that a +;; not playing in it is just losing the game, and so on. Note that a ;; "polluted" qtuple, i.e. one containing at least one X and at least one O, ;; has score zero because there is no more any point in playing in it, from ;; both an attacking and a defending point of view. @@ -299,15 +299,15 @@ Other useful commands:\n ;; these values will change (hopefully improve) the strength of the program ;; and may change its style (rather aggressive here). -(defconst nil-score 7 "Score of an empty qtuple.") -(defconst Xscore 15 "Score of a qtuple containing one X.") -(defconst XXscore 400 "Score of a qtuple containing two X's.") -(defconst XXXscore 1800 "Score of a qtuple containing three X's.") -(defconst XXXXscore 100000 "Score of a qtuple containing four X's.") -(defconst Oscore 35 "Score of a qtuple containing one O.") -(defconst OOscore 800 "Score of a qtuple containing two O's.") -(defconst OOOscore 15000 "Score of a qtuple containing three O's.") -(defconst OOOOscore 800000 "Score of a qtuple containing four O's.") +(defconst gomoku-nil-score 7 "Score of an empty qtuple.") +(defconst gomoku-Xscore 15 "Score of a qtuple containing one X.") +(defconst gomoku-XXscore 400 "Score of a qtuple containing two X's.") +(defconst gomoku-XXXscore 1800 "Score of a qtuple containing three X's.") +(defconst gomoku-XXXXscore 100000 "Score of a qtuple containing four X's.") +(defconst gomoku-Oscore 35 "Score of a qtuple containing one O.") +(defconst gomoku-OOscore 800 "Score of a qtuple containing two O's.") +(defconst gomoku-OOOscore 15000 "Score of a qtuple containing three O's.") +(defconst gomoku-OOOOscore 800000 "Score of a qtuple containing four O's.") ;; These values are not just random: if, given the following situation: ;; @@ -320,7 +320,7 @@ Other useful commands:\n ;; you want Emacs to play in "a" and not in "b", then the parameters must ;; satisfy the inequality: ;; -;; 6 * XXscore > XXXscore + XXscore +;; 6 * gomoku-XXscore > gomoku-XXXscore + gomoku-XXscore ;; ;; because "a" mainly belongs to six "XX" qtuples (the others are less ;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other @@ -334,26 +334,26 @@ Other useful commands:\n ;; we just have to set up a translation table. (defconst gomoku-score-trans-table - (vector nil-score Xscore XXscore XXXscore XXXXscore 0 - Oscore 0 0 0 0 0 - OOscore 0 0 0 0 0 - OOOscore 0 0 0 0 0 - OOOOscore 0 0 0 0 0 + (vector gomoku-nil-score gomoku-Xscore gomoku-XXscore gomoku-XXXscore gomoku-XXXXscore 0 + gomoku-Oscore 0 0 0 0 0 + gomoku-OOscore 0 0 0 0 0 + gomoku-OOOscore 0 0 0 0 0 + gomoku-OOOOscore 0 0 0 0 0 0) "Vector associating qtuple contents to their score.") ;; If you do not modify drastically the previous constants, the only way for a -;; square to have a score higher than OOOOscore is to belong to a "OOOO" +;; square to have a score higher than gomoku-OOOOscore is to belong to a "OOOO" ;; qtuple, thus to be a winning move. Similarly, the only way for a square to -;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX" +;; have a score between gomoku-XXXXscore and gomoku-OOOOscore is to belong to a "XXXX" ;; qtuple. We may use these considerations to detect when a given move is -;; winning or loosing. +;; winning or losing. -(defconst gomoku-winning-threshold OOOOscore +(defconst gomoku-winning-threshold gomoku-OOOOscore "Threshold score beyond which an Emacs move is winning.") -(defconst gomoku-loosing-threshold XXXXscore +(defconst gomoku-losing-threshold gomoku-XXXXscore "Threshold score beyond which a human move is winning.") @@ -394,10 +394,10 @@ Other useful commands:\n ;;; ;; At initialization the board is empty so that every qtuple amounts for -;; nil-score. Therefore, the score of any square is nil-score times the number +;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score times the number ;; of qtuples that pass through it. This number is 3 in a corner and 20 if you ;; are sufficiently far from the sides. As computing the number is time -;; consuming, we initialize every square with 20*nil-score and then only +;; consuming, we initialize every square with 20*gomoku-nil-score and then only ;; consider squares at less than 5 squares from one side. We speed this up by ;; taking symmetry into account. ;; Also, as it is likely that successive games will be played on a board with @@ -421,7 +421,7 @@ Other useful commands:\n (setq gomoku-score-table (copy-sequence gomoku-saved-score-table)) ;; No, compute it: (setq gomoku-score-table - (make-vector gomoku-vector-length (* 20 nil-score))) + (make-vector gomoku-vector-length (* 20 gomoku-nil-score))) (let (i j maxi maxj maxi2 maxj2) (setq maxi (/ (1+ gomoku-board-width) 2) maxj (/ (1+ gomoku-board-height) 2) @@ -872,7 +872,7 @@ If the game is finished, this command requests for another game." (t (setq score (aref gomoku-score-table square)) (gomoku-play-move square 1) - (cond ((and (>= score gomoku-loosing-threshold) + (cond ((and (>= score gomoku-losing-threshold) ;; Just testing SCORE > THRESHOLD is not enough for ;; detecting wins, it just gives an indication that ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE. @@ -929,11 +929,7 @@ If the game is finished, this command requests for another game." "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." @@ -1206,5 +1202,4 @@ If the game is finished, this command requests for another game." (provide 'gomoku) -;; arch-tag: b1b8205e-77fc-4597-b373-3ea2c04311eb ;;; gomoku.el ends here diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index 5262f4db98d..0db1041e307 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -30,31 +30,31 @@ ;;; Commentary: -;;; Lm is a relatively non-participatory game in which a robot -;;; attempts to maneuver towards a tree at the center of the window -;;; based on unique olfactory cues from each of the 4 directions. If -;;; the smell of the tree increases, then the weights in the robot's -;;; brain are adjusted to encourage this odor-driven behavior in the -;;; future. If the smell of the tree decreases, the robots weights are -;;; adjusted to discourage a correct move. - -;;; In laymen's terms, the search space is initially flat. The point -;;; of training is to "turn up the edges of the search space" so that -;;; the robot rolls toward the center. - -;;; Further, do not become alarmed if the robot appears to oscillate -;;; back and forth between two or a few positions. This simply means -;;; it is currently caught in a local minimum and is doing its best to -;;; work its way out. - -;;; The version of this program as described has a small problem. a -;;; move in a net direction can produce gross credit assignment. for -;;; example, if moving south will produce positive payoff, then, if in -;;; a single move, one moves east,west and south, then both east and -;;; west will be improved when they shouldn't - -;;; Many thanks to Yuri Pryadkin (yuri@rana.usc.edu) for this -;;; concise problem description. +;; Lm is a relatively non-participatory game in which a robot +;; attempts to maneuver towards a tree at the center of the window +;; based on unique olfactory cues from each of the 4 directions. If +;; the smell of the tree increases, then the weights in the robot's +;; brain are adjusted to encourage this odor-driven behavior in the +;; future. If the smell of the tree decreases, the robots weights are +;; adjusted to discourage a correct move. + +;; In laymen's terms, the search space is initially flat. The point +;; of training is to "turn up the edges of the search space" so that +;; the robot rolls toward the center. + +;; Further, do not become alarmed if the robot appears to oscillate +;; back and forth between two or a few positions. This simply means +;; it is currently caught in a local minimum and is doing its best to +;; work its way out. + +;; The version of this program as described has a small problem. a +;; move in a net direction can produce gross credit assignment. for +;; example, if moving south will produce positive payoff, then, if in +;; a single move, one moves east,west and south, then both east and +;; west will be improved when they shouldn't + +;; Many thanks to Yuri Pryadkin (yuri@rana.usc.edu) for this +;; concise problem description. ;;;_* Require (eval-when-compile (require 'cl)) @@ -255,8 +255,8 @@ is non-nil. One interesting value is `turn-on-font-lock'." (lm-display-statistics) (use-local-map lm-mode-map) (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(lm-font-lock-keywords t)) - (toggle-read-only t) + (setq font-lock-defaults '(lm-font-lock-keywords t) + buffer-read-only t) (run-mode-hooks 'lm-mode-hook)) @@ -282,7 +282,7 @@ is non-nil. One interesting value is `turn-on-font-lock'." ;; its contents as a set, i.e. not considering the order of its elements. The ;; highest score is given to the "OOOO" qtuples because playing in such a ;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because -;; not playing in it is just loosing the game, and so on. Note that a +;; not playing in it is just losing the game, and so on. Note that a ;; "polluted" qtuple, i.e. one containing at least one X and at least one O, ;; has score zero because there is no more any point in playing in it, from ;; both an attacking and a defending point of view. @@ -303,47 +303,47 @@ is non-nil. One interesting value is `turn-on-font-lock'." ;; these values will change (hopefully improve) the strength of the program ;; and may change its style (rather aggressive here). -(defconst nil-score 7 "Score of an empty qtuple.") -(defconst Xscore 15 "Score of a qtuple containing one X.") -(defconst XXscore 400 "Score of a qtuple containing two X's.") -(defconst XXXscore 1800 "Score of a qtuple containing three X's.") -(defconst XXXXscore 100000 "Score of a qtuple containing four X's.") -(defconst Oscore 35 "Score of a qtuple containing one O.") -(defconst OOscore 800 "Score of a qtuple containing two O's.") -(defconst OOOscore 15000 "Score of a qtuple containing three O's.") -(defconst OOOOscore 800000 "Score of a qtuple containing four O's.") - -;; These values are not just random: if, given the following situation: -;; -;; . . . . . . . O . -;; . X X a . . . X . -;; . . . X . . . X . -;; . . . X . . . X . -;; . . . . . . . b . -;; -;; you want Emacs to play in "a" and not in "b", then the parameters must -;; satisfy the inequality: -;; -;; 6 * XXscore > XXXscore + XXscore -;; -;; because "a" mainly belongs to six "XX" qtuples (the others are less -;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other -;; conditions are required to obtain sensible moves, but the previous example -;; should illustrate the point. If you manage to improve on these values, -;; please send me a note. Thanks. - - -;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the -;; contents of a qtuple are uniquely determined by the sum of its elements and -;; we just have to set up a translation table. +(defconst lm-nil-score 7 "Score of an empty qtuple.") (defconst lm-score-trans-table - (vector nil-score Xscore XXscore XXXscore XXXXscore 0 - Oscore 0 0 0 0 0 - OOscore 0 0 0 0 0 - OOOscore 0 0 0 0 0 - OOOOscore 0 0 0 0 0 - 0) + (let ((Xscore 15) ; Score of a qtuple containing one X. + (XXscore 400) ; Score of a qtuple containing two X's. + (XXXscore 1800) ; Score of a qtuple containing three X's. + (XXXXscore 100000) ; Score of a qtuple containing four X's. + (Oscore 35) ; Score of a qtuple containing one O. + (OOscore 800) ; Score of a qtuple containing two O's. + (OOOscore 15000) ; Score of a qtuple containing three O's. + (OOOOscore 800000)) ; Score of a qtuple containing four O's. + + ;; These values are not just random: if, given the following situation: + ;; + ;; . . . . . . . O . + ;; . X X a . . . X . + ;; . . . X . . . X . + ;; . . . X . . . X . + ;; . . . . . . . b . + ;; + ;; you want Emacs to play in "a" and not in "b", then the parameters must + ;; satisfy the inequality: + ;; + ;; 6 * XXscore > XXXscore + XXscore + ;; + ;; because "a" mainly belongs to six "XX" qtuples (the others are less + ;; important) while "b" belongs to one "XXX" and one "XX" qtuples. + ;; Other conditions are required to obtain sensible moves, but the + ;; previous example should illustrate the point. If you manage to + ;; improve on these values, please send me a note. Thanks. + + + ;; As we chose values 0, 1 and 6 to denote empty, X and O squares, + ;; the contents of a qtuple are uniquely determined by the sum of + ;; its elements and we just have to set up a translation table. + (vector lm-nil-score Xscore XXscore XXXscore XXXXscore 0 + Oscore 0 0 0 0 0 + OOscore 0 0 0 0 0 + OOOscore 0 0 0 0 0 + OOOOscore 0 0 0 0 0 + 0)) "Vector associating qtuple contents to their score.") @@ -352,12 +352,14 @@ is non-nil. One interesting value is `turn-on-font-lock'." ;; qtuple, thus to be a winning move. Similarly, the only way for a square to ;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX" ;; qtuple. We may use these considerations to detect when a given move is -;; winning or loosing. +;; winning or losing. -(defconst lm-winning-threshold OOOOscore +(defconst lm-winning-threshold + (aref lm-score-trans-table (+ 6 6 6 6)) ;; OOOOscore "Threshold score beyond which an Emacs move is winning.") -(defconst lm-loosing-threshold XXXXscore +(defconst lm-losing-threshold + (aref lm-score-trans-table (+ 1 1 1 1)) ;; XXXXscore "Threshold score beyond which a human move is winning.") @@ -423,7 +425,7 @@ is non-nil. One interesting value is `turn-on-font-lock'." (setq lm-score-table (copy-sequence lm-saved-score-table)) ;; No, compute it: (setq lm-score-table - (make-vector lm-vector-length (* 20 nil-score))) + (make-vector lm-vector-length (* 20 lm-nil-score))) (let (i j maxi maxj maxi2 maxj2) (setq maxi (/ (1+ lm-board-width) 2) maxj (/ (1+ lm-board-height) 2) @@ -769,7 +771,7 @@ If the game is finished, this command requests for another game." (t (setq score (aref lm-score-table square)) (lm-play-move square 1) - (cond ((and (>= score lm-loosing-threshold) + (cond ((and (>= score lm-losing-threshold) ;; Just testing SCORE > THRESHOLD is not enough for ;; detecting wins, it just gives an indication that ;; we confirm with LM-FIND-FILLED-QTUPLE. @@ -824,11 +826,7 @@ If the game is finished, this command requests for another game." "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." @@ -1139,7 +1137,7 @@ because it is overwritten by \"One moment please\"." (defun lm-weights-debug () (if lm-debug - (progn (lm-print-wts) (lm-blackbox) (lm-print-y,s,noise) + (progn (lm-print-wts) (lm-blackbox) (lm-print-y-s-noise) (lm-print-smell)))) ;;;_ - Printing various things @@ -1189,7 +1187,7 @@ because it is overwritten by \"One moment please\"." (insert (format "%S\n" moves)))) -(defun lm-print-y,s,noise-int (direction) +(defun lm-print-y-s-noise-int (direction) (insert (format "%S:lm-y %S, s %S, noise %S \n" (symbol-name direction) (get direction 'y_t) @@ -1197,11 +1195,11 @@ because it is overwritten by \"One moment please\"." (get direction 'noise) ))) -(defun lm-print-y,s,noise () +(defun lm-print-y-s-noise () (interactive) (with-current-buffer "*lm-y,s,noise*" (insert "==============================\n") - (mapc 'lm-print-y,s,noise-int lm-directions))) + (mapc 'lm-print-y-s-noise-int lm-directions))) (defun lm-print-smell-int (direction) (insert (format "%S: smell: %S \n" @@ -1700,5 +1698,4 @@ Use \\[describe-mode] for more info." (provide 'landmark) -;; arch-tag: ae5031be-96e6-459e-a3df-1df53117d3f2 ;;; landmark.el ends here diff --git a/lisp/play/life.el b/lisp/play/life.el index f4a6ee1836e..996b0c6144b 100644 --- a/lisp/play/life.el +++ b/lisp/play/life.el @@ -1,7 +1,7 @@ ;;; life.el --- John Horton Conway's `Life' game for GNU Emacs -;; Copyright (C) 1988, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1988, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Kyle Jones <kyleuunet.uu.net> ;; Maintainer: FSF @@ -163,7 +163,7 @@ generations (this defaults to 1)." (replace-match (life-life-string) t t)) ;; center the pattern horizontally (goto-char (point-min)) - (setq n (/ (- fill-column (save-excursion (end-of-line) (point))) 2)) + (setq n (/ (- fill-column (line-end-position)) 2)) (while (not (eobp)) (indent-to n) (forward-line)) @@ -302,5 +302,4 @@ generations (this defaults to 1)." (provide 'life) -;; arch-tag: e9373544-755e-42f5-a9a1-4d4c422bb97a ;;; life.el ends here diff --git a/lisp/printing.el b/lisp/printing.el index aacd8d42ae4..ecbc82e0144 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -3438,12 +3438,7 @@ See `pr-ps-printer-alist'.") (defun pr-menu-bind () "Install `printing' menu in the menubar. - -On Emacs 20, it replaces the Tools/Print menu by Tools/Printing menu. - -On Emacs 21 and 22, it replaces the File/Print* menu entries by File/Print -menu. - +This replaces the File/Print* menu entries with a File/Print sub-menu. Calls `pr-update-menus' to adjust menus." (interactive) (pr-global-menubar pr-menu-spec) @@ -6670,5 +6665,4 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (provide 'printing) -;; arch-tag: 9ce9ac3f-0f60-4370-900b-1943215d9d18 ;;; printing.el ends here diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 4bbe1e43f85..b45c4b1eb7e 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1,7 +1,8 @@ ;;; ada-mode.el --- major-mode for editing Ada sources -;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Rolf Ebert <ebert@inf.enst.fr> ;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> @@ -460,6 +461,7 @@ The extensions should include a `.' if needed.") (defvar ada-mode-abbrev-table nil "Local abbrev table for Ada mode.") +(define-abbrev-table 'ada-mode-abbrev-table ()) (defvar ada-mode-syntax-table nil "Syntax table to be used for editing Ada source code.") @@ -1117,21 +1119,13 @@ the file name." (funcall (symbol-function 'speedbar-add-supported-extension) spec) (funcall (symbol-function 'speedbar-add-supported-extension) - body))) - ) + body)))) +(defvar ada-font-lock-syntactic-keywords) ; defined below ;;;###autoload -(defun ada-mode () - "Ada mode is the major mode for editing Ada code. -\\{ada-mode-map}" - - (interactive) - (kill-all-local-variables) - - (set-syntax-table ada-mode-syntax-table) - - (set (make-local-variable 'require-final-newline) mode-require-final-newline) +(define-derived-mode ada-mode prog-mode "Ada" + "Ada mode is the major mode for editing Ada code." ;; Set the paragraph delimiters so that one can select a whole block ;; simply with M-h @@ -1302,64 +1296,54 @@ the file name." (define-key ada-mode-map ada-popup-key 'ada-popup-menu)) ;; Support for Abbreviations (the user still need to "M-x abbrev-mode" - (define-abbrev-table 'ada-mode-abbrev-table ()) (setq local-abbrev-table ada-mode-abbrev-table) ;; Support for which-function mode - (make-local-variable 'which-func-functions) - (setq which-func-functions '(ada-which-function)) + (set (make-local-variable 'which-func-functions) '(ada-which-function)) ;; Support for indent-new-comment-line (Especially for XEmacs) (set (make-local-variable 'comment-multi-line) nil) ;; Support for add-log - (set (make-local-variable 'add-log-current-defun-function) 'ada-which-function) - - (setq major-mode 'ada-mode - mode-name "Ada") - - (use-local-map ada-mode-map) + (set (make-local-variable 'add-log-current-defun-function) + 'ada-which-function) (easy-menu-add ada-mode-menu ada-mode-map) - (set-syntax-table ada-mode-syntax-table) - (set (make-local-variable 'skeleton-further-elements) '((< '(backward-delete-char-untabify (min ada-indent (current-column)))))) (add-hook 'skeleton-end-hook 'ada-adjust-case-skeleton nil t) - (run-mode-hooks 'ada-mode-hook) - ;; To be run after the hook, in case the user modified ;; ada-fill-comment-prefix - ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs - ;; then it was already available before running the hook, and if he - ;; modifies it in the hook, he might as well modify comment-start instead. - (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- ")) - - ;; Run this after the hook to give the users a chance to activate - ;; font-lock-mode - - (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) - (featurep 'xemacs)) - (ada-initialize-syntax-table-properties) - (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t)) - - ;; the following has to be done after running the ada-mode-hook - ;; because users might want to set the values of these variable - ;; inside the hook - ;; FIXME: it might even be set later on via file-local vars, no? - ;; so maybe ada-keywords should be set lazily. - (cond ((eq ada-language-version 'ada83) - (setq ada-keywords ada-83-keywords)) - ((eq ada-language-version 'ada95) - (setq ada-keywords ada-95-keywords)) - ((eq ada-language-version 'ada2005) - (setq ada-keywords ada-2005-keywords))) - - (if ada-auto-case - (ada-activate-keys-for-case))) + (add-hook 'hack-local-variables-hook + (lambda () + (set (make-local-variable 'comment-start) + (or ada-fill-comment-prefix "-- ")) + + ;; Run this after the hook to give the users a chance + ;; to activate font-lock-mode. + + (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (featurep 'xemacs)) + (ada-initialize-syntax-table-properties) + (add-hook 'font-lock-mode-hook + 'ada-handle-syntax-table-properties nil t)) + + ;; FIXME: ada-language-version might be set in the mode + ;; hook or it might even be set later on via file-local + ;; vars, so ada-keywords should be set lazily. + (cond ((eq ada-language-version 'ada83) + (setq ada-keywords ada-83-keywords)) + ((eq ada-language-version 'ada95) + (setq ada-keywords ada-95-keywords)) + ((eq ada-language-version 'ada2005) + (setq ada-keywords ada-2005-keywords))) + + (if ada-auto-case + (ada-activate-keys-for-case))) + nil 'local)) (defun ada-adjust-case-skeleton () "Adjust the case of the text inserted by a skeleton." @@ -2471,8 +2455,7 @@ and the offset." (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) @@ -2579,10 +2562,7 @@ and the offset." (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)) @@ -2601,7 +2581,7 @@ and the offset." ((and (= (char-after) ?#) (equal ada-which-compiler 'gnat) (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)")) - (list (save-excursion (beginning-of-line) (point)) 0)) + (list (point-at-bol) 0)) ;;-------------------------------- ;; starting with ')' (end of a parameter list) @@ -4048,11 +4028,7 @@ Point is moved at the beginning of the SEARCH-RE." (funcall search-func search-re limit 1)) (setq begin (match-beginning 0)) (setq end (match-end 0)) - - (setq parse-result (parse-partial-sexp - (save-excursion (beginning-of-line) (point)) - (point))) - + (setq parse-result (parse-partial-sexp (point-at-bol) (point))) (cond ;; ;; If inside a string, skip it (and the following comments) @@ -4271,16 +4247,12 @@ of the region. Otherwise, operate only on the current line." (save-excursion (beginning-of-line) (insert-char ? ada-indent)) - (if (save-excursion (= (point) (progn (beginning-of-line) (point)))) - (forward-char ada-indent))) + (if (bolp) (forward-char ada-indent))) (defun ada-untab-hard () "Indent current line to previous tab stop." (interactive) - (let ((bol (save-excursion (progn (beginning-of-line) (point)))) - (eol (save-excursion (progn (end-of-line) (point))))) - (indent-rigidly bol eol (- 0 ada-indent)))) - + (indent-rigidly (point-at-bol) (point-at-eol) (- 0 ada-indent))) ;; ------------------------------------------------------------ @@ -4643,7 +4615,7 @@ Moves to 'begin' if in a declarative part." ["Gdb Documentation" (info "gdb") (eq ada-which-compiler 'gnat)] ["Ada95 Reference Manual" (info "arm95") t]) - ("Options" :included (eq major-mode 'ada-mode) + ("Options" :included (derived-mode-p 'ada-mode) ["Auto Casing" (setq ada-auto-case (not ada-auto-case)) :style toggle :selected ada-auto-case] ["Auto Indent After Return" @@ -4680,7 +4652,7 @@ Moves to 'begin' if in a declarative part." ["Load..." ada-set-default-project-file t] ["New..." ada-prj-new t] ["Edit..." ada-prj-edit t]) - ("Goto" :included (eq major-mode 'ada-mode) + ("Goto" :included (derived-mode-p 'ada-mode) ["Goto Declaration/Body" ada-goto-declaration (eq ada-which-compiler 'gnat)] ["Goto Body" ada-goto-body @@ -4709,7 +4681,7 @@ Moves to 'begin' if in a declarative part." ["-" nil nil] ["Other File" ff-find-other-file t] ["Other File Other Window" ada-ff-other-window t]) - ("Edit" :included (eq major-mode 'ada-mode) + ("Edit" :included (derived-mode-p 'ada-mode) ["Search File On Source Path" ada-find-file t] ["------" nil nil] ["Complete Identifier" ada-complete-identifier t] @@ -4741,7 +4713,7 @@ Moves to 'begin' if in a declarative part." ["-----" nil nil] ["Narrow to subprogram" ada-narrow-to-defun t]) ("Templates" - :included (eq major-mode 'ada-mode) + :included (derived-mode-p 'ada-mode) ["Header" ada-header t] ["-" nil nil] ["Package Body" ada-package-body t] @@ -5292,11 +5264,7 @@ Use \\[widen] to go back to the full visibility for the buffer." (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)) @@ -5538,5 +5506,4 @@ This function typically is to be hooked into `ff-file-created-hook'." ;;; provide ourselves (provide 'ada-mode) -;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270 ;;; ada-mode.el ends here diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index 630f83e58aa..3d10e482be1 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -196,21 +196,17 @@ One item per line should be found in the file." (widen) (goto-char (point-min)) (while (not (eobp)) - (set 'line (buffer-substring-no-properties - (point) (save-excursion (end-of-line) (point)))) + (set 'line (buffer-substring-no-properties (point) (point-at-eol))) (add-to-list 'list line) - (forward-line 1) - ) + (forward-line 1)) (kill-buffer nil) (set-buffer buffer) (set 'ada-prj-current-values (plist-put ada-prj-current-values symbol (append (plist-get ada-prj-current-values symbol) - (reverse list)))) - ) - (ada-prj-display-page 2) - )) + (reverse list))))) + (ada-prj-display-page 2))) (defun ada-prj-subdirs-of (dir) "Return a list of all the subdirectories of DIR, recursively." @@ -518,11 +514,18 @@ If FILENAME is given, edit that file." (set (make-local-variable 'ada-prj-ada-buffer) ada-buffer) - (use-local-map (copy-keymap custom-mode-map)) - (local-set-key "\C-x\C-s" 'ada-prj-save) + (use-local-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map custom-mode-map) + (define-key map "\C-x\C-s" 'ada-prj-save) + map)) - (make-local-variable 'widget-keymap) - (define-key widget-keymap "\C-x\C-s" 'ada-prj-save) + ;; FIXME: Not sure if this works!! + (set (make-local-variable 'widget-keymap) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map widget-keymap) + (define-key map "\C-x\C-s" 'ada-prj-save) + map)) (set (make-local-variable 'ada-old-cross-prefix) (ada-xref-get-project-field 'cross-prefix)) @@ -568,8 +571,7 @@ Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." ;; variables (momentary-string-display (concat "*****Help*****\n" text "\n**************\n") - (save-excursion (forward-line) (beginning-of-line) (point))) - ))) + (point-at-bol 2))))) (defun ada-prj-show-value (widget widget-modified event) "Show the current field value in WIDGET. @@ -681,5 +683,4 @@ AFTER-TEXT is inserted just after the widget." (provide 'ada-prj) -;; arch-tag: 65978c77-816e-49c6-896e-6905605d1b4c ;;; ada-prj.el ends here diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 73c31f08cd3..36e297182cf 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1,7 +1,8 @@ ;; ada-xref.el --- for lookup and completion in Ada mode -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> ;; Rolf Ebert <ebert@inf.enst.fr> @@ -166,7 +167,7 @@ This has the same syntax as in the project file (with variable substitution)." 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 @@ -221,7 +222,7 @@ Used to go back to these positions.") 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.") @@ -324,7 +325,7 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command." (add-to-list 'ada-xref-runtime-library-specs-path (buffer-substring-no-properties (point) - (save-excursion (end-of-line) (point))))) + (point-at-eol)))) (forward-line 1)) ;; Object path @@ -338,7 +339,7 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command." (add-to-list 'ada-xref-runtime-library-ali-path (buffer-substring-no-properties (point) - (save-excursion (end-of-line) (point))))) + (point-at-eol)))) (forward-line 1)) ) (kill-buffer nil)))) @@ -767,7 +768,7 @@ is non-nil, prompt the user to select one. If none are found, return '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 @@ -781,7 +782,7 @@ is non-nil, prompt the user to select one. If none are found, return '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 ".") @@ -1015,7 +1016,7 @@ existing buffer `*gnatfind*', if there is one." ;; 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)) @@ -1817,7 +1818,7 @@ Information is extracted from the ali file." (beginning-of-line) (if declaration-found (let ((current-line (buffer-substring - (point) (save-excursion (end-of-line) (point))))) + (point) (point-at-eol)))) (save-excursion (forward-line 1) (beginning-of-line) @@ -2379,5 +2380,4 @@ For instance, it creates the gnat-specific menus, sets some hooks for (provide 'ada-xref) -;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e ;;; ada-xref.el ends here diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 742bcf726eb..3e3e315c500 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -87,6 +87,7 @@ (require 'cl)) (require 'easymenu) +(require 'cc-mode) ;; Just to get the rid of the byte compiler warning. The code for ;; this function and its friends are too complex for their own good. @@ -1004,12 +1005,21 @@ The SYNTAX-ALIST element is also used to initialize (defvar antlr-mode-hook nil "Hook called by `antlr-mode'.") -(defvar antlr-mode-syntax-table nil +(defvar antlr-mode-syntax-table + (let ((st (make-syntax-table))) + (c-populate-syntax-table st) + st) "Syntax table used in `antlr-mode' buffers. If non-nil, it will be initialized in `antlr-mode'.") ;; used for "in Java/C++ code" = syntactic-depth>0 -(defvar antlr-action-syntax-table nil +(defvar antlr-action-syntax-table + (let ((st (copy-syntax-table antlr-mode-syntax-table)) + (slist (nth 3 antlr-font-lock-defaults))) + (while slist + (modify-syntax-entry (caar slist) (cdar slist) st) + (setq slist (cdr slist))) + st) "Syntax table used for ANTLR action parsing. Initialized by `antlr-mode-syntax-table', changed by SYNTAX-ALIST in `antlr-font-lock-defaults'. This table should be selected if you use @@ -2189,7 +2199,7 @@ export vocabulary specified in that file." (insert-file-contents file t nil nil t) (normal-mode t) ; necessary for major-mode, syntax ; table and `antlr-language' - (when (eq major-mode 'antlr-mode) + (when (derived-mode-p 'antlr-mode) (let* ((file-deps (antlr-file-dependencies)) (file (car file-deps))) (when file-deps @@ -2373,7 +2383,7 @@ are used according to variable `antlr-unknown-file-formats' and a commentary with value `antlr-help-unknown-file-text' is added. The *Help* buffer always starts with the text in `antlr-help-rules-intro'." (interactive) - (if (null (eq major-mode 'makefile-mode)) + (if (null (derived-mode-p 'makefile-mode)) (antlr-with-displaying-help-buffer 'antlr-insert-makefile-rules) (push-mark) (antlr-insert-makefile-rules t))) @@ -2563,13 +2573,15 @@ ANTLR's syntax and influences the auto indentation, see "Find language in `antlr-language-alist' for language option. If SEARCH is non-nil, find element for language option. Otherwise, find the default language." - (let ((value (and search - (save-excursion - (goto-char (point-min)) - (re-search-forward (cdr antlr-language-limit-n-regexp) - (car antlr-language-limit-n-regexp) - t)) - (match-string 1))) + (let ((value + (and search + (save-excursion + (goto-char (point-min)) + (re-search-forward (cdr antlr-language-limit-n-regexp) + (+ (point) + (car antlr-language-limit-n-regexp)) + t)) + (match-string 1))) (seq antlr-language-alist) r) ;; Like (find VALUE antlr-language-alist :key 'cddr :test 'member) @@ -2581,35 +2593,20 @@ the default language." (car r))) ;;;###autoload -(defun antlr-mode () - "Major mode for editing ANTLR grammar files. -\\{antlr-mode-map}" - (interactive) - (kill-all-local-variables) +(define-derived-mode antlr-mode prog-mode + ;; FIXME: Since it uses cc-mode, it bumps into c-update-modeline's + ;; limitation to mode-name being a string. + ;; '("Antlr." (:eval (cadr (assq antlr-language antlr-language-alist)))) + "Antlr" + "Major mode for editing ANTLR grammar files." + :abbrev-table antlr-mode-abbrev-table (c-initialize-cc-mode) ; cc-mode is required (unless (fboundp 'c-forward-sws) ; see above (fset 'antlr-c-forward-sws 'c-forward-syntactic-ws)) ;; ANTLR specific ---------------------------------------------------------- - (setq major-mode 'antlr-mode - mode-name "Antlr") - (setq local-abbrev-table antlr-mode-abbrev-table) - (unless antlr-mode-syntax-table - (setq antlr-mode-syntax-table (make-syntax-table)) - (c-populate-syntax-table antlr-mode-syntax-table)) - (set-syntax-table antlr-mode-syntax-table) - (unless antlr-action-syntax-table - (let ((slist (nth 3 antlr-font-lock-defaults))) - (setq antlr-action-syntax-table - (copy-syntax-table antlr-mode-syntax-table)) - (while slist - (modify-syntax-entry (caar slist) (cdar slist) - antlr-action-syntax-table) - (setq slist (cdr slist))))) - (use-local-map antlr-mode-map) - (make-local-variable 'antlr-language) (unless antlr-language - (setq antlr-language - (or (antlr-language-option t) (antlr-language-option nil)))) + (set (make-local-variable 'antlr-language) + (or (antlr-language-option t) (antlr-language-option nil)))) (if (stringp (cadr (assq antlr-language antlr-language-alist))) (setq mode-name (concat "Antlr." @@ -2627,33 +2624,24 @@ the default language." (t ; cc-mode upto 5.28 (antlr-c-init-language-vars))) ; do it myself (c-basic-common-init antlr-language (or antlr-indent-style "gnu")) - (make-local-variable 'outline-regexp) - (make-local-variable 'outline-level) - (make-local-variable 'require-final-newline) - (make-local-variable 'indent-line-function) - (make-local-variable 'indent-region-function) - (setq outline-regexp "[^#\n\^M]" - outline-level 'c-outline-level) ; TODO: define own - (setq require-final-newline mode-require-final-newline) - (setq indent-line-function 'antlr-indent-line - indent-region-function nil) ; too lazy + (set (make-local-variable 'outline-regexp) "[^#\n\^M]") + (set (make-local-variable 'outline-level) 'c-outline-level) ;TODO: define own + (set (make-local-variable 'indent-line-function) 'antlr-indent-line) + (set (make-local-variable 'indent-region-function) nil) ; too lazy (setq comment-start "// " comment-end "" comment-start-skip "/\\*+ *\\|// *") ;; various ----------------------------------------------------------------- - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults antlr-font-lock-defaults) + (set (make-local-variable 'font-lock-defaults) antlr-font-lock-defaults) (easy-menu-add antlr-mode-menu) - (make-local-variable 'imenu-create-index-function) - (setq imenu-create-index-function 'antlr-imenu-create-index-function) - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression t) ; fool stupid test + (set (make-local-variable 'imenu-create-index-function) + 'antlr-imenu-create-index-function) + (set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test (and antlr-imenu-name ; there should be a global variable... (fboundp 'imenu-add-to-menubar) (imenu-add-to-menubar (if (stringp antlr-imenu-name) antlr-imenu-name "Index"))) - (antlr-set-tabs) - (run-mode-hooks 'antlr-mode-hook)) + (antlr-set-tabs)) ;; A smarter version of `group-buffers-menu-by-mode-then-alphabetically' (in ;; XEmacs) could use the following property. The header of the submenu would diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index f5fef76a009..12179e8f9b8 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -77,15 +77,14 @@ (define-key map "\C-c;" 'comment-region) (define-key map "\C-j" 'newline-and-indent) (define-key map "\C-m" 'newline-and-indent) - (define-key map [menu-bar] (make-sparse-keymap)) - (define-key map [menu-bar asm-mode] (cons "Asm" map)) - (define-key map [comment-region] + (define-key map [menu-bar asm-mode] (cons "Asm" (make-sparse-keymap))) + (define-key map [menu-bar asm-mode comment-region] '(menu-item "Comment Region" comment-region :help "Comment or uncomment each line in the region")) - (define-key map [newline-and-indent] + (define-key map [menu-bar asm-mode newline-and-indent] '(menu-item "Insert Newline and Indent" newline-and-indent :help "Insert a newline, then indent according to major mode")) - (define-key map [asm-colon] + (define-key map [menu-bar asm-mode asm-colon] '(menu-item "Insert Colon" asm-colon :help "Insert a colon; if it follows a label, delete the label's indentation")) map) @@ -142,16 +141,12 @@ Special commands: (set-syntax-table (make-syntax-table asm-mode-syntax-table)) (modify-syntax-entry asm-comment-char "< b") - (make-local-variable 'comment-start) - (setq comment-start (string asm-comment-char)) - (make-local-variable 'comment-add) - (setq comment-add 1) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "\\(?:\\s<+\\|/[/*]+\\)[ \t]*") - (make-local-variable 'comment-end-skip) - (setq comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)") - (make-local-variable 'comment-end) - (setq comment-end "") + (set (make-local-variable 'comment-start) (string asm-comment-char)) + (set (make-local-variable 'comment-add) 1) + (set (make-local-variable 'comment-start-skip) + "\\(?:\\s<+\\|/[/*]+\\)[ \t]*") + (set (make-local-variable 'comment-end-skip) "[ \t]*\\(\\s>\\|\\*+/\\)") + (set (make-local-variable 'comment-end) "") (setq fill-prefix "\t")) (defun asm-indent-line () diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 004bb3de78d..827949cc70e 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -78,14 +78,8 @@ searching backwards at another AC_... command." (match-string-no-properties 3))))) ;;;###autoload -(defun autoconf-mode () +(define-derived-mode autoconf-mode prog-mode "Autoconf" "Major mode for editing Autoconf configure.in files." - (interactive) - (kill-all-local-variables) - (use-local-map autoconf-mode-map) - (setq major-mode 'autoconf-mode) - (setq mode-name "Autoconf") - (set-syntax-table autoconf-mode-syntax-table) (set (make-local-variable 'parens-require-spaces) nil) ; for M4 arg lists (set (make-local-variable 'defun-prompt-regexp) "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+") @@ -100,8 +94,7 @@ searching backwards at another AC_... command." (set (make-local-variable 'imenu-syntax-alist) '(("_" . "w"))) (set (make-local-variable 'indent-line-function) #'indent-relative) (set (make-local-variable 'add-log-current-defun-function) - #'autoconf-current-defun-function) - (run-mode-hooks 'autoconf-mode-hook)) + #'autoconf-current-defun-function)) (provide 'autoconf-mode) (provide 'autoconf) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index b17703b0305..8639ebba3bc 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -266,8 +266,10 @@ With universal argument, inserts the analysis as a comment on that line." (symbol-value 'subword-mode)) "w" ""))) + ;; FIXME: Derived modes might want to use something else + ;; than a string for `mode-name'. (bare-mode-name (if (string-match "\\(^[^/]*\\)/" mode-name) - (substring mode-name (match-beginning 1) (match-end 1)) + (match-string 1 mode-name) mode-name))) ;; (setq c-submode-indicators ;; (if (> (length fmt) 1) @@ -3974,17 +3976,19 @@ command to conveniently insert and align the necessary backslashes." ;; "Invalid search bound (wrong side of point)" ;; error in the subsequent re-search. Maybe ;; another fix would be needed (2007-12-08). - (or (<= (- (cdr c-lit-limits) 2) (point)) - (and - (search-forward-regexp - (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)") - (- (cdr c-lit-limits) 2) t) - (not (search-forward-regexp - "\\(\\s \\|\\sw\\)" - (- (cdr c-lit-limits) 2) 'limit)) - ;; The comment ender IS on its own line. Exclude - ;; this line from the filling. - (set-marker end (c-point 'bol))))) +; (or (<= (- (cdr c-lit-limits) 2) (point)) +; 2010-10-17 Construct removed. +; (or (< (- (cdr c-lit-limits) 2) (point)) + (and + (search-forward-regexp + (concat "\\=[ \t]*\\(" c-current-comment-prefix "\\)") + (- (cdr c-lit-limits) 2) t) + (not (search-forward-regexp + "\\(\\s \\|\\sw\\)" + (- (cdr c-lit-limits) 2) 'limit)) + ;; The comment ender IS on its own line. Exclude this + ;; line from the filling. + (set-marker end (c-point 'bol))));) ;; The comment ender is hanging. Replace all space between it ;; and the last word either by one or two 'x's (when diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index a99876a6bfc..d2e5657d34a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1045,6 +1045,12 @@ casts and declarations are fontified. Used on level 2 and higher." ;; The position of the next token after the closing paren of ;; the last detected cast. last-cast-end + ;; Start of containing declaration (if any); limit for searching + ;; backwards for it. + decl-start decl-search-lim + ;; Start of containing declaration (if any); limit for searching + ;; backwards for it. + decl-start decl-search-lim ;; The result from `c-forward-decl-or-cast-1'. decl-or-cast ;; The maximum of the end positions of all the checked type @@ -1184,20 +1190,29 @@ casts and declarations are fontified. Used on level 2 and higher." match-pos context last-cast-end)) (if (not decl-or-cast) - ;; Are we at a declarator? - ;; Try to go back to the declaration to check this. - (let (paren-state bod-res lim encl-pos is-typedef) + ;; Are we at a declarator? Try to go back to the declaration + ;; to check this. Note that `c-beginning-of-decl-1' is slow, + ;; so we cache its result between calls. + (let (paren-state bod-res encl-pos is-typedef) (goto-char start-pos) (save-excursion - (setq lim (and (c-syntactic-skip-backward "^;" nil t) - (point)))) + (unless (and decl-search-lim + (eq decl-search-lim + (save-excursion + (c-syntactic-skip-backward "^;" nil t) + (point)))) + (setq decl-search-lim + (and (c-syntactic-skip-backward "^;" nil t) (point))) + (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim))) + (if (and (eq bod-res 'same) + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?\}))) + (c-beginning-of-decl-1 decl-search-lim)) + (setq decl-start (point)))) + (save-excursion - (setq bod-res (car (c-beginning-of-decl-1 lim))) - (if (and (eq bod-res 'same) - (progn - (c-backward-syntactic-ws) - (eq (char-before) ?\}))) - (c-beginning-of-decl-1 lim)) + (goto-char decl-start) ;; We're now putatively at the declaration. (setq paren-state (c-parse-state)) ;; At top level or inside a "{"? @@ -1306,6 +1321,40 @@ casts and declarations are fontified. Used on level 2 and higher." nil))) +(defun c-font-lock-enum-tail (limit) + ;; Fontify an enum's identifiers when POINT is within the enum's brace + ;; block. + ;; + ;; This function will be called from font-lock for a region bounded by POINT + ;; and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; Fontification". + ;; + ;; Note that this function won't attempt to fontify beyond the end of the + ;; current enum block, if any. + (let* ((paren-state (c-parse-state)) + (encl-pos (c-most-enclosing-brace paren-state)) + (start (point)) + ) + (when (and + encl-pos + (eq (char-after encl-pos) ?\{) + (save-excursion + (goto-char encl-pos) + (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward) + (or (looking-at c-brace-list-key) ; "enum" + (progn (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward) + (looking-at c-brace-list-key))))) + (c-syntactic-skip-backward "^{," nil t) + (c-put-char-property (1- (point)) 'c-type 'c-decl-id-start) + + (c-forward-syntactic-ws) + (c-font-lock-declarators limit t nil))) + nil) + (c-lang-defconst c-simple-decl-matchers "Simple font lock matchers for types and declarations. These are used on level 2 only and so aren't combined with `c-complex-decl-matchers'." @@ -1570,11 +1619,14 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." generic casts and declarations are fontified. Used on level 2 and higher." - t `(;; Fontify the identifiers inside enum lists. (The enum type + t `(,@(when (c-lang-const c-brace-id-list-kwds) + ;; Fontify the remaining identifiers inside an enum list when we start + ;; inside it. + `(c-font-lock-enum-tail + ;; Fontify the identifiers inside enum lists. (The enum type ;; name is handled by `c-simple-decl-matchers' or ;; `c-complex-decl-matchers' below. - ,@(when (c-lang-const c-brace-id-list-kwds) - `((,(c-make-font-lock-search-function + (,(c-make-font-lock-search-function (concat "\\<\\(" (c-make-keywords-re nil (c-lang-const c-brace-id-list-kwds)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ba056133651..ad6b6787652 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2676,15 +2676,15 @@ Identifier syntax is in effect when this is matched \(see c++ (concat "\\(" "[*\(&]" "\\|" - (concat "\\(" ; 2 + (c-lang-const c-type-decl-prefix-key) + "\\|" + (concat "\\(" ; 3 ;; If this matches there's special treatment in ;; `c-font-lock-declarators' and ;; `c-font-lock-declarations' that check for a ;; complete name followed by ":: *". (c-lang-const c-identifier-start) "\\)") - "\\|" - (c-lang-const c-type-decl-prefix-key) "\\)" "\\([^=]\\|$\\)") pike "\\(\\*\\)\\([^=]\\|$\\)") diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 505a5663ebc..3196fc59023 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -487,15 +487,10 @@ that requires a literal mode spec at compile time." ;; these variables should always be buffer local; they do not affect ;; indentation style. - (make-local-variable 'parse-sexp-ignore-comments) - (make-local-variable 'indent-line-function) - (make-local-variable 'indent-region-function) - (make-local-variable 'normal-auto-fill-function) (make-local-variable 'comment-start) (make-local-variable 'comment-end) (make-local-variable 'comment-start-skip) - (make-local-variable 'comment-multi-line) - (make-local-variable 'comment-line-break-function) + (make-local-variable 'paragraph-start) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-ignore-fill-prefix) @@ -503,18 +498,18 @@ that requires a literal mode spec at compile time." (make-local-variable 'adaptive-fill-regexp) ;; now set their values - (setq parse-sexp-ignore-comments t - indent-line-function 'c-indent-line - indent-region-function 'c-indent-region - normal-auto-fill-function 'c-do-auto-fill - comment-multi-line t - comment-line-break-function 'c-indent-new-comment-line) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'indent-line-function) 'c-indent-line) + (set (make-local-variable 'indent-region-function) 'c-indent-region) + (set (make-local-variable 'normal-auto-fill-function) 'c-do-auto-fill) + (set (make-local-variable 'comment-multi-line) t) + (set (make-local-variable 'comment-line-break-function) + 'c-indent-new-comment-line) ;; Install `c-fill-paragraph' on `fill-paragraph-function' so that a ;; direct call to `fill-paragraph' behaves better. This still ;; doesn't work with filladapt but it's better than nothing. - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'c-fill-paragraph) + (set (make-local-variable 'fill-paragraph-function) 'c-fill-paragraph) ;; Initialise the cache of brace pairs, and opening braces/brackets/parens. (c-state-cache-init) @@ -532,22 +527,19 @@ that requires a literal mode spec at compile time." ;; Emacs. (when (boundp 'parse-sexp-lookup-properties) - (make-local-variable 'parse-sexp-lookup-properties) - (setq parse-sexp-lookup-properties t)) + (set (make-local-variable 'parse-sexp-lookup-properties) t)) ;; Same as above for XEmacs. (when (boundp 'lookup-syntax-properties) - (make-local-variable 'lookup-syntax-properties) - (setq lookup-syntax-properties t))) + (set (make-local-variable 'lookup-syntax-properties) t))) ;; Use this in Emacs 21+ to avoid meddling with the rear-nonsticky ;; property on each character. (when (boundp 'text-property-default-nonsticky) - (make-local-variable 'text-property-default-nonsticky) (mapc (lambda (tprop) (unless (assq tprop text-property-default-nonsticky) - (setq text-property-default-nonsticky - (cons `(,tprop . t) text-property-default-nonsticky)))) + (set (make-local-variable 'text-property-default-nonsticky) + (cons `(,tprop . t) text-property-default-nonsticky)))) '(syntax-table category c-type))) ;; In Emacs 21 and later it's possible to turn off the ad-hoc @@ -587,8 +579,7 @@ that requires a literal mode spec at compile time." (setq c-offsets-alist (copy-alist c-offsets-alist)) ;; setup the comment indent variable in a Emacs version portable way - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'c-comment-indent) + (set (make-local-variable 'comment-indent-function) 'c-comment-indent) ;; ;; Put submode indicators onto minor-mode-alist, but only once. ;; (or (assq 'c-submode-indicators minor-mode-alist) @@ -660,16 +651,14 @@ compatible with old code; callers should always specify it." (funcall c-before-font-lock-function (point-min) (point-max) (- (point-max) (point-min)))))) - (make-local-variable 'outline-regexp) - (make-local-variable 'outline-level) - (setq outline-regexp "[^#\n\^M]" - outline-level 'c-outline-level) + (set (make-local-variable 'outline-regexp) "[^#\n\^M]") + (set (make-local-variable 'outline-level) 'c-outline-level) (let ((rfn (assq mode c-require-final-newline))) (when rfn - (make-local-variable 'require-final-newline) (and (cdr rfn) - (setq require-final-newline mode-require-final-newline))))) + (set (make-local-variable 'require-final-newline) + mode-require-final-newline))))) (defun c-count-cfss (lv-alist) ;; LV-ALIST is an alist like `file-local-variables-alist'. Count how many @@ -1029,10 +1018,6 @@ Note that the style variables are always made local to the buffer." (buffer-substring-no-properties type-pos term-pos) (buffer-substring-no-properties beg end))))))) - ;; (c-new-BEG c-new-END) will be the region to fontify. It may become - ;; larger than (beg end). - (setq c-new-BEG beg - c-new-END end) (if c-get-state-before-change-functions (mapc (lambda (fn) (funcall fn beg end)) @@ -1086,6 +1071,10 @@ Note that the style variables are always made local to the buffer." (when c-recognize-<>-arglists (c-after-change-check-<>-operators beg end)) + ;; (c-new-BEG c-new-END) will be the region to fontify. It may become + ;; larger than (beg end). + (setq c-new-BEG beg + c-new-END end) (if c-before-font-lock-function (save-excursion (funcall c-before-font-lock-function beg end old-len))))))) @@ -1100,8 +1089,7 @@ Note that the style variables are always made local to the buffer." This does not load the font-lock package. Use after `c-basic-common-init' and after cc-fonts has been loaded." - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults + (set (make-local-variable 'font-lock-defaults) `(,(if (c-major-mode-is 'awk-mode) ;; awk-mode currently has only one font lock level. 'awk-font-lock-keywords @@ -1206,7 +1194,7 @@ Key bindings: (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table c-mode-syntax-table) - (setq major-mode 'c-mode + (setq major-mode 'c-mode ; FIXME: Use define-derived-mode. mode-name "C" local-abbrev-table c-mode-abbrev-table abbrev-mode t) @@ -1269,7 +1257,7 @@ Key bindings: (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table c++-mode-syntax-table) - (setq major-mode 'c++-mode + (setq major-mode 'c++-mode ; FIXME: Use define-derived-mode. mode-name "C++" local-abbrev-table c++-mode-abbrev-table abbrev-mode t) @@ -1330,7 +1318,7 @@ Key bindings: (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table objc-mode-syntax-table) - (setq major-mode 'objc-mode + (setq major-mode 'objc-mode ; FIXME: Use define-derived-mode. mode-name "ObjC" local-abbrev-table objc-mode-abbrev-table abbrev-mode t) @@ -1400,7 +1388,7 @@ Key bindings: (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table java-mode-syntax-table) - (setq major-mode 'java-mode + (setq major-mode 'java-mode ; FIXME: Use define-derived-mode. mode-name "Java" local-abbrev-table java-mode-abbrev-table abbrev-mode t) @@ -1459,7 +1447,7 @@ Key bindings: (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table idl-mode-syntax-table) - (setq major-mode 'idl-mode + (setq major-mode 'idl-mode ; FIXME: Use define-derived-mode. mode-name "IDL" local-abbrev-table idl-mode-abbrev-table) (use-local-map idl-mode-map) @@ -1520,7 +1508,7 @@ Key bindings: (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table pike-mode-syntax-table) - (setq major-mode 'pike-mode + (setq major-mode 'pike-mode ; FIXME: Use define-derived-mode. mode-name "Pike" local-abbrev-table pike-mode-abbrev-table abbrev-mode t) @@ -1594,7 +1582,7 @@ Key bindings: (kill-all-local-variables) (c-initialize-cc-mode t) (set-syntax-table awk-mode-syntax-table) - (setq major-mode 'awk-mode + (setq major-mode 'awk-mode ; FIXME: Use define-derived-mode. mode-name "AWK" local-abbrev-table awk-mode-abbrev-table abbrev-mode t) @@ -1680,7 +1668,7 @@ Key bindings: adaptive-fill-regexp) nil))) (mapc (lambda (var) (unless (boundp var) - (setq vars (delq var vars)))) + (setq vars (delq var vars)))) '(signal-error-on-buffer-boundary filladapt-mode defun-prompt-regexp diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 15d44f6538a..26529411c43 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -540,13 +540,12 @@ variables." (when (boundp 'adaptive-fill-first-line-regexp) ;; XEmacs adaptive fill mode doesn't have this. - (make-local-variable 'adaptive-fill-first-line-regexp) - (setq adaptive-fill-first-line-regexp - (concat "\\`" comment-line-prefix - ;; Maybe we should incorporate the old value here, - ;; but then we have to do all sorts of kludges to - ;; deal with the \` and \' it probably contains. - "\\'")))) + (set (make-local-variable 'adaptive-fill-first-line-regexp) + (concat "\\`" comment-line-prefix + ;; Maybe we should incorporate the old value here, + ;; but then we have to do all sorts of kludges to + ;; deal with the \` and \' it probably contains. + "\\'")))) ;; Set up the values for use in strings. These are the default ;; paragraph-start/separate values, enhanced to accept escaped EOLs as diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index e074e92fbe5..07fdbed12d6 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -221,7 +221,6 @@ to the action header." ;; movement. (set (make-local-variable 'parens-require-spaces) nil) - (set (make-local-variable 'require-final-newline) mode-require-final-newline) (set (make-local-variable 'comment-start) "# ") (set (make-local-variable 'comment-start-skip) "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index a335f3dd427..da9b213ad8f 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -543,7 +543,7 @@ you may also want to change `compilation-page-delimiter'.") ;; Command output lines. Recognize `make[n]:' lines too. ("^\\([[:alnum:]_/.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:" (1 font-lock-function-name-face) (3 compilation-line-face nil t)) - (" --?o\\(?:utfile\\|utput\\)?[= ]?\\(\\S +\\)" . 1) + (" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\S +\\)" . 1) ("^Compilation \\(finished\\).*" (0 '(face nil message nil help-echo nil mouse-face nil) t) (1 compilation-info-face)) @@ -1606,7 +1606,7 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see). ;; Let windows scroll along with the output. (set (make-local-variable 'window-point-insertion-type) t) (set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map) - (setq major-mode 'compilation-mode + (setq major-mode 'compilation-mode ; FIXME: Use define-derived-mode. mode-name (or name-of-mode "Compilation")) (set (make-local-variable 'page-delimiter) compilation-page-delimiter) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 46002929791..6f8c1261510 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1,8 +1,8 @@ ;;; cperl-mode.el --- Perl code editing commands for Emacs -;; Copyright (C) 1985, 1986, 1987, 1991, 1992, 1993, 1994, 1995, 1996, 1997, -;; 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, -;; 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1991, 1992, 1993, 1994, 1995, 1996, +;; 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich ;; Bob Olson @@ -2145,7 +2145,7 @@ char is \"{\", insert extra newline before only if "Insert an opening parenthesis or a matching pair of parentheses. See `cperl-electric-parens'." (interactive "P") - (let ((beg (save-excursion (beginning-of-line) (point))) + (let ((beg (point-at-bol)) (other-end (if (and cperl-electric-parens-mark (cperl-mark-active) (> (mark) (point))) @@ -2182,7 +2182,7 @@ See `cperl-electric-parens'." If not, or if we are not at the end of marking range, would self-insert. Affected by `cperl-electric-parens'." (interactive "P") - (let ((beg (save-excursion (beginning-of-line) (point))) + (let ((beg (point-at-bol)) (other-end (if (and cperl-electric-parens-mark (cperl-val 'cperl-electric-parens) (memq last-command-event @@ -2215,7 +2215,7 @@ Affected by `cperl-electric-parens'." "Insert a construction appropriate after a keyword. Help message may be switched off by setting `cperl-message-electric-keyword' to nil." - (let ((beg (save-excursion (beginning-of-line) (point))) + (let ((beg (point-at-bol)) (dollar (and (eq last-command-event ?$) (eq this-command 'self-insert-command))) (delete (and (memq last-command-event '(?\s ?\n ?\t ?\f)) @@ -2358,7 +2358,7 @@ to nil." "Insert a construction appropriate after a keyword. Help message may be switched off by setting `cperl-message-electric-keyword' to nil." - (let ((beg (save-excursion (beginning-of-line) (point)))) + (let ((beg (point-at-bol))) (and (save-excursion (backward-sexp 1) (cperl-after-expr-p nil "{;:")) @@ -2397,8 +2397,8 @@ to nil." "Go to end of line, open a new line and indent appropriately. If in POD, insert appropriate lines." (interactive) - (let ((beg (save-excursion (beginning-of-line) (point))) - (end (save-excursion (end-of-line) (point))) + (let ((beg (point-at-bol)) + (end (point-at-eol)) (pos (point)) start over cut res) (if (and ; Check if we need to split: ; i.e., on a boundary and inside "{...}" @@ -2476,12 +2476,8 @@ If in POD, insert appropriate lines." (forward-paragraph -1) (forward-word 1) (setq pos (point)) - (setq cut (buffer-substring (point) - (save-excursion - (end-of-line) - (point)))) - (delete-char (- (save-excursion (end-of-line) (point)) - (point))) + (setq cut (buffer-substring (point) (point-at-eol))) + (delete-char (- (point-at-eol) (point))) (setq res (expand-abbrev)) (save-excursion (goto-char pos) @@ -2946,8 +2942,7 @@ Will not look before LIM." (point-max)))) ; do not loop if no syntaxification ;; label: (t - (save-excursion (end-of-line) - (setq colon-line-end (point))) + (setq colon-line-end (point-at-eol)) (search-forward ":")))) ;; We are at beginning of code (NOT label or comment) ;; First, the following code counts @@ -2989,8 +2984,7 @@ Will not look before LIM." (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 @@ -3220,7 +3214,7 @@ the current line is to be regarded as part of a block comment." Returns true if comment is found. In POD will not move the point." ;; If the line is inside other syntax groups (qq-style strings, HERE-docs) ;; then looks for literal # or end-of-line. - (let (state stop-in cpoint (lim (progn (end-of-line) (point))) pr e) + (let (state stop-in cpoint (lim (point-at-eol)) pr e) (or cperl-font-locking (cperl-update-syntaxification lim lim)) (beginning-of-line) @@ -3809,12 +3803,13 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', 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 #! (cperl-commentify min - (save-excursion (end-of-line) (point)) + (point-at-eol) nil)) (while (and (< (point) max) @@ -4053,10 +4048,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "") 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 "^[.;]$"))) @@ -5002,7 +4994,7 @@ If `cperl-indent-region-fix-constructs', will improve spacing on conditional/loop constructs." (interactive) (save-excursion - (let ((tmp-end (progn (end-of-line) (point))) top done) + (let ((tmp-end (point-at-eol)) top done) (save-excursion (beginning-of-line) (while (null done) @@ -5045,13 +5037,9 @@ conditional/loop constructs." "\\<\\(else\\|elsif\|continue\\)\\>")) (progn (goto-char (match-end 0)) - (save-excursion - (end-of-line) - (setq tmp-end (point)))) + (setq tmp-end (point-at-eol))) (setq done t)))) - (save-excursion - (end-of-line) - (setq tmp-end (point)))) + (setq tmp-end (point-at-eol))) (goto-char tmp-end) (setq tmp-end (point-marker))) (if cperl-indent-region-fix-constructs @@ -5064,7 +5052,7 @@ Returns some position at the last line." (interactive) (or end (setq end (point-max))) - (let ((ee (save-excursion (end-of-line) (point))) + (let ((ee (point-at-eol)) (cperl-indent-region-fix-constructs (or cperl-indent-region-fix-constructs 1)) p pp ml have-brace ret) @@ -5217,7 +5205,7 @@ Returns some position at the last line." (if (cperl-indent-line parse-data) (setq ret (cperl-fix-line-spacing end parse-data))))))))))) (beginning-of-line) - (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee. + (setq p (point) pp (point-at-eol)) ; May be different from ee. ;; Now check whether there is a hanging `}' ;; Looking at: ;; } blah @@ -7051,7 +7039,7 @@ Use as (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 @@ -7479,7 +7467,7 @@ Currently it is tuned to C and Perl syntax." ;; Get to the something meaningful (or (eobp) (eolp) (forward-char 1)) (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]" - (save-excursion (beginning-of-line) (point)) + (point-at-bol) 'to-beg) ;; (cond ;; ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol @@ -8999,5 +8987,4 @@ do extra unwind via `cperl-unwind-to-safe'." (provide 'cperl-mode) -;; arch-tag: 42e5b19b-e187-4537-929f-1a7408980ce6 ;;; cperl-mode.el ends here diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index 220ecf107ed..77a30521e9b 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -416,63 +416,59 @@ A prefix arg suppresses display of that buffer." ;;; Edit Buffer: -(defvar cpp-edit-map nil) -;; Keymap for `cpp-edit-mode'. - -(if cpp-edit-map - () - (setq cpp-edit-map (make-keymap)) - (suppress-keymap cpp-edit-map) - (define-key cpp-edit-map [ down-mouse-2 ] 'cpp-push-button) - (define-key cpp-edit-map [ mouse-2 ] 'ignore) - (define-key cpp-edit-map " " 'scroll-up) - (define-key cpp-edit-map "\C-?" 'scroll-down) - (define-key cpp-edit-map [ delete ] 'scroll-down) - (define-key cpp-edit-map "\C-c\C-c" 'cpp-edit-apply) - (define-key cpp-edit-map "a" 'cpp-edit-apply) - (define-key cpp-edit-map "A" 'cpp-edit-apply) - (define-key cpp-edit-map "r" 'cpp-edit-reset) - (define-key cpp-edit-map "R" 'cpp-edit-reset) - (define-key cpp-edit-map "s" 'cpp-edit-save) - (define-key cpp-edit-map "S" 'cpp-edit-save) - (define-key cpp-edit-map "l" 'cpp-edit-load) - (define-key cpp-edit-map "L" 'cpp-edit-load) - (define-key cpp-edit-map "h" 'cpp-edit-home) - (define-key cpp-edit-map "H" 'cpp-edit-home) - (define-key cpp-edit-map "b" 'cpp-edit-background) - (define-key cpp-edit-map "B" 'cpp-edit-background) - (define-key cpp-edit-map "k" 'cpp-edit-known) - (define-key cpp-edit-map "K" 'cpp-edit-known) - (define-key cpp-edit-map "u" 'cpp-edit-unknown) - (define-key cpp-edit-map "u" 'cpp-edit-unknown) - (define-key cpp-edit-map "t" 'cpp-edit-true) - (define-key cpp-edit-map "T" 'cpp-edit-true) - (define-key cpp-edit-map "f" 'cpp-edit-false) - (define-key cpp-edit-map "F" 'cpp-edit-false) - (define-key cpp-edit-map "w" 'cpp-edit-write) - (define-key cpp-edit-map "W" 'cpp-edit-write) - (define-key cpp-edit-map "X" 'cpp-edit-toggle-known) - (define-key cpp-edit-map "x" 'cpp-edit-toggle-known) - (define-key cpp-edit-map "Y" 'cpp-edit-toggle-unknown) - (define-key cpp-edit-map "y" 'cpp-edit-toggle-unknown) - (define-key cpp-edit-map "q" 'bury-buffer) - (define-key cpp-edit-map "Q" 'bury-buffer)) +(defvar cpp-edit-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [ down-mouse-2 ] 'cpp-push-button) + (define-key map [ mouse-2 ] 'ignore) + (define-key map " " 'scroll-up) + (define-key map "\C-?" 'scroll-down) + (define-key map [ delete ] 'scroll-down) + (define-key map "\C-c\C-c" 'cpp-edit-apply) + (define-key map "a" 'cpp-edit-apply) + (define-key map "A" 'cpp-edit-apply) + (define-key map "r" 'cpp-edit-reset) + (define-key map "R" 'cpp-edit-reset) + (define-key map "s" 'cpp-edit-save) + (define-key map "S" 'cpp-edit-save) + (define-key map "l" 'cpp-edit-load) + (define-key map "L" 'cpp-edit-load) + (define-key map "h" 'cpp-edit-home) + (define-key map "H" 'cpp-edit-home) + (define-key map "b" 'cpp-edit-background) + (define-key map "B" 'cpp-edit-background) + (define-key map "k" 'cpp-edit-known) + (define-key map "K" 'cpp-edit-known) + (define-key map "u" 'cpp-edit-unknown) + (define-key map "u" 'cpp-edit-unknown) + (define-key map "t" 'cpp-edit-true) + (define-key map "T" 'cpp-edit-true) + (define-key map "f" 'cpp-edit-false) + (define-key map "F" 'cpp-edit-false) + (define-key map "w" 'cpp-edit-write) + (define-key map "W" 'cpp-edit-write) + (define-key map "X" 'cpp-edit-toggle-known) + (define-key map "x" 'cpp-edit-toggle-known) + (define-key map "Y" 'cpp-edit-toggle-unknown) + (define-key map "y" 'cpp-edit-toggle-unknown) + (define-key map "q" 'bury-buffer) + (define-key map "Q" 'bury-buffer) + map) + "Keymap for `cpp-edit-mode'.") + + (defvar cpp-edit-symbols nil) ;; Symbols defined in the edit buffer. (make-variable-buffer-local 'cpp-edit-symbols) -(defun cpp-edit-mode () +(define-derived-mode cpp-edit-mode fundamental-mode "CPP Edit" "Major mode for editing the criteria for highlighting cpp conditionals. Click on objects to change them. You can also use the keyboard accelerators indicated like this: [K]ey." - (kill-all-local-variables) (buffer-disable-undo) (auto-save-mode -1) - (setq buffer-read-only t) - (setq major-mode 'cpp-edit-mode) - (setq mode-name "CPP Edit") - (use-local-map cpp-edit-map)) + (setq buffer-read-only t)) (defun cpp-edit-apply () "Apply edited display information to original buffer." @@ -568,7 +564,7 @@ You can also use the keyboard accelerators indicated like this: [K]ey." (load-file cpp-config-file)) ((file-readable-p (concat "~/" cpp-config-file)) (load-file cpp-config-file))) - (if (eq major-mode 'cpp-edit-mode) + (if (derived-mode-p 'cpp-edit-mode) (cpp-edit-reset))) (defun cpp-edit-save () diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index ead8b5db38f..9aea53705cd 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -1,7 +1,7 @@ ;;; dcl-mode.el --- major mode for editing DCL command files -;; 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: Odd Gripenstam <gripenstamol@decus.se> ;; Maintainer: Odd Gripenstam <gripenstamol@decus.se> @@ -296,72 +296,69 @@ See `imenu-generic-expression' for details." ) -(defvar dcl-mode-map () +(defvar dcl-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\e\n" 'dcl-split-line) + (define-key map "\e\t" 'tempo-complete-tag) + (define-key map "\e^" 'dcl-delete-indentation) + (define-key map "\em" 'dcl-back-to-indentation) + (define-key map "\ee" 'dcl-forward-command) + (define-key map "\ea" 'dcl-backward-command) + (define-key map "\e\C-q" 'dcl-indent-command) + (define-key map "\t" 'dcl-tab) + (define-key map ":" 'dcl-electric-character) + (define-key map "F" 'dcl-electric-character) + (define-key map "f" 'dcl-electric-character) + (define-key map "E" 'dcl-electric-character) + (define-key map "e" 'dcl-electric-character) + (define-key map "\C-c\C-o" 'dcl-set-option) + (define-key map "\C-c\C-f" 'tempo-forward-mark) + (define-key map "\C-c\C-b" 'tempo-backward-mark) + + (define-key map [menu-bar] (make-sparse-keymap)) + (define-key map [menu-bar dcl] + (cons "DCL" (make-sparse-keymap "DCL"))) + + ;; Define these in bottom-up order + (define-key map [menu-bar dcl tempo-backward-mark] + '("Previous template mark" . tempo-backward-mark)) + (define-key map [menu-bar dcl tempo-forward-mark] + '("Next template mark" . tempo-forward-mark)) + (define-key map [menu-bar dcl tempo-complete-tag] + '("Complete template tag" . tempo-complete-tag)) + (define-key map [menu-bar dcl dcl-separator-tempo] + '("--")) + (define-key map [menu-bar dcl dcl-save-all-options] + '("Save all options" . dcl-save-all-options)) + (define-key map [menu-bar dcl dcl-save-nondefault-options] + '("Save changed options" . dcl-save-nondefault-options)) + (define-key map [menu-bar dcl dcl-set-option] + '("Set option" . dcl-set-option)) + (define-key map [menu-bar dcl dcl-separator-option] + '("--")) + (define-key map [menu-bar dcl dcl-delete-indentation] + '("Delete indentation" . dcl-delete-indentation)) + (define-key map [menu-bar dcl dcl-split-line] + '("Split line" . dcl-split-line)) + (define-key map [menu-bar dcl dcl-indent-command] + '("Indent command" . dcl-indent-command)) + (define-key map [menu-bar dcl dcl-tab] + '("Indent line/insert tab" . dcl-tab)) + (define-key map [menu-bar dcl dcl-back-to-indentation] + '("Back to indentation" . dcl-back-to-indentation)) + (define-key map [menu-bar dcl dcl-forward-command] + '("End of statement" . dcl-forward-command)) + (define-key map [menu-bar dcl dcl-backward-command] + '("Beginning of statement" . dcl-backward-command)) + ;; imenu is only supported for versions with imenu-generic-expression + (if (boundp 'imenu-generic-expression) + (progn + (define-key map [menu-bar dcl dcl-separator-movement] + '("--")) + (define-key map [menu-bar dcl imenu] + '("Buffer index menu" . imenu)))) + map) "Keymap used in DCL-mode buffers.") -(if dcl-mode-map - () - (setq dcl-mode-map (make-sparse-keymap)) - (define-key dcl-mode-map "\e\n" 'dcl-split-line) - (define-key dcl-mode-map "\e\t" 'tempo-complete-tag) - (define-key dcl-mode-map "\e^" 'dcl-delete-indentation) - (define-key dcl-mode-map "\em" 'dcl-back-to-indentation) - (define-key dcl-mode-map "\ee" 'dcl-forward-command) - (define-key dcl-mode-map "\ea" 'dcl-backward-command) - (define-key dcl-mode-map "\e\C-q" 'dcl-indent-command) - (define-key dcl-mode-map "\t" 'dcl-tab) - (define-key dcl-mode-map ":" 'dcl-electric-character) - (define-key dcl-mode-map "F" 'dcl-electric-character) - (define-key dcl-mode-map "f" 'dcl-electric-character) - (define-key dcl-mode-map "E" 'dcl-electric-character) - (define-key dcl-mode-map "e" 'dcl-electric-character) - (define-key dcl-mode-map "\C-c\C-o" 'dcl-set-option) - (define-key dcl-mode-map "\C-c\C-f" 'tempo-forward-mark) - (define-key dcl-mode-map "\C-c\C-b" 'tempo-backward-mark) - - (define-key dcl-mode-map [menu-bar] (make-sparse-keymap)) - (define-key dcl-mode-map [menu-bar dcl] - (cons "DCL" (make-sparse-keymap "DCL"))) - - ;; Define these in bottom-up order - (define-key dcl-mode-map [menu-bar dcl tempo-backward-mark] - '("Previous template mark" . tempo-backward-mark)) - (define-key dcl-mode-map [menu-bar dcl tempo-forward-mark] - '("Next template mark" . tempo-forward-mark)) - (define-key dcl-mode-map [menu-bar dcl tempo-complete-tag] - '("Complete template tag" . tempo-complete-tag)) - (define-key dcl-mode-map [menu-bar dcl dcl-separator-tempo] - '("--")) - (define-key dcl-mode-map [menu-bar dcl dcl-save-all-options] - '("Save all options" . dcl-save-all-options)) - (define-key dcl-mode-map [menu-bar dcl dcl-save-nondefault-options] - '("Save changed options" . dcl-save-nondefault-options)) - (define-key dcl-mode-map [menu-bar dcl dcl-set-option] - '("Set option" . dcl-set-option)) - (define-key dcl-mode-map [menu-bar dcl dcl-separator-option] - '("--")) - (define-key dcl-mode-map [menu-bar dcl dcl-delete-indentation] - '("Delete indentation" . dcl-delete-indentation)) - (define-key dcl-mode-map [menu-bar dcl dcl-split-line] - '("Split line" . dcl-split-line)) - (define-key dcl-mode-map [menu-bar dcl dcl-indent-command] - '("Indent command" . dcl-indent-command)) - (define-key dcl-mode-map [menu-bar dcl dcl-tab] - '("Indent line/insert tab" . dcl-tab)) - (define-key dcl-mode-map [menu-bar dcl dcl-back-to-indentation] - '("Back to indentation" . dcl-back-to-indentation)) - (define-key dcl-mode-map [menu-bar dcl dcl-forward-command] - '("End of statement" . dcl-forward-command)) - (define-key dcl-mode-map [menu-bar dcl dcl-backward-command] - '("Beginning of statement" . dcl-backward-command)) - ;; imenu is only supported for versions with imenu-generic-expression - (if (boundp 'imenu-generic-expression) - (progn - (define-key dcl-mode-map [menu-bar dcl dcl-separator-movement] - '("--")) - (define-key dcl-mode-map [menu-bar dcl imenu] - '("Buffer index menu" . imenu)))) - ) - (defcustom dcl-ws-r "\\([ \t]*-[ \t]*\\(!.*\\)*\n\\)*[ \t]*" @@ -409,7 +406,7 @@ A list of regexps that will trigger a reindent if the last letter is defined as dcl-electric-character. E.g.: if this list contains `endif', the key `f' is defined as -dcl-electric-character and the you have just typed the `f' in +dcl-electric-character and you have just typed the `f' in `endif', the line will be reindented." :type '(repeat regexp) :group 'dcl) @@ -475,7 +472,7 @@ Preloaded with all known option names from dcl-option-alist") ;;;###autoload -(defun dcl-mode () +(define-derived-mode dcl-mode prog-mode "DCL" "Major mode for editing DCL-files. This mode indents command lines in blocks. (A block is commands between @@ -593,29 +590,17 @@ $ There is some minimal font-lock support (see vars `dcl-font-lock-defaults' and `dcl-font-lock-keywords')." - (interactive) - (kill-all-local-variables) - (set-syntax-table dcl-mode-syntax-table) - - (make-local-variable 'indent-line-function) - (setq indent-line-function 'dcl-indent-line) - - (make-local-variable 'comment-start) - (setq comment-start "!") - - (make-local-variable 'comment-end) - (setq comment-end "") - - (make-local-variable 'comment-multi-line) - (setq comment-multi-line nil) + (set (make-local-variable 'indent-line-function) 'dcl-indent-line) + (set (make-local-variable 'comment-start) "!") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-multi-line) nil) ;; This used to be "^\\$[ \t]*![ \t]*" which looks more correct. ;; The drawback was that you couldn't make empty comment lines by pressing ;; C-M-j repeatedly - only the first line became a comment line. ;; This version has the drawback that the "$" can be anywhere in the line, ;; and something inappropriate might be interpreted as a comment. - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "\\$[ \t]*![ \t]*") + (set (make-local-variable 'comment-start-skip) "\\$[ \t]*![ \t]*") (if (boundp 'imenu-generic-expression) (progn (setq imenu-generic-expression dcl-imenu-generic-expression) @@ -636,14 +621,9 @@ There is some minimal font-lock support (see vars (make-local-variable 'dcl-electric-reindent-regexps) ;; font lock - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults dcl-font-lock-defaults) + (set (make-local-variable 'font-lock-defaults) dcl-font-lock-defaults) - (setq major-mode 'dcl-mode) - (setq mode-name "DCL") - (use-local-map dcl-mode-map) - (tempo-use-tag-list 'dcl-tempo-tags) - (run-mode-hooks 'dcl-mode-hook)) + (tempo-use-tag-list 'dcl-tempo-tags)) ;;; *** Movement commands *************************************************** @@ -821,7 +801,7 @@ by the numbers in order 1-2-3-1-... : ;; text ;; 1 - (let* ((default-limit (save-excursion (end-of-line) (1+ (point)))) + (let* ((default-limit (1+ (line-end-position))) (limit (or limit default-limit)) (last-good-point (point)) (opoint (point))) @@ -1783,7 +1763,7 @@ Set or update the value of VAR in the current buffers (skip-chars-forward " \t") (or (eolp) (setq suffix-string (buffer-substring (point) - (progn (end-of-line) (point))))) + (line-end-position)))) (goto-char (match-beginning 0)) (or (bolp) (setq prefix-string @@ -2214,5 +2194,4 @@ otherwise return nil." (run-hooks 'dcl-mode-load-hook) ; for your customizations -;; arch-tag: e00d421b-f26c-483e-a8bd-af412ea7764a ;;; dcl-mode.el ends here diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index 2558456bc07..77d88e5a812 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -1779,7 +1779,7 @@ If no extension is specified, .pas is assumed. Creates a buffer for the unit." (if (null file) (error "unit not found: %s" unit-file) (find-file file) - (if (not (eq major-mode 'delphi-mode)) + (if (not (derived-mode-p 'delphi-mode)) (delphi-mode))) file)) @@ -2015,7 +2015,7 @@ no args, if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map delphi-mode-map) - (setq major-mode 'delphi-mode) + (setq major-mode 'delphi-mode) ;FIXME: Use define-derived-mode. (setq mode-name "Delphi") (setq local-abbrev-table delphi-mode-abbrev-table) @@ -2025,8 +2025,7 @@ no args, if that value is non-nil." (mapc #'(lambda (var) (let ((var-symb (car var)) (var-val (cadr var))) - (make-local-variable var-symb) - (set var-symb var-val))) + (set (make-local-variable var-symb) var-val))) (list '(indent-line-function delphi-indent-line) '(comment-indent-function delphi-indent-line) '(case-fold-search t) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 201a091cc26..a4d1fe85c30 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1,7 +1,7 @@ ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -;; 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: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> @@ -5279,7 +5279,7 @@ killed after process termination." (goto-char (point-min)) (and (search-forward "%%Creator: " nil t) (not (search-forward "& ebnf2ps v" - (save-excursion (end-of-line) (point)) + (line-end-position) t)) (progn ;; adjust creator comment @@ -6395,5 +6395,4 @@ killed after process termination." (provide 'ebnf2ps) -;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f ;;; ebnf2ps.el ends here diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index e32c453b91f..6b7c70208ea 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1,8 +1,8 @@ ;;; ebrowse.el --- Emacs C++ class browser & tags facility -;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation Inc. +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation Inc. ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Maintainer: FSF @@ -1116,7 +1116,7 @@ if for some reason a circle is in the inheritance graph." ;;; Tree-mode - mode for tree buffers ;;;###autoload -(defun ebrowse-tree-mode () +(define-derived-mode ebrowse-tree-mode special-mode "Ebrowse-Tree" "Major mode for Ebrowse class tree buffers. Each line corresponds to a class in a class tree. Letters do not insert themselves, they are commands. @@ -1125,12 +1125,10 @@ E.g.\\[save-buffer] writes the tree to the file it was loaded from. Tree mode key bindings: \\{ebrowse-tree-mode-map}" - (interactive) (let* ((ident (propertized-buffer-identification "C++ Tree")) - header tree buffer-read-only) + (inhibit-read-only t) + header tree) - (kill-all-local-variables) - (use-local-map ebrowse-tree-mode-map) (buffer-disable-undo) (unless (zerop (buffer-size)) @@ -1141,38 +1139,27 @@ Tree mode key bindings: (erase-buffer) (message nil)) - (mapc 'make-local-variable - '(ebrowse--tags-file-name - ebrowse--indentation - ebrowse--tree - ebrowse--header - ebrowse--show-file-names-flag - ebrowse--frozen-flag - ebrowse--tree-obarray - revert-buffer-function)) - - (setf ebrowse--show-file-names-flag nil - ebrowse--tree-obarray (make-vector 127 0) - ebrowse--frozen-flag nil - major-mode 'ebrowse-tree-mode - mode-name "Ebrowse-Tree" - mode-line-buffer-identification ident - buffer-read-only t - selective-display t - selective-display-ellipses t - revert-buffer-function 'ebrowse-revert-tree-buffer-from-file - ebrowse--header header - ebrowse--tree tree - ebrowse--tags-file-name (buffer-file-name) - ebrowse--tree-obarray (and tree (ebrowse-build-tree-obarray tree)) - ebrowse--frozen-flag nil) - - (add-hook 'local-write-file-hooks 'ebrowse-write-file-hook-fn) + (set (make-local-variable 'ebrowse--show-file-names-flag) nil) + (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0)) + (set (make-local-variable 'ebrowse--frozen-flag) nil) + (setq mode-line-buffer-identification ident) + (setq buffer-read-only t) + (setq selective-display t) + (setq selective-display-ellipses t) + (set (make-local-variable 'revert-buffer-function) + #'ebrowse-revert-tree-buffer-from-file) + (set (make-local-variable 'ebrowse--header) header) + (set (make-local-variable 'ebrowse--tree) tree) + (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name) + (set (make-local-variable 'ebrowse--tree-obarray) + (and tree (ebrowse-build-tree-obarray tree))) + (set (make-local-variable 'ebrowse--frozen-flag) nil) + + (add-hook 'local-write-file-hooks 'ebrowse-write-file-hook-fn nil t) (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) (when tree (ebrowse-redraw-tree) - (set-buffer-modified-p nil)) - (run-mode-hooks 'ebrowse-tree-mode-hook))) + (set-buffer-modified-p nil)))) @@ -1313,7 +1300,7 @@ With PREFIX, insert that many filenames." (skip-chars-forward " \t*a-zA-Z0-9_") (setq start (point) file-name-existing (looking-at "(")) - (delete-region start (save-excursion (end-of-line) (point))) + (delete-region start (line-end-position)) (unless file-name-existing (indent-to ebrowse-source-file-column) (insert "(" (or (ebrowse-cs-file @@ -1340,6 +1327,7 @@ With PREFIX, insert that many filenames." (defun ebrowse-member-buffer-p (buffer) "Value is non-nil if BUFFER is a member buffer." + ;; FIXME: Why not (buffer-local-value 'major-mode buffer)? (eq (cdr (assoc 'major-mode (buffer-local-variables buffer))) 'ebrowse-member-mode)) @@ -1459,12 +1447,13 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise." (defun ebrowse-set-tree-indentation () "Set the indentation width of the tree display." (interactive) - (let ((width (string-to-number (read-from-minibuffer - (concat "Indentation (" + (let ((width (string-to-number (read-string + (concat "Indentation (default " (int-to-string ebrowse--indentation) - "): "))))) + "): ") + nil nil ebrowse--indentation)))) (when (plusp width) - (setf ebrowse--indentation width) + (set (make-local-variable 'ebrowse--indentation) width) (ebrowse-redraw-tree)))) @@ -1632,13 +1621,12 @@ The new frame is deleted when you quit viewing the file in that frame." (had-a-buf (get-file-buffer file)) (buf-to-view (find-file-noselect file))) (switch-to-buffer-other-frame buf-to-view) - (make-local-variable 'ebrowse--frame-configuration) - (setq ebrowse--frame-configuration old-frame-configuration) - (make-local-variable 'ebrowse--view-exit-action) - (setq ebrowse--view-exit-action - (and (not had-a-buf) - (not (buffer-modified-p buf-to-view)) - 'kill-buffer)) + (set (make-local-variable 'ebrowse--frame-configuration) + old-frame-configuration) + (set (make-local-variable 'ebrowse--view-exit-action) + (and (not had-a-buf) + (not (buffer-modified-p buf-to-view)) + 'kill-buffer)) (view-mode-enter (cons (selected-window) (cons (selected-window) t)) 'ebrowse-view-exit-fn))) @@ -2006,21 +1994,16 @@ COLLAPSE non-nil means collapse the branch." (put 'ebrowse-electric-list-undefined 'suppress-keymap t) -(defun ebrowse-electric-list-mode () +(define-derived-mode ebrowse-electric-list-mode + fundamental-mode "Electric Position Menu" "Mode for electric tree list mode." - (kill-all-local-variables) - (use-local-map ebrowse-electric-list-mode-map) - (setq mode-name "Electric Position Menu" - mode-line-buffer-identification "Electric Tree Menu") + (setq mode-line-buffer-identification "Electric Tree Menu") (when (memq 'mode-name mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) - (make-local-variable 'Helper-return-blurb) - (setq Helper-return-blurb "return to buffer editing" - truncate-lines t - buffer-read-only t - major-mode 'ebrowse-electric-list-mode) - (run-mode-hooks 'ebrowse-electric-list-mode-hook)) + (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") + (setq truncate-lines t + buffer-read-only t)) (defun ebrowse-list-tree-buffers () @@ -2226,13 +2209,8 @@ See 'Electric-command-loop' for a description of STATE and CONDITION." ;;; Member mode ;;;###autoload -(defun ebrowse-member-mode () - "Major mode for Ebrowse member buffers. - -\\{ebrowse-member-mode-map}" - (kill-all-local-variables) - (use-local-map ebrowse-member-mode-map) - (setq major-mode 'ebrowse-member-mode) +(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members" + "Major mode for Ebrowse member buffers." (mapc 'make-local-variable '(ebrowse--decl-column ;display column ebrowse--n-columns ;number of short columns @@ -2255,8 +2233,7 @@ See 'Electric-command-loop' for a description of STATE and CONDITION." ebrowse--const-display-flag ebrowse--pure-display-flag ebrowse--frozen-flag)) ;buffer not automagically reused - (setq mode-name "Ebrowse-Members" - mode-line-buffer-identification + (setq mode-line-buffer-identification (propertized-buffer-identification "C++ Members") buffer-read-only t ebrowse--long-display-flag nil @@ -2270,8 +2247,7 @@ See 'Electric-command-loop' for a description of STATE and CONDITION." ebrowse--inline-display-flag nil ebrowse--const-display-flag nil ebrowse--pure-display-flag nil) - (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) - (run-mode-hooks 'ebrowse-member-mode-hook)) + (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))) @@ -3967,22 +3943,17 @@ Prefix arg ARG says how much." (put 'ebrowse-electric-position-undefined 'suppress-keymap t) -(defun ebrowse-electric-position-mode () +(define-derived-mode ebrowse-electric-position-mode + fundamental-mode "Electric Position Menu" "Mode for electric position buffers. Runs the hook `ebrowse-electric-position-mode-hook'." - (kill-all-local-variables) - (use-local-map ebrowse-electric-position-mode-map) - (setq mode-name "Electric Position Menu" - mode-line-buffer-identification "Electric Position Menu") + (setq mode-line-buffer-identification "Electric Position Menu") (when (memq 'mode-name mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (setcar (memq 'mode-name mode-line-format) "Positions")) - (make-local-variable 'Helper-return-blurb) - (setq Helper-return-blurb "return to buffer editing" - truncate-lines t - buffer-read-only t - major-mode 'ebrowse-electric-position-mode) - (run-mode-hooks 'ebrowse-electric-position-mode-hook)) + (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") + (setq truncate-lines t + buffer-read-only t)) (defun ebrowse-draw-position-buffer () @@ -4491,5 +4462,4 @@ EVENT is the mouse event." ;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) ;; End: -;; arch-tag: 4fa3c8bf-1771-479b-bcd7-b029c7c9677b ;;; ebrowse.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 042cc8c33f6..885ad0796ba 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1,8 +1,8 @@ ;;; etags.el --- etags facility for Emacs -;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, +;; 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Roland McGrath <roland@gnu.org> ;; Maintainer: FSF @@ -280,7 +280,7 @@ buffer-local and set them to nil." (defun tags-table-mode () "Major mode for tags table file buffers." (interactive) - (setq major-mode 'tags-table-mode + (setq major-mode 'tags-table-mode ;FIXME: Use define-derived-mode. mode-name "Tags Table" buffer-undo-list t) (initialize-new-tags-table)) @@ -1133,9 +1133,7 @@ error message." ;; 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 @@ buffer-local values of tags table format variables." ;; 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))))) @@ -1681,7 +1677,7 @@ Point should be just after a string that matches TAG." (save-excursion (beginning-of-line) (let ((bol (point))) - (and (search-forward "\177" (save-excursion (end-of-line) (point)) t) + (and (search-forward "\177" (line-end-position) t) (re-search-backward re bol t))))) (defcustom tags-loop-revert-buffers nil @@ -2034,10 +2030,8 @@ see the doc of that variable if you want to add names to the list." (define-key map "q" 'select-tags-table-quit) map)) -(define-derived-mode select-tags-table-mode fundamental-mode "Select Tags Table" - "Major mode for choosing a current tags table among those already loaded. - -\\{select-tags-table-mode-map}" +(define-derived-mode select-tags-table-mode special-mode "Select Tags Table" + "Major mode for choosing a current tags table among those already loaded." (setq buffer-read-only t)) (defun select-tags-table-select (button) @@ -2086,5 +2080,4 @@ for \\[find-tag] (which see)." (provide 'etags) -;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e ;;; etags.el ends here diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 64c716208e9..906ed4588c2 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -657,6 +657,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (define-key map "\C-c\C-f" 'f90-fill-region) (define-key map "\C-c\C-p" 'f90-previous-statement) (define-key map "\C-c\C-n" 'f90-next-statement) + (define-key map "\C-c]" 'f90-insert-end) (define-key map "\C-c\C-w" 'f90-insert-end) ;; Standard tab binding will call this, and also handle regions. ;;; (define-key map "\t" 'f90-indent-line) @@ -1066,11 +1067,9 @@ Variables controlling indentation style and extra features: Turning on F90 mode calls the value of the variable `f90-mode-hook' with no args, if that value is non-nil." :group 'f90 - :syntax-table f90-mode-syntax-table :abbrev-table f90-mode-abbrev-table (set (make-local-variable 'indent-line-function) 'f90-indent-line) (set (make-local-variable 'indent-region-function) 'f90-indent-region) - (set (make-local-variable 'require-final-newline) mode-require-final-newline) (set (make-local-variable 'comment-start) "!") (set (make-local-variable 'comment-start-skip) "!+ *") (set (make-local-variable 'comment-indent-function) 'f90-comment-indent) @@ -2206,7 +2205,7 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word." With optional argument ALL, change the default for all present and future F90 buffers. F90 mode normally treats backslash as an escape character." - (or (eq major-mode 'f90-mode) + (or (derived-mode-p 'f90-mode) (error "This function should only be used in F90 buffers")) (when (equal (char-syntax ?\\ ) ?\\ ) (or all (set-syntax-table (copy-syntax-table (syntax-table)))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 712af6fd288..a90f380d1c3 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -106,16 +106,6 @@ Zero-length substrings at the beginning and end of the list are omitted." 'temp-directory (lambda () temporary-file-directory))) -(defalias 'flymake-line-beginning-position - (if (fboundp 'line-beginning-position) - 'line-beginning-position - (lambda (&optional arg) (save-excursion (beginning-of-line arg) (point))))) - -(defalias 'flymake-line-end-position - (if (fboundp 'line-end-position) - 'line-end-position - (lambda (&optional arg) (save-excursion (end-of-line arg) (point))))) - (defun flymake-posn-at-point-as-event (&optional position window dx dy) "Return pixel position of top left corner of glyph at POSITION, relative to top left corner of WINDOW, as a mouse-1 click @@ -423,9 +413,11 @@ to the beginning of the list (File.h -> File.cpp moved to top)." (not (equal file-one file-two)))) (defcustom flymake-check-file-limit 8192 - "Max number of chars to look at when checking possible master file." + "Maximum number of chars to look at when checking possible master file. +Nil means search the entire file." :group 'flymake - :type 'integer) + :type '(choice (const :tag "No limit" nil) + (integer :tag "Characters"))) (defun flymake-check-patch-master-file-buffer (master-file-temp-buffer @@ -441,16 +433,26 @@ For example, foo.cpp is a master file if it includes foo.h. Whether a buffer for MATER-FILE-NAME exists, use it as a source instead of reading master file from disk." (let* ((source-file-nondir (file-name-nondirectory source-file-name)) + (source-file-extension (file-name-extension source-file-nondir)) + (source-file-nonext (file-name-sans-extension source-file-nondir)) (found nil) (inc-name nil) (search-limit flymake-check-file-limit)) (setq regexp (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" - (regexp-quote source-file-nondir))) + ;; Hack for tex files, where \include often excludes .tex. + ;; Maybe this is safe generally. + (if (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex")) + (format "%s\\(?:\\.%s\\)?" + (regexp-quote source-file-nonext) + (regexp-quote source-file-extension)) + (regexp-quote source-file-nondir)))) (unwind-protect (with-current-buffer master-file-temp-buffer - (when (> search-limit (point-max)) - (setq search-limit (point-max))) + (if (or (not search-limit) + (> search-limit (point-max))) + (setq search-limit (point-max))) (flymake-log 3 "checking %s against regexp %s" master-file-name regexp) (goto-char (point-min)) @@ -461,6 +463,11 @@ instead of reading master file from disk." (flymake-log 3 "found possible match for %s" source-file-nondir) (setq inc-name (match-string 1)) + (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex") + (not (string-match (format "\\.%s\\'" source-file-extension) + inc-name)) + (setq inc-name (concat inc-name "." source-file-extension))) (when (eq t (compare-strings source-file-nondir nil nil inc-name (- (length inc-name) @@ -808,8 +815,8 @@ Return t if it has at least one flymake overlay, nil if no overlay." Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." (goto-char (point-min)) (forward-line (1- line-no)) - (let* ((line-beg (flymake-line-beginning-position)) - (line-end (flymake-line-end-position)) + (let* ((line-beg (point-at-bol)) + (line-end (point-at-eol)) (beg line-beg) (end line-end) (tooltip-text (flymake-ler-text (nth 0 line-err-info-list))) @@ -1747,11 +1754,14 @@ Use CREATE-TEMP-F for creating temp copy." (defun flymake-simple-tex-init () (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace))) +;; Perhaps there should be a buffer-local variable flymake-master-file +;; that people can set to override this stuff. Could inherit from +;; the similar AUCTeX variable. (defun flymake-master-tex-init () (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace '("\\.tex\\'") - "[ \t]*\\input[ \t]*{\\(.*%s\\)}"))) + "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) (when temp-master-file-name (flymake-get-tex-args temp-master-file-name)))) @@ -1764,5 +1774,4 @@ Use CREATE-TEMP-F for creating temp copy." (provide 'flymake) -;; arch-tag: 8f0d6090-061d-4cac-8862-7c151c4a02dd ;;; flymake.el ends here diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 91cfb646b66..c8bbbf48343 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1315,8 +1315,7 @@ Directive lines are treated as comments." (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 @@ arg DO-SPACE prevents stripping the whitespace." (provide 'fortran) -;; arch-tag: 74935096-21c4-4cab-8ee5-6ef16090dc04 ;;; fortran.el ends here diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 3019f8bbf04..f3f7e617376 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -647,7 +647,22 @@ detailed description of this mode. (gud-common-init command-line nil 'gud-gdbmi-marker-filter) (set (make-local-variable 'gud-minor-mode) 'gdbmi) (setq comint-input-sender 'gdb-send) - + (when (ring-empty-p comint-input-ring) ; cf shell-mode + (let (hfile) + (when (catch 'done + (dolist (file '(".gdbinit" "~/.gdbinit")) + (if (file-readable-p (setq file (expand-file-name file))) + (with-temp-buffer + (insert-file-contents file) + (and (re-search-forward + "^ *set history filename *\\(.*\\)" nil t) + (file-readable-p + (setq hfile (expand-file-name + (match-string 1) + (file-name-directory file)))) + (throw 'done t)))))) + (set (make-local-variable 'comint-input-ring-file-name) hfile) + (comint-read-input-ring t)))) (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set temporary breakpoint at current line.") (gud-def gud-jump @@ -1001,7 +1016,7 @@ With arg, enter name of variable to be watched in the minibuffer." 'gud-gdb-complete-command) (if (and transient-mark-mode mark-active) (buffer-substring (region-beginning) (region-end)) - (concat (if (eq major-mode 'gdb-registers-mode) "$") + (concat (if (derived-mode-p 'gdb-registers-mode) "$") (tooltip-identifier-from-point (point))))))) (set-text-properties 0 (length expr) nil expr) (gdb-input @@ -1468,14 +1483,9 @@ DOC is an optional documentation string." ;; We want to use comint because it has various nifty and familiar features. (define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O" - "Major mode for gdb inferior-io. - -The following commands are available: -\\{gdb-inferior-io-mode-map}" - + "Major mode for gdb inferior-io." :syntax-table nil :abbrev-table nil - -(make-comint-in-buffer "gdb-inferior" (current-buffer) nil)) + (make-comint-in-buffer "gdb-inferior" (current-buffer) nil)) (defun gdb-inferior-filter (proc string) (unless (string-equal string "") @@ -2428,7 +2438,7 @@ If not in a source or disassembly buffer just set point." (mouse-minibuffer-check event) (let ((posn (event-end event))) (with-selected-window (posn-window posn) - (if (or (buffer-file-name) (eq major-mode 'gdb-disassembly-mode)) + (if (or (buffer-file-name) (derived-mode-p 'gdb-disassembly-mode)) (if (numberp (posn-point posn)) (save-excursion (goto-char (posn-point posn)) @@ -2612,15 +2622,12 @@ corresponding to the mode line clicked." nil nil mode-line))) (define-derived-mode gdb-threads-mode gdb-parent-mode "Threads" - "Major mode for GDB threads. - -\\{gdb-threads-mode-map}" + "Major mode for GDB threads." (setq gdb-thread-position (make-marker)) (add-to-list 'overlay-arrow-variable-list 'gdb-thread-position) (setq header-line-format gdb-threads-header) (set (make-local-variable 'font-lock-defaults) '(gdb-threads-font-lock-keywords)) - (run-mode-hooks 'gdb-threads-mode-hook) 'gdb-invalidate-threads) (defun gdb-thread-list-handler-custom () @@ -3146,13 +3153,10 @@ DOC is an optional documentation string." "Header line used in `gdb-memory-mode'.") (define-derived-mode gdb-memory-mode gdb-parent-mode "Memory" - "Major mode for examining memory. - -\\{gdb-memory-mode-map}" + "Major mode for examining memory." (setq header-line-format gdb-memory-header) (set (make-local-variable 'font-lock-defaults) '(gdb-memory-font-lock-keywords)) - (run-mode-hooks 'gdb-memory-mode-hook) 'gdb-invalidate-memory) (defun gdb-memory-buffer-name () @@ -3241,16 +3245,13 @@ DOC is an optional documentation string." map)) (define-derived-mode gdb-disassembly-mode gdb-parent-mode "Disassembly" - "Major mode for GDB disassembly information. - -\\{gdb-disassembly-mode-map}" + "Major mode for GDB disassembly information." ;; TODO Rename overlay variable for disassembly mode (add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position) (setq fringes-outside-margins t) (set (make-local-variable 'gdb-disassembly-position) (make-marker)) (set (make-local-variable 'font-lock-defaults) '(gdb-disassembly-font-lock-keywords)) - (run-mode-hooks 'gdb-disassembly-mode-hook) 'gdb-invalidate-disassembly) (defun gdb-disassembly-handler-custom () @@ -3308,11 +3309,8 @@ DOC is an optional documentation string." ;;; Breakpoints view (define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints" - "Major mode for gdb breakpoints. - -\\{gdb-breakpoints-mode-map}" + "Major mode for gdb breakpoints." (setq header-line-format gdb-breakpoints-header) - (run-mode-hooks 'gdb-breakpoints-mode-hook) 'gdb-invalidate-breakpoints) (defun gdb-toggle-breakpoint () @@ -3451,15 +3449,12 @@ member." "Font lock keywords used in `gdb-frames-mode'.") (define-derived-mode gdb-frames-mode gdb-parent-mode "Frames" - "Major mode for gdb call stack. - -\\{gdb-frames-mode-map}" + "Major mode for gdb call stack." (setq gdb-stack-position (make-marker)) (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) (setq truncate-lines t) ;; Make it easier to see overlay arrow. (set (make-local-variable 'font-lock-defaults) '(gdb-frames-font-lock-keywords)) - (run-mode-hooks 'gdb-frames-mode-hook) 'gdb-invalidate-frames) (defun gdb-select-frame (&optional event) @@ -3573,11 +3568,8 @@ member." map)) (define-derived-mode gdb-locals-mode gdb-parent-mode "Locals" - "Major mode for gdb locals. - -\\{gdb-locals-mode-map}" + "Major mode for gdb locals." (setq header-line-format gdb-locals-header) - (run-mode-hooks 'gdb-locals-mode-hook) 'gdb-invalidate-locals) (defun gdb-locals-buffer-name () @@ -3672,11 +3664,8 @@ member." nil nil mode-line))) (define-derived-mode gdb-registers-mode gdb-parent-mode "Registers" - "Major mode for gdb registers. - -\\{gdb-registers-mode-map}" + "Major mode for gdb registers." (setq header-line-format gdb-registers-header) - (run-mode-hooks 'gdb-registers-mode-hook) 'gdb-invalidate-registers) (defun gdb-registers-buffer-name () @@ -4191,5 +4180,4 @@ BUFFER nil or omitted means use the current buffer." (provide 'gdb-mi) -;; arch-tag: 1b41ea2b-f364-4cec-8f35-e02e4fe01912 ;;; gdb-mi.el ends here diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 3f5fa543813..06ab8c389d4 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -348,7 +348,11 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies ;; produces them ;; ("^\\(.+?\\)\\(:[ \t]*\\)\\([0-9]+\\)\\2\\(?:\\([0-9]+\\)\\(?:-\\([0-9]+\\)\\)?\\2\\)?" ;; 1 3 (4 . 5)) - ("^\\(\\(.+?\\):\\([0-9]+\\):\\).*?\ + ;; Note that we want to use as tight a regexp as we can to try and + ;; handle weird file names (with colons in them) as well as possible. + ;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:" in + ;; file names. + ("^\\(\\(.+?\\):\\([1-9][0-9]*\\):\\).*?\ \\(\033\\[01;31m\\(?:\033\\[K\\)?\\)\\(.*?\\)\\(\033\\[[0-9]*m\\)" 2 3 ;; Calculate column positions (beg . end) of first grep match on a line @@ -357,7 +361,7 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (- (match-beginning 4) (match-end 1))) . (lambda () (- (match-end 5) (match-end 1) - (- (match-end 4) (match-beginning 4))))) + (- (match-end 4) (match-beginning 4))))) nil 1) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 8c35a13ac53..ef35b118be8 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2533,7 +2533,7 @@ comint mode, which see." (gud-set-buffer)) (defun gud-set-buffer () - (when (eq major-mode 'gud-mode) + (when (derived-mode-p 'gud-mode) (setq gud-comint-buffer (current-buffer)))) (defvar gud-filter-defer-flag nil @@ -3344,10 +3344,8 @@ only tooltips in the buffer containing the overlay arrow." ACTIVATEP non-nil means activate mouse motion events." (if activatep (progn - (make-local-variable 'gud-tooltip-mouse-motions-active) - (setq gud-tooltip-mouse-motions-active t) - (make-local-variable 'track-mouse) - (setq track-mouse t)) + (set (make-local-variable 'gud-tooltip-mouse-motions-active) t) + (set (make-local-variable 'track-mouse) t)) (when gud-tooltip-mouse-motions-active (kill-local-variable 'gud-tooltip-mouse-motions-active) (kill-local-variable 'track-mouse)))) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 04ec915f3d3..b21cd9c89ef 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -760,7 +760,7 @@ Point is left unchanged." (cond ((hif-looking-at-else) (setq else (point))) (t - (setq end (point)))) ; (save-excursion (end-of-line) (point)) + (setq end (point)))) ; (line-end-position) ;; If found #else, look for #endif. (when else (while (progn @@ -769,7 +769,7 @@ Point is left unchanged." (hif-ifdef-to-endif)) (if (hif-looking-at-else) (error "Found two elses in a row? Broken!")) - (setq end (point))) ; (save-excursion (end-of-line) (point)) + (setq end (point))) ; (line-end-position) (hif-make-range start end else)))) @@ -1025,5 +1025,4 @@ Return as (TOP . BOTTOM) the extent of ifdef block." (provide 'hideif) -;; arch-tag: c6381d17-a59a-483a-b945-658f22277981 ;;; hideif.el ends here diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 9182b319b57..b1c8dc2b336 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -1,7 +1,7 @@ ;;; icon.el --- mode for editing Icon code -;; Copyright (C) 1989, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1989, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Chris Smith <csmith@convex.com> ;; Created: 15 Feb 89 @@ -131,7 +131,7 @@ when the TAB command is used." ;;;###autoload -(defun icon-mode () +(define-derived-mode icon-mode prog-mode "Icon" "Major mode for editing Icon code. Expression and list commands understand all Icon brackets. Tab indents for Icon code. @@ -163,49 +163,33 @@ Variables controlling indentation style: Turning on Icon mode calls the value of the variable `icon-mode-hook' with no args, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map icon-mode-map) - (setq major-mode 'icon-mode) - (setq mode-name "Icon") - (setq local-abbrev-table icon-mode-abbrev-table) - (set-syntax-table icon-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 'indent-line-function) - (setq indent-line-function 'icon-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-start-skip) - (setq comment-start-skip "# *") - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'icon-comment-indent) + :abbrev-table icon-mode-abbrev-table + (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'indent-line-function) #'icon-indent-line) + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-start-skip) "# *") + (set (make-local-variable 'comment-indent-function) 'icon-comment-indent) (set (make-local-variable 'indent-line-function) 'icon-indent-line) ;; font-lock support - (setq font-lock-defaults - '((icon-font-lock-keywords - icon-font-lock-keywords-1 icon-font-lock-keywords-2) - nil nil ((?_ . "w")) beginning-of-defun - ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP. - ;(font-lock-comment-start-regexp . "#") - (font-lock-mark-block-function . mark-defun))) + (set (make-local-variable 'font-lock-defaults) + '((icon-font-lock-keywords + icon-font-lock-keywords-1 icon-font-lock-keywords-2) + nil nil ((?_ . "w")) beginning-of-defun + ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP. + ;;(font-lock-comment-start-regexp . "#") + (font-lock-mark-block-function . mark-defun))) ;; imenu support - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression icon-imenu-generic-expression) + (set (make-local-variable 'imenu-generic-expression) + icon-imenu-generic-expression) ;; hideshow support ;; we start from the assertion that `hs-special-modes-alist' is autoloaded. (unless (assq 'icon-mode hs-special-modes-alist) (setq hs-special-modes-alist (cons '(icon-mode "\\<procedure\\>" "\\<end\\>" nil icon-forward-sexp-function) - hs-special-modes-alist))) - (run-mode-hooks 'icon-mode-hook)) + hs-special-modes-alist)))) ;; This is used by indent-for-comment to decide how much to ;; indent a comment in Icon code based on its context. @@ -601,7 +585,7 @@ Returns nil if line starts inside a string, t if in a comment." (indent-to this-indent))) ;; Indent any comment following the text. (or (looking-at comment-start-skip) - (if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) + (if (re-search-forward comment-start-skip (line-end-position) t) (progn (indent-for-comment) (beginning-of-line)))))))))) (defconst icon-font-lock-keywords-1 @@ -687,5 +671,4 @@ Returns nil if line starts inside a string, t if in a comment." (provide 'icon) -;; arch-tag: 8abf8c99-e7df-44af-a58f-ef5ed2ee52cb ;;; icon.el ends here diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index 95acc427736..a2457eead0f 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -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> @@ -167,7 +167,7 @@ an up-to-date completion list." (defun idlwave-prepare-structure-tag-completion (var) "Find and parse the tag list for structure tag completion." ;; This works differently in source buffers and in the shell - (if (eq major-mode 'idlwave-shell-mode) + (if (derived-mode-p 'idlwave-shell-mode) ;; OK, we are in the shell, do it dynamically (progn (message "preparing shell tags") @@ -225,9 +225,8 @@ an up-to-date completion list." ;; 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 @@ an up-to-date completion list." (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 diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 850d68e918f..0674ccf730a 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -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> @@ -288,7 +288,7 @@ support." (declare-function idlwave-what-module-find-class "idlwave") (declare-function idlwave-where "idlwave") -(defun idlwave-help-mode () +(define-derived-mode idlwave-help-mode special-mode "IDLWAVE Help" "Major mode for displaying IDL Help. This is a VIEW mode for the ASCII version of IDL Help files, @@ -308,11 +308,7 @@ Jump: [h] to function doclib header Here are all keybindings. \\{idlwave-help-mode-map}" - (kill-all-local-variables) (buffer-disable-undo) - (setq major-mode 'idlwave-help-mode - mode-name "IDLWAVE Help") - (use-local-map idlwave-help-mode-map) (easy-menu-add idlwave-help-menu idlwave-help-mode-map) (setq truncate-lines t) (setq case-fold-search t) @@ -325,8 +321,7 @@ Here are all keybindings. (setq buffer-read-only t) (set (make-local-variable 'idlwave-help-def-pos) nil) (set (make-local-variable 'idlwave-help-args) nil) - (set (make-local-variable 'idlwave-help-in-header) nil) - (run-hooks 'idlwave-help-mode-hook)) + (set (make-local-variable 'idlwave-help-in-header) nil)) (defun idlwave-html-help-location () "Return the help directory where HTML files are, or nil if that is unknown." @@ -576,13 +571,13 @@ Needs additional info stored in global `idlwave-completion-help-info'." (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 +585,18 @@ Needs additional info stored in global `idlwave-completion-help-info'." (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 +606,19 @@ Needs additional info stored in global `idlwave-completion-help-info'." ;; 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 +627,12 @@ Needs additional info stored in global `idlwave-completion-help-info'." ;; 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 +645,11 @@ Needs additional info stored in global `idlwave-completion-help-info'." (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 +1381,4 @@ IDL assistant.") (provide 'idlw-help) (provide 'idlwave-help) -;; arch-tag: d27b5505-59de-497f-ba3f-f199fd4fb911 ;;; idlw-help.el ends here diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 3acd396e9cd..0cad8cce517 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -866,7 +866,7 @@ IDL has currently stepped.") (defvar idlwave-shell-only-prompt-pattern nil) (defvar tool-bar-map) -(defun idlwave-shell-mode () +(define-derived-mode idlwave-shell-mode comint-mode "IDL-Shell" "Major mode for interacting with an inferior IDL process. 1. Shell Interaction @@ -947,28 +947,23 @@ IDL has currently stepped.") 8. Keybindings ----------- \\{idlwave-shell-mode-map}" - - (interactive) + :abbrev-table idlwave-mode-abbrev-table (idlwave-setup) ; Make sure config files and paths, etc. are available. (unless (file-name-absolute-p idlwave-shell-command-history-file) (setq idlwave-shell-command-history-file (expand-file-name idlwave-shell-command-history-file idlwave-config-directory))) - ;; We don't do `kill-all-local-variables' here, because this is done by - ;; comint (setq comint-prompt-regexp idlwave-shell-prompt-pattern) (setq comint-process-echoes t) ;; Can not use history expansion because "!" is used for system variables. (setq comint-input-autoexpand nil) -; (setq comint-input-ring-size 64) - (make-local-variable 'comint-completion-addsuffix) + ;; (setq comint-input-ring-size 64) + (set (make-local-variable 'completion-ignore-case) t) - (setq comint-completion-addsuffix '("/" . "")) + (set (make-local-variable 'comint-completion-addsuffix) '("/" . "")) (setq comint-input-ignoredups t) - (setq major-mode 'idlwave-shell-mode) - (setq mode-name "IDL-Shell") (setq idlwave-shell-mode-line-info nil) (setq mode-line-format '("" @@ -1023,7 +1018,6 @@ IDL has currently stepped.") nil 'local) (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) (add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files) - (use-local-map idlwave-shell-mode-map) (easy-menu-add idlwave-shell-mode-menu idlwave-shell-mode-map) ;; Set the optional comint variables @@ -1054,10 +1048,7 @@ IDL has currently stepped.") ;; with overlay-arrows. (remove-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file) - ;; IDLWAVE syntax, and turn on abbreviations - (setq local-abbrev-table idlwave-mode-abbrev-table) - (set-syntax-table idlwave-mode-syntax-table) (set (make-local-variable 'comment-start) ";") (setq abbrev-mode t) @@ -1076,8 +1067,6 @@ IDL has currently stepped.") ;; Turn off the non-debug toolbar buttons (open,save,etc.) (set (make-local-variable 'tool-bar-map) nil) - ;; Run the hooks. - (run-mode-hooks 'idlwave-shell-mode-hook) (idlwave-shell-send-command idlwave-shell-initial-commands nil 'hide) ;; Turn off IDL's ^d interpreting, and define a system ;; variable which knows the version of IDLWAVE @@ -1458,7 +1447,7 @@ Otherwise just move the line. Move down unless UP is non-nil." (arg (if up arg (- arg)))) (if (eq t idlwave-shell-arrows-do-history) (goto-char proc-pos)) (if (and idlwave-shell-arrows-do-history - (>= (1+ (save-excursion (end-of-line) (point))) proc-pos)) + (>= (1+ (point-at-eol)) proc-pos)) (comint-previous-input arg) (forward-line (- arg))))) @@ -2180,8 +2169,8 @@ keywords." ;; 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 +2178,7 @@ keywords." ((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) @@ -2211,7 +2200,7 @@ args of an executive .run, .rnew or .compile." (defun idlwave-shell-filename-string () "Return t if in a string and after what could be a file name." - (let ((limit (save-excursion (beginning-of-line) (point)))) + (let ((limit (point-at-bol))) (save-excursion ;; Skip backwards over file name chars (skip-chars-backward idlwave-shell-file-name-chars limit) @@ -2220,7 +2209,7 @@ args of an executive .run, .rnew or .compile." (defun idlwave-shell-batch-command () "Return t if we're in a batch command statement like @foo" - (let ((limit (save-excursion (beginning-of-line) (point)))) + (let ((limit (point-at-bol))) (save-excursion ;; Skip backwards over filename (skip-chars-backward idlwave-shell-file-name-chars limit) @@ -2398,7 +2387,7 @@ matter what the settings of that variable." idlwave-shell-electric-stop-line-face idlwave-shell-stop-line-face)) (move-overlay idlwave-shell-stop-line-overlay - (point) (save-excursion (end-of-line) (point)) + (point) (point-at-eol) (current-buffer))) ;; use the arrow instead, but only if marking is wanted. (if idlwave-shell-mark-stop-line @@ -2591,9 +2580,7 @@ If in the IDL shell buffer, returns `idlwave-shell-pc-frame'." (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 +3632,7 @@ Existing overlays are recycled, in order to minimize consumption." (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)) @@ -3897,7 +3884,7 @@ handled by this command." (setq overlay-arrow-string nil) (let (buf) (cond - ((eq major-mode 'idlwave-mode) + ((derived-mode-p 'idlwave-mode) (save-buffer) (setq idlwave-shell-last-save-and-action-file (buffer-file-name))) (idlwave-shell-last-save-and-action-file @@ -3999,8 +3986,7 @@ of the form: (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 @@ -4086,7 +4072,7 @@ of the form: (defun idlwave-shell-file-name (name) "If `idlwave-shell-use-truename' is non-nil, convert file name to true name. Otherwise, just expand the file name." - (let ((def-dir (if (eq major-mode 'idlwave-shell-mode) + (let ((def-dir (if (derived-mode-p 'idlwave-shell-mode) default-directory idlwave-shell-default-directory))) (if idlwave-shell-use-truename @@ -4349,7 +4335,7 @@ idlwave-shell-electric-debug-mode-map) (while (setq buf (pop buffers)) (when (buffer-live-p buf) (set-buffer buf) - (when (and (eq major-mode 'idlwave-mode) + (when (and (derived-mode-p 'idlwave-mode) buffer-file-name idlwave-shell-electric-debug-mode) (idlwave-shell-electric-debug-mode 0)))))) @@ -4374,51 +4360,51 @@ idlwave-shell-electric-debug-mode-map) ["Electric Debug Mode" idlwave-shell-electric-debug-mode :style toggle :selected idlwave-shell-electric-debug-mode - :included (eq major-mode 'idlwave-mode) :keys "C-c C-d C-v"] + :included (derived-mode-p 'idlwave-mode) :keys "C-c C-d C-v"] "--" ("Compile & Run" ["Save and .RUN" idlwave-shell-save-and-run - (or (eq major-mode 'idlwave-mode) + (or (derived-mode-p 'idlwave-mode) idlwave-shell-last-save-and-action-file)] ["Save and .COMPILE" idlwave-shell-save-and-compile - (or (eq major-mode 'idlwave-mode) + (or (derived-mode-p 'idlwave-mode) idlwave-shell-last-save-and-action-file)] ["Save and @Batch" idlwave-shell-save-and-batch - (or (eq major-mode 'idlwave-mode) + (or (derived-mode-p 'idlwave-mode) idlwave-shell-last-save-and-action-file)] "--" ["Goto Next Error" idlwave-shell-goto-next-error t] "--" ["Compile and Run Region" idlwave-shell-run-region - (eq major-mode 'idlwave-mode)] + (derived-mode-p 'idlwave-mode)] ["Evaluate Region" idlwave-shell-evaluate-region - (eq major-mode 'idlwave-mode)] + (derived-mode-p 'idlwave-mode)] "--" ["Execute Default Cmd" idlwave-shell-execute-default-command-line t] ["Edit Default Cmd" idlwave-shell-edit-default-command-line t]) ("Breakpoints" ["Set Breakpoint" idlwave-shell-break-here - :keys "C-c C-d C-b" :active (eq major-mode 'idlwave-mode)] + :keys "C-c C-d C-b" :active (derived-mode-p 'idlwave-mode)] ("Set Special Breakpoint" ["Set After Count Breakpoint" (progn (let ((count (string-to-number (read-string "Break after count: ")))) (if (integerp count) (idlwave-shell-break-here count)))) - :active (eq major-mode 'idlwave-mode)] + :active (derived-mode-p 'idlwave-mode)] ["Set Condition Breakpoint" (idlwave-shell-break-here '(4)) - :active (eq major-mode 'idlwave-mode)]) + :active (derived-mode-p 'idlwave-mode)]) ["Break in Module" idlwave-shell-break-in - :keys "C-c C-d C-i" :active (eq major-mode 'idlwave-mode)] + :keys "C-c C-d C-i" :active (derived-mode-p 'idlwave-mode)] ["Break in this Module" idlwave-shell-break-this-module - :keys "C-c C-d C-j" :active (eq major-mode 'idlwave-mode)] + :keys "C-c C-d C-j" :active (derived-mode-p 'idlwave-mode)] ["Clear Breakpoint" idlwave-shell-clear-current-bp t] ["Clear All Breakpoints" idlwave-shell-clear-all-bp t] ["Disable/Enable Breakpoint" idlwave-shell-toggle-enable-current-bp t] ["Goto Previous Breakpoint" idlwave-shell-goto-previous-bp - :keys "C-c C-d [" :active (eq major-mode 'idlwave-mode)] + :keys "C-c C-d [" :active (derived-mode-p 'idlwave-mode)] ["Goto Next Breakpoint" idlwave-shell-goto-next-bp - :keys "C-c C-d ]" :active (eq major-mode 'idlwave-mode)] + :keys "C-c C-d ]" :active (derived-mode-p 'idlwave-mode)] ["List All Breakpoints" idlwave-shell-list-all-bp t] ["Resync Breakpoints" idlwave-shell-bp-query t]) ("Continue/Step" @@ -4430,7 +4416,7 @@ idlwave-shell-electric-debug-mode-map) ["... to End of Subprog" idlwave-shell-return t] ["... to End of Subprog+1" idlwave-shell-out t] ["... to Here (Cursor Line)" idlwave-shell-to-here - :keys "C-c C-d C-h" :active (eq major-mode 'idlwave-mode)]) + :keys "C-c C-d C-h" :active (derived-mode-p 'idlwave-mode)]) ("Examine Expressions" ["Print expression" idlwave-shell-print t] ["Help on expression" idlwave-shell-help-expression t] @@ -4515,7 +4501,7 @@ idlwave-shell-electric-debug-mode-map) (save-current-buffer (dolist (buf (buffer-list)) (set-buffer buf) - (if (eq major-mode 'idlwave-mode) + (if (derived-mode-p 'idlwave-mode) (progn (easy-menu-remove idlwave-mode-debug-menu) (easy-menu-add idlwave-mode-debug-menu))))))) @@ -4693,5 +4679,4 @@ static char * file[] = { (if idlwave-shell-use-toolbar (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere)) -;; arch-tag: 20c2e8ce-0709-41d8-a5b6-bb039148440a ;;; idlw-shell.el ends here diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 474065451d7..e6137e46860 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -807,7 +807,7 @@ static char * file[] = { "Goto Next Error"] [idlwave-toolbar-stop-at-icon idlwave-shell-break-here - (eq major-mode 'idlwave-mode) + (derived-mode-p 'idlwave-mode) "Set Breakpoint at selected position"] [idlwave-toolbar-clear-at-icon idlwave-shell-clear-current-bp @@ -819,7 +819,7 @@ static char * file[] = { "Clear all Breakpoints"] [idlwave-toolbar-stop-beginning-icon idlwave-shell-break-this-module - (eq major-mode 'idlwave-mode) + (derived-mode-p 'idlwave-mode) "Stop at beginning of enclosing Routine"] [idlwave-toolbar-stop-in-icon idlwave-shell-break-in @@ -839,7 +839,7 @@ static char * file[] = { "Continue Current Program"] [idlwave-toolbar-to-here-icon idlwave-shell-to-here - (eq major-mode 'idlwave-mode) + (derived-mode-p 'idlwave-mode) "Continue to Here (cursor position)"] [idlwave-toolbar-step-over-icon idlwave-shell-stepover @@ -871,7 +871,7 @@ static char * file[] = { "Reset IDL (RETALL & CLOSE,/ALL and more)"] [idlwave-toolbar-electric-debug-icon idlwave-shell-electric-debug-mode - (eq major-mode 'idlwave-mode) + (derived-mode-p 'idlwave-mode) "Toggle Electric Debug Mode"] )) @@ -884,8 +884,7 @@ static char * file[] = { "Add the IDLWAVE toolbar if appropriate." (if (and (featurep 'xemacs) ; This is a noop on Emacs (boundp 'idlwave-toolbar-is-possible) - (or (eq major-mode 'idlwave-mode) - (eq major-mode 'idlwave-shell-mode))) + (derived-mode-p 'idlwave-mode 'idlwave-shell-mode)) (set-specifier default-toolbar (cons (current-buffer) idlwave-toolbar)))) @@ -893,8 +892,7 @@ static char * file[] = { "Add the IDLWAVE toolbar if appropriate." (if (and (featurep 'xemacs) ; This is a noop on Emacs (boundp 'idlwave-toolbar-is-possible) - (or (eq major-mode 'idlwave-mode) - (eq major-mode 'idlwave-shell-mode))) + (derived-mode-p 'idlwave-mode 'idlwave-shell-mode)) (remove-specifier default-toolbar (current-buffer)))) (defvar idlwave-shell-mode-map) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index dc85d094810..4788cb30783 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1776,7 +1776,7 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into (defvar idlwave-mode-debug-menu) ;;;###autoload -(defun idlwave-mode () +(define-derived-mode idlwave-mode prog-mode "IDLWAVE" "Major mode for editing IDL source files (version 6.1_em22). The main features of this mode are @@ -1895,21 +1895,15 @@ The main features of this mode are followed by the key sequence to see what the key sequence does. \\{idlwave-mode-map}" - - (interactive) - (kill-all-local-variables) - + :abbrev-table idlwave-mode-abbrev-table (if idlwave-startup-message (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) (setq idlwave-startup-message nil) - (setq local-abbrev-table idlwave-mode-abbrev-table) - (set-syntax-table idlwave-mode-syntax-table) - (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) - (make-local-variable idlwave-comment-indent-function) - (set idlwave-comment-indent-function 'idlwave-comment-hook) + (set (make-local-variable idlwave-comment-indent-function) + #'idlwave-comment-hook) (set (make-local-variable 'comment-start-skip) ";+[ \t]*") (set (make-local-variable 'comment-start) ";") @@ -1919,14 +1913,10 @@ The main features of this mode are (set (make-local-variable 'indent-tabs-mode) nil) (set (make-local-variable 'completion-ignore-case) t) - (use-local-map idlwave-mode-map) - (when (featurep 'easymenu) (easy-menu-add idlwave-mode-menu idlwave-mode-map) (easy-menu-add idlwave-mode-debug-menu idlwave-mode-map)) - (setq mode-name "IDLWAVE") - (setq major-mode 'idlwave-mode) (setq abbrev-mode t) (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) @@ -1991,10 +1981,7 @@ The main features of this mode are (idlwave-new-buffer-update) ;; Check help location - (idlwave-help-check-locations) - - ;; Run the mode hook - (run-mode-hooks 'idlwave-mode-hook)) + (idlwave-help-check-locations)) (defvar idlwave-setup-done nil) (defun idlwave-setup () @@ -2097,7 +2084,7 @@ Returns non-nil if abbrev is left expanded." 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 @@ -2152,7 +2139,7 @@ Also checks if the correct END statement has been used." ;;(backward-char 1) (let* ((pos (point-marker)) (last-abbrev-marker (copy-marker last-abbrev-location)) - (eol-pos (save-excursion (end-of-line) (point))) + (eol-pos (point-at-eol)) begin-pos end-pos end end1 ) (if idlwave-reindent-end (idlwave-indent-line)) (setq last-abbrev-location (marker-position last-abbrev-marker)) @@ -2543,7 +2530,7 @@ Point is placed at the beginning of the line whether or not this is an actual statement." (interactive) (cond - ((eq major-mode 'idlwave-shell-mode) + ((derived-mode-p 'idlwave-shell-mode) (if (re-search-backward idlwave-shell-prompt-pattern nil t) (goto-char (match-end 0)))) (t @@ -3301,10 +3288,8 @@ ignored." (setq here (point)) (beginning-of-line) (setq bcl (point)) - (re-search-forward - (concat "^[ \t]*" comment-start "+") - (save-excursion (end-of-line) (point)) - t) + (re-search-forward (concat "^[ \t]*" comment-start "+") + (point-at-eol) t) ;; Get the comment leader on the line and its length (setq pre (current-column)) ;; the comment leader is the indentation plus exactly the @@ -3312,10 +3297,7 @@ ignored." (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 @@ -3369,9 +3351,7 @@ ignored." (setq indent hang) (beginning-of-line) (while (> (point) start) - (re-search-forward comment-start-skip - (save-excursion (end-of-line) (point)) - t) + (re-search-forward comment-start-skip (point-at-eol) t) (if (> (setq diff (- indent (current-column))) 0) (progn (if (>= here (point)) @@ -3393,13 +3373,9 @@ ignored." (setq indent (min indent (progn - (re-search-forward - comment-start-skip - (save-excursion (end-of-line) (point)) - t) + (re-search-forward comment-start-skip (point-at-eol) t) (current-column)))) - (forward-line -1)) - ) + (forward-line -1))) (setq fill-prefix (concat fill-prefix (make-string (- indent pre) ?\ ))) @@ -3407,10 +3383,7 @@ ignored." (setq first-indent (max (progn - (re-search-forward - comment-start-skip - (save-excursion (end-of-line) (point)) - t) + (re-search-forward comment-start-skip (point-at-eol) t) (current-column)) indent)) @@ -3448,17 +3421,11 @@ If not found returns nil." (if idlwave-use-last-hang-indent (save-excursion (end-of-line) - (if (re-search-backward - idlwave-hang-indent-regexp - (save-excursion (beginning-of-line) (point)) - t) + (if (re-search-backward idlwave-hang-indent-regexp (point-at-bol) t) (+ (current-column) (length idlwave-hang-indent-regexp)))) (save-excursion (beginning-of-line) - (if (re-search-forward - idlwave-hang-indent-regexp - (save-excursion (end-of-line) (point)) - t) + (if (re-search-forward idlwave-hang-indent-regexp (point-at-eol) t) (current-column))))) (defun idlwave-auto-fill () @@ -3502,18 +3469,14 @@ if `idlwave-auto-fill-split-string' is non-nil." (save-excursion (forward-line -1) (idlwave-calc-hanging-indent)))) - (if indent - (progn - ;; Remove whitespace between comment delimiter and - ;; text, insert spaces for appropriate indentation. - (beginning-of-line) - (re-search-forward - comment-start-skip - (save-excursion (end-of-line) (point)) t) - (delete-horizontal-space) - (idlwave-indent-to indent) - (goto-char (- (point-max) here))) - ))) + (when indent + ;; Remove whitespace between comment delimiter and + ;; text, insert spaces for appropriate indentation. + (beginning-of-line) + (re-search-forward comment-start-skip (point-at-eol) t) + (delete-horizontal-space) + (idlwave-indent-to indent) + (goto-char (- (point-max) here))))) ;; Split code or comment? (if (save-excursion (end-of-line 0) @@ -3689,7 +3652,7 @@ constants - a double quote followed by an octal digit." ;; 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)) @@ -3756,7 +3719,7 @@ expression to enter. The lines containing S1 and S2 are reindented using `indent-region' unless the optional second argument NOINDENT is non-nil." - (if (eq major-mode 'idlwave-shell-mode) + (if (derived-mode-p 'idlwave-shell-mode) ;; This is a gross hack to avoit template abbrev expansion ;; in the shell. FIXME: This is a dirty hack. (if (and (eq this-command 'self-insert-command) @@ -3767,7 +3730,7 @@ unless the optional second argument NOINDENT is non-nil." (setq s1 (downcase s1) s2 (downcase s2))) (idlwave-abbrev-change-case (setq s1 (upcase s1) s2 (upcase s2)))) - (let ((beg (save-excursion (beginning-of-line) (point))) + (let ((beg (point-at-bol)) end) (if (not (looking-at "\\s-*\n")) (open-line 1)) @@ -5112,7 +5075,7 @@ Cache to disk for quick recovery." (setq res nil)) (t ;; Just scan this buffer - (if (eq major-mode 'idlwave-mode) + (if (derived-mode-p 'idlwave-mode) (progn (message "Scanning current buffer...") (setq res (idlwave-get-routine-info-from-buffers @@ -5166,7 +5129,7 @@ Cache to disk for quick recovery." (defun idlwave-update-current-buffer-info (why) "Update `idlwave-routines' for current buffer. Can run from `after-save-hook'." - (when (and (eq major-mode 'idlwave-mode) + (when (and (derived-mode-p 'idlwave-mode) (or (eq t idlwave-auto-routine-info-updates) (memq why idlwave-auto-routine-info-updates)) idlwave-scan-all-buffers-for-routine-info @@ -5212,7 +5175,7 @@ Can run from `after-save-hook'." (save-excursion (while (setq buf (pop buffers)) (set-buffer buf) - (if (and (eq major-mode 'idlwave-mode) + (if (and (derived-mode-p 'idlwave-mode) buffer-file-name) ;; yes, this buffer has the right mode. (progn (setq res (condition-case nil @@ -6911,9 +6874,10 @@ accumulate information on matching completions." ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- -(defvar rtn) -(defun idlwave-pset (item) - (set 'rtn item)) +(when (featurep 'xemacs) + (defvar rtn) + (defun idlwave-pset (item) + (set 'rtn item))) (defun idlwave-popup-select (ev list title &optional sort) "Select an item in LIST with a popup menu. @@ -7053,7 +7017,7 @@ sort the list before displaying." "Call FUNCTION as a completion chooser and pass ARGS to it." (let ((completion-ignore-case t)) ; install correct value (apply function args)) - (if (and (eq major-mode 'idlwave-shell-mode) + (if (and (derived-mode-p 'idlwave-shell-mode) (boundp 'font-lock-mode) (not font-lock-mode)) ;; For the shell, remove the fontification of the word before point @@ -7454,7 +7418,7 @@ class/struct definition." ;; Read the file in temporarily (set-buffer (get-buffer-create " *IDLWAVE-tmp*")) (erase-buffer) - (unless (eq major-mode 'idlwave-mode) + (unless (derived-mode-p 'idlwave-mode) (idlwave-mode)) (insert-file-contents file)) (save-excursion @@ -7682,8 +7646,7 @@ property indicating the link is added." t)) ; return t to skip other completions (t nil)))) -(defvar link) ;dynamic variables set by help callback -(defvar props) +(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))) @@ -7691,7 +7654,8 @@ property indicating the link is added." ((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) @@ -7705,10 +7669,10 @@ property indicating the link is added." (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) @@ -7728,9 +7692,10 @@ property indicating the link is added." 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 @@ -7746,9 +7711,9 @@ property indicating the link is added." 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")))) @@ -8205,8 +8170,7 @@ demand _EXTRA in the keyword list." ;; If this is the OBJ_NEW function, try to figure out the class and use ;; the keywords from the corresponding INIT method. (if (and (equal (upcase name) "OBJ_NEW") - (or (eq major-mode 'idlwave-mode) - (eq major-mode 'idlwave-shell-mode))) + (derived-mode-p 'idlwave-mode 'idlwave-shell-mode)) (let* ((bos (save-excursion (idlwave-beginning-of-statement) (point))) (string (buffer-substring bos (point))) (case-fold-search t) @@ -8656,7 +8620,7 @@ was pressed." "List the load path shadows of all routines defined in current buffer." (interactive "P") (idlwave-routines) - (if (eq major-mode 'idlwave-mode) + (if (derived-mode-p 'idlwave-mode) (idlwave-list-load-path-shadows nil (idlwave-update-current-buffer-info 'save-buffer) "in current buffer") @@ -8826,9 +8790,9 @@ the `idlwave-system-routines' list, we omit the latter as 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 - (class (nth 2 entry)) ; idlwave-routine-twin-compare + (idlwave-twin-class (nth 2 entry)) ; idlwave-routine-twin-compare (cnt 0) source type type-cons file alist syslibp key) (while (setq entry (pop entries)) @@ -8870,7 +8834,6 @@ routines, and may have been scanned." ;; FIXME: Dynamically scoped vars need to use the `idlwave-' prefix. ;; (defvar type) -;; (defvar class) (defmacro idlwave-xor (a b) `(and (or ,a ,b) (not (and ,a ,b)))) @@ -8903,7 +8866,9 @@ names and path locations." (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)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside + (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)) (atype (car asrc)) (bsrc (nth 3 b)) @@ -8916,18 +8881,17 @@ This basically calls `idlwave-routine-twin-compare' with the correct args." (list atype afile (list atype))) (if (stringp bfile) (list (file-truename bfile) bfile (list btype)) - (list btype bfile (list btype)))) - )) + (list btype bfile (list btype)))))) ;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins. -;; FIXME: Dynamically scoped vars need to use the `idlwave-' prefix. -(defvar class) +(defvar idlwave-twin-class) +(defvar idlwave-twin-name) (defun idlwave-routine-twin-compare (a b) "Compare two routine twin entries for sorting. In here, A and B are not normal routine info entries, but special lists (KEY FILENAME (TYPES...)). -This expects NAME TYPE CLASS to be bound to the right values." +This expects NAME TYPE IDLWAVE-TWIN-CLASS to be bound to the right values." (let* (;; Dis-assemble entries (akey (car a)) (bkey (car b)) (afile (nth 1 a)) (bfile (nth 1 b)) @@ -8959,16 +8923,19 @@ This expects NAME TYPE CLASS to be bound to the right values." ;; Look at file names (aname (if (stringp afile) (downcase (file-name-nondirectory afile)) "")) (bname (if (stringp bfile) (downcase (file-name-nondirectory bfile)) "")) - (fname-re (if class (format "\\`%s__\\(%s\\|define\\)\\.pro\\'" - (regexp-quote (downcase class)) - (regexp-quote (downcase name))) - (format "\\`%s\\.pro" (regexp-quote (downcase name))))) + (fname-re (if idlwave-twin-class + (format "\\`%s__\\(%s\\|define\\)\\.pro\\'" + (regexp-quote (downcase idlwave-twin-class)) + (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)) - (adefp (and class anamep (string= "define" (match-string 1 aname)))) + (adefp (and idlwave-twin-class anamep + (string= "define" (match-string 1 aname)))) (bnamep (string-match fname-re bname)) - (bdefp (and class bnamep (string= "define" (match-string 1 bname))))) + (bdefp (and idlwave-twin-class bnamep + (string= "define" (match-string 1 bname))))) ;; Now: follow JD's ideas about sorting. Looks really simple now, ;; doesn't it? The difficult stuff is hidden above... @@ -8980,7 +8947,7 @@ This expects NAME TYPE CLASS to be bound to the right values." ((idlwave-xor acompp bcompp) acompp) ; Compiled entries ((idlwave-xor apathp bpathp) apathp) ; Library before non-library ((idlwave-xor anamep bnamep) anamep) ; Correct file names first - ((and class anamep bnamep ; both file names match -> + ((and idlwave-twin-class anamep bnamep ; both file names match -> (idlwave-xor adefp bdefp)) bdefp) ; __define after __method ((> anpath bnpath) t) ; Who is first on path? (t nil)))) ; Default @@ -9364,5 +9331,4 @@ This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." (provide 'idlwave) -;; arch-tag: f77f3b0c-c37c-424f-a328-0886fd42b6fb ;;; idlwave.el ends here diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 41ce378e966..109bda80170 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -216,7 +216,7 @@ buffer with \\[set-variable].") (put 'inferior-lisp-mode 'mode-class 'special) -(defun inferior-lisp-mode () +(define-derived-mode inferior-lisp-mode comint-mode "Inferior Lisp" "Major mode for interacting with an inferior Lisp process. Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an Emacs buffer. Variable `inferior-lisp-program' controls which Lisp interpreter @@ -263,18 +263,11 @@ If `comint-use-prompt-regexp' is nil (the default), \\[comint-insert-input] on o Paragraphs are separated only by blank lines. Semicolons start comments. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it." - (interactive) - (delay-mode-hooks - (comint-mode)) (setq comint-prompt-regexp inferior-lisp-prompt) - (setq major-mode 'inferior-lisp-mode) - (setq mode-name "Inferior Lisp") (setq mode-line-process '(":%s")) (lisp-mode-variables t) - (use-local-map inferior-lisp-mode-map) ;c-c c-k for "kompile" file (setq comint-get-old-input (function lisp-get-old-input)) - (setq comint-input-filter (function lisp-input-filter)) - (run-mode-hooks 'inferior-lisp-mode-hook)) + (setq comint-input-filter (function lisp-input-filter))) (defun lisp-get-old-input () "Return a string containing the sexp ending at point." @@ -600,7 +593,7 @@ See variable `lisp-describe-sym-command'." ;; "Returns the current inferior Lisp process. ;; See variable `inferior-lisp-buffer'." (defun inferior-lisp-proc () - (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode) + (let ((proc (get-buffer-process (if (derived-mode-p 'inferior-lisp-mode) (current-buffer) inferior-lisp-buffer)))) (or proc diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index aeb2e91b6af..fdb11aa7d88 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -703,7 +703,7 @@ point at BOB." (setq str-terminator ?/)) (re-search-forward (concat "\\([^\\]\\|^\\)" (string str-terminator)) - (save-excursion (end-of-line) (point)) t)) + (point-at-eol) t)) ((nth 7 parse) (forward-line)) ((or (nth 4 parse) @@ -759,7 +759,7 @@ macro as normal text." (setq str-terminator ?/)) (re-search-backward (concat "\\([^\\]\\|^\\)" (string str-terminator)) - (save-excursion (beginning-of-line) (point)) t)) + (point-at-bol) t)) ((nth 7 parse) (goto-char (nth 8 parse))) ((or (nth 4 parse) @@ -2135,7 +2135,7 @@ and each value is a marker giving the location of that symbol." with imenu-use-markers = t for buffer being the buffers for imenu-index = (with-current-buffer buffer - (when (eq major-mode 'js-mode) + (when (derived-mode-p 'js-mode) (js--imenu-create-index))) do (js--imenu-to-flat imenu-index "" symbols) finally return symbols)) @@ -3286,15 +3286,9 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;;; Main Function ;;;###autoload -(define-derived-mode js-mode prog-mode "js" - "Major mode for editing JavaScript. - -Key bindings: - -\\{js-mode-map}" - +(define-derived-mode js-mode prog-mode "Javascript" + "Major mode for editing JavaScript." :group 'js - :syntax-table js-mode-syntax-table (set (make-local-variable 'indent-line-function) 'js-indent-line) (set (make-local-variable 'beginning-of-defun-function) @@ -3330,9 +3324,6 @@ Key bindings: (set (make-local-variable 'imenu-create-index-function) #'js--imenu-create-index) - (setq major-mode 'js-mode) - (setq mode-name "Javascript") - ;; for filling, pretend we're cc-mode (setq c-comment-prefix-regexp "//+\\|\\**" c-paragraph-start "$" @@ -3363,10 +3354,9 @@ Key bindings: ;; the buffer containing the problem, JIT-lock will apply the ;; correct syntax to the regular expresion literal and the problem ;; will mysteriously disappear. - (font-lock-set-defaults) - - (let (font-lock-keywords) ; leaves syntactic keywords intact - (font-lock-fontify-buffer))) + ;; FIXME: We should actually do this fontification lazily by adding + ;; calls to syntax-propertize wherever it's really needed. + (syntax-propertize (point-max))) ;;;###autoload (defalias 'javascript-mode 'js-mode) @@ -3377,5 +3367,4 @@ Key bindings: (provide 'js) -;; arch-tag: 1a0d0409-e87f-4fc7-a58c-3731c66ddaac ;; js.el ends here diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 07b6656bde0..39c46d69aea 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -143,27 +143,12 @@ (switch-to-buffer-other-window "*m4-output*")) ;;;###autoload -(defun m4-mode () - "A major mode to edit m4 macro files. -\\{m4-mode-map} -" - (interactive) - (kill-all-local-variables) - (use-local-map m4-mode-map) - - (make-local-variable 'comment-start) - (setq comment-start "#") - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (setq local-abbrev-table m4-mode-abbrev-table) - - (make-local-variable 'font-lock-defaults) - (setq major-mode 'm4-mode - mode-name "m4" - font-lock-defaults '(m4-font-lock-keywords nil) - ) - (set-syntax-table m4-mode-syntax-table) - (run-mode-hooks 'm4-mode-hook)) +(define-derived-mode m4-mode prog-mode "m4" + "A major mode to edit m4 macro files." + :abbrev-table m4-mode-abbrev-table + (set (make-local-variable 'comment-start) "#") + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'font-lock-defaults) '(m4-font-lock-keywords nil))) (provide 'm4-mode) ;;stuff to play with for debugging diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 70b38dc3999..7e679f7fe31 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -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 @@ -474,6 +474,7 @@ If the list was changed, sort the list and remove duplicates first." (defun meta-complete-symbol () "Perform completion on Metafont or MetaPost symbol preceding point." + ;; FIXME: Use completion-at-point-functions. (interactive "*") (let ((list meta-complete-list) entry) @@ -517,24 +518,24 @@ If the list was changed, sort the list and remove duplicates first." ;;; 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 +544,21 @@ If the list was changed, sort the list and remove duplicates first." (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 +576,11 @@ If the list was changed, sort the list and remove duplicates first." "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 +744,13 @@ If the list was changed, sort the list and remove duplicates first." (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) @@ -845,11 +845,10 @@ The environment marked is the one that contains point or follows point." ;;; Syntax table, keymap and menu. -(defvar meta-mode-abbrev-table nil +(define-abbrev-table 'meta-mode-abbrev-table () "Abbrev table used in Metafont or MetaPost mode.") -(define-abbrev-table 'meta-mode-abbrev-table ()) -(defvar meta-mode-syntax-table +(defvar meta-common-mode-syntax-table (let ((st (make-syntax-table))) ;; underscores are word constituents (modify-syntax-entry ?_ "w" st) @@ -886,9 +885,8 @@ The environment marked is the one that contains point or follows point." st) "Syntax table used in Metafont or MetaPost mode.") -(defvar meta-mode-map +(defvar meta-common-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-m" 'reindent-then-newline-and-indent) ;; Comment Paragraphs: ;; (define-key map "\M-a" 'backward-sentence) ;; (define-key map "\M-e" 'forward-sentence) @@ -916,10 +914,10 @@ The environment marked is the one that contains point or follows point." ;; (define-key map "\C-c\C-l" 'meta-recenter-output) map) "Keymap used in Metafont or MetaPost mode.") - +(define-obsolete-variable-alias 'meta-mode-map 'meta-common-mode-map "24.1") (easy-menu-define - meta-mode-menu meta-mode-map + meta-mode-menu meta-common-mode-map "Menu used in Metafont or MetaPost mode." (list "Meta" ["Forward Environment" meta-beginning-of-defun t] @@ -955,21 +953,21 @@ The environment marked is the one that contains point or follows point." ;;; 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) @@ -977,106 +975,62 @@ The environment marked is the one that contains point or follows point." ;;; Initialization. -(defun meta-common-initialization () +(define-derived-mode meta-common-mode prog-mode "-Meta-common-" "Common initialization for Metafont or MetaPost mode." - (kill-all-local-variables) - - (make-local-variable 'paragraph-start) - (make-local-variable 'paragraph-separate) - (setq paragraph-start - (concat page-delimiter "\\|$")) - (setq paragraph-separate - (concat page-delimiter "\\|$")) - - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - - (make-local-variable 'comment-start-skip) - (make-local-variable 'comment-start) - (make-local-variable 'comment-end) - (make-local-variable 'comment-multi-line) - (setq comment-start-skip "%+[ \t\f]*") - (setq comment-start "%") - (setq comment-end "") - (setq comment-multi-line nil) + :abbrev-table meta-mode-abbrev-table + (set (make-local-variable 'paragraph-start) + (concat page-delimiter "\\|$")) + (set (make-local-variable 'paragraph-separate) + (concat page-delimiter "\\|$")) + + (set (make-local-variable 'paragraph-ignore-fill-prefix) t) + + (set (make-local-variable 'comment-start-skip) "%+[ \t\f]*") + (set (make-local-variable 'comment-start) "%") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-multi-line) nil) ;; We use `back-to-indentation' but \f is no indentation sign. (modify-syntax-entry ?\f "_ ") - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) + (set (make-local-variable 'parse-sexp-ignore-comments) t) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'meta-comment-indent) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'meta-indent-line) + (set (make-local-variable 'comment-indent-function) #'meta-comment-indent) + (set (make-local-variable 'indent-line-function) #'meta-indent-line) ;; No need to define a mode-specific 'indent-region-function. ;; Simply use the generic 'indent-region and 'comment-region. ;; Set defaults for font-lock mode. - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - '(meta-font-lock-keywords - nil nil ((?_ . "w")) nil - (font-lock-comment-start-regexp . "%"))) + (set (make-local-variable 'font-lock-defaults) + '(meta-font-lock-keywords + nil nil ((?_ . "w")) nil + (font-lock-comment-start-regexp . "%"))) ;; Activate syntax table, keymap and menu. - (setq local-abbrev-table meta-mode-abbrev-table) - (set-syntax-table meta-mode-syntax-table) - (use-local-map meta-mode-map) - (easy-menu-add meta-mode-menu) - ) + (easy-menu-add meta-mode-menu)) ;;;###autoload -(defun metafont-mode () - "Major mode for editing Metafont sources. -Special commands: -\\{meta-mode-map} - -Turning on Metafont mode calls the value of the variables -`meta-common-mode-hook' and `metafont-mode-hook'." - (interactive) - (meta-common-initialization) - (setq mode-name "Metafont") - (setq major-mode 'metafont-mode) - +(define-derived-mode metafont-mode meta-common-mode "Metafont" + "Major mode for editing Metafont sources." ;; Set defaults for completion function. - (make-local-variable 'meta-symbol-list) - (make-local-variable 'meta-symbol-changed) - (make-local-variable 'meta-complete-list) - (setq meta-symbol-list nil) - (setq meta-symbol-changed nil) + (set (make-local-variable 'meta-symbol-list) nil) + (set (make-local-variable 'meta-symbol-changed) nil) (apply 'meta-add-symbols metafont-symbol-list) - (setq meta-complete-list + (set (make-local-variable 'meta-complete-list) (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list) - (list "" 'ispell-complete-word))) - (run-mode-hooks 'meta-common-mode-hook 'metafont-mode-hook)) + (list "" 'ispell-complete-word)))) ;;;###autoload -(defun metapost-mode () - "Major mode for editing MetaPost sources. -Special commands: -\\{meta-mode-map} - -Turning on MetaPost mode calls the value of the variable -`meta-common-mode-hook' and `metafont-mode-hook'." - (interactive) - (meta-common-initialization) - (setq mode-name "MetaPost") - (setq major-mode 'metapost-mode) - +(define-derived-mode metapost-mode meta-common-mode "MetaPost" + "Major mode for editing MetaPost sources." ;; Set defaults for completion function. - (make-local-variable 'meta-symbol-list) - (make-local-variable 'meta-symbol-changed) - (make-local-variable 'meta-complete-list) - (setq meta-symbol-list nil) - (setq meta-symbol-changed nil) + (set (make-local-variable 'meta-symbol-list) nil) + (set (make-local-variable 'meta-symbol-changed) nil) (apply 'meta-add-symbols metapost-symbol-list) - (setq meta-complete-list + (set (make-local-variable 'meta-complete-list) (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list) - (list "" 'ispell-complete-word))) - (run-mode-hooks 'meta-common-mode-hook 'metapost-mode-hook)) + (list "" 'ispell-complete-word)))) ;;; Just in case ... @@ -1084,5 +1038,4 @@ Turning on MetaPost mode calls the value of the variable (provide 'meta-mode) (run-hooks 'meta-mode-load-hook) -;; arch-tag: ec2916b2-3a83-4cf7-962d-d8019370c006 ;;; meta-mode.el ends here diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index f2a7aa045e4..bdf222376ff 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -1106,8 +1106,7 @@ Assumes that file has been compiled with debugging support." ;;;###autoload (define-derived-mode mixal-mode fundamental-mode "mixal" - "Major mode for the mixal asm language. -\\{mixal-mode-map}" + "Major mode for the mixal asm language." (set (make-local-variable 'comment-start) "*") (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*") (set (make-local-variable 'font-lock-defaults) @@ -1117,11 +1116,7 @@ Assumes that file has been compiled with debugging support." ;; might add an indent function in the future ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line) (set (make-local-variable 'compile-command) (concat "mixasm " - buffer-file-name)) - ;; mixasm will do strange when there is no final newline, - ;; so let Emacs ensure that it is always there - (set (make-local-variable 'require-final-newline) - mode-require-final-newline)) + buffer-file-name))) (provide 'mixal-mode) diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 3d2af5e217e..2fc3bc59d88 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -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,21 @@ followed by the first character of the construct. `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 +408,131 @@ followed by the first character of the construct. (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))) - -(defun m2-tab () - "Indent to next tab stop." - (interactive) - (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent))) - -(defun m2-begin () +(define-skeleton m2-begin "Insert a BEGIN keyword and indent for the next line." - (interactive) - (insert "BEGIN") - (m2-newline) - (m2-tab)) + nil + \n "BEGIN" > \n) -(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)) - -(defun m2-definition () + "Case-Expression: " + \n "CASE " str " OF" > \n _ \n "END (* " str " *);" > \n) + +(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)) - -(defun 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")) - -(defun 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)) - -(defun m2-loop () - "Build skeleton LOOP (with END)." - (interactive) - (insert "LOOP") - (m2-newline) - (m2-newline) - (insert "END (* loop *);") - (end-of-line 0) - (m2-tab)) - -(defun 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)) - -(defun m2-or () - (interactive) - (m2-newline) - (backward-delete-char-untabify m2-indent) - (insert "|") - (m2-newline) - (m2-tab)) + (concat " BY " by))) + " DO" > \n _ \n "END (* for " str " to " v1 " *);" > \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))) - -(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)) - -(defun m2-record () - (interactive) - (insert "RECORD") - (m2-newline) - (m2-newline) - (insert "END (* record *);") - (end-of-line 0) - (m2-tab)) - -(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-header + "Insert a comment block containing the module title, author, etc." + "Title: " + "(*\n Title: \t" str + "\n Created: \t" (current-time-string) + "\n Author: \t" (user-full-name) " <" user-mail-address ">\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)) - -(defun m2-var () - (interactive) - (m2-newline) - (insert "VAR") - (m2-newline) - (m2-tab)) +(define-skeleton m2-if + "Insert skeleton IF statement, prompting for <boolean-expression>." + "<boolean-expression>: " + \n "IF " str " THEN" > \n _ \n "END (* if " str " *);" > \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)) - -(defun m2-export () - (interactive) - (insert "EXPORT QUALIFIED ")) +(define-skeleton m2-loop + "Build skeleton LOOP (with END)." + nil + \n "LOOP" > \n _ \n "END (* loop *);" > \n) -(defun m2-import () - (interactive) - (insert "FROM ") - (insert (read-string "Module: ")) - (insert " IMPORT ")) +(define-skeleton m2-module + "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>." + "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) + +(define-skeleton m2-or + "No doc." + nil + \n "|" > \n) + +(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) + +(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) + +(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) + +(define-skeleton m2-type + "No doc." + nil + \n "TYPE" > \n ";" > \n) + +(define-skeleton m2-until + "No doc." + "<boolean-expression>: " + \n "REPEAT" > \n _ \n "UNTIL " str ";" > \n) + +(define-skeleton m2-var + "No doc." + nil + \n "VAR" > \n ";" > \n) + +(define-skeleton m2-while + "No doc." + "<boolean-expression>: " + \n "WHILE " str " DO" > \n _ \n "END (* while " str " *);" > \n) + +(define-skeleton m2-export + "No doc." + nil + \n "EXPORT QUALIFIED " > _ \n) + +(define-skeleton m2-import + "No doc." + "Module: " + \n "FROM " str " IMPORT " > _ \n) (defun m2-begin-comment () (interactive) @@ -501,15 +552,15 @@ FROM SysStreams IMPORT sysIn, sysOut, sysErr; (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 () diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el index c526a634d86..1003ffd6460 100644 --- a/lisp/progmodes/octave-inf.el +++ b/lisp/progmodes/octave-inf.el @@ -121,34 +121,24 @@ the regular expression `comint-prompt-regexp', a buffer local variable." This variable is used to initialize `comint-dynamic-complete-functions' in the Inferior Octave buffer.") -(defun inferior-octave-mode () +(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave" "Major mode for interacting with an inferior Octave process. Runs Octave as a subprocess of Emacs, with Octave I/O through an Emacs buffer. Entry to this mode successively runs the hooks `comint-mode-hook' and `inferior-octave-mode-hook'." - (interactive) - (delay-mode-hooks (comint-mode)) (setq comint-prompt-regexp inferior-octave-prompt - major-mode 'inferior-octave-mode - mode-name "Inferior Octave" mode-line-process '(":%s") local-abbrev-table octave-abbrev-table) - (use-local-map inferior-octave-mode-map) - (set-syntax-table inferior-octave-mode-syntax-table) - (make-local-variable 'comment-start) - (setq comment-start octave-comment-start) - (make-local-variable 'comment-end) - (setq comment-end "") - (make-local-variable 'comment-column) - (setq comment-column 32) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip octave-comment-start-skip) + (set (make-local-variable 'comment-start) octave-comment-start) + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-column) 32) + (set (make-local-variable 'comment-start-skip) octave-comment-start-skip) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil)) + (set (make-local-variable 'font-lock-defaults) + '(inferior-octave-font-lock-keywords nil nil)) (setq comint-input-ring-file-name (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist") @@ -157,9 +147,7 @@ Entry to this mode successively runs the hooks `comint-mode-hook' and inferior-octave-dynamic-complete-functions) (add-hook 'comint-input-filter-functions 'inferior-octave-directory-tracker nil t) - (comint-read-input-ring t) - - (run-mode-hooks 'inferior-octave-mode-hook)) + (comint-read-input-ring t)) ;;;###autoload (defun inferior-octave (&optional arg) diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 56de9b869db..3e6c2896752 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -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 @@ parenthetical grouping.") (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 @@ parenthetical grouping.") 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, @@ -446,17 +433,13 @@ Non-nil means always go to the next Octave code line after sending." ;; (fundesc (atom "=" atom)) )) -(defconst octave-smie-closer-alist - (smie-bnf-closer-alist octave-smie-bnf-table)) - -(defconst octave-smie-op-levels - (smie-prec2-levels +(defconst octave-smie-grammar + (smie-prec2->grammar (smie-merge-prec2s - (smie-bnf-precedence-table - octave-smie-bnf-table - '((assoc "\n" ";"))) + (smie-bnf->prec2 octave-smie-bnf-table + '((assoc "\n" ";"))) - (smie-precs-precedence-table octave-operator-table)))) + (smie-precs->prec2 octave-operator-table)))) ;; Tokenizing needs to be refined so that ";;" is treated as two ;; tokens and also so as to recognize the \n separator (and @@ -521,17 +504,26 @@ Non-nil means always go to the next Octave code line after sending." (t (smie-default-forward-token)))) -(defconst octave-smie-indent-rules - '((";" - (:parent ("function" "if" "while" "else" "elseif" "for" "otherwise" - "case" "try" "catch" "unwind_protect" "unwind_protect_cleanup") - ;; FIXME: don't hardcode 2. - (+ parent octave-block-offset)) - ;; (:parent "switch" 4) ;For (invalid) code between switch and case. - 0) - ((:before . "case") octave-block-offset))) - -(defvar electric-indent-chars) +(defun octave-smie-rules (kind token) + (pcase (cons kind token) + ;; We could set smie-indent-basic instead, but that would have two + ;; disadvantages: + ;; - changes to octave-block-offset wouldn't take effect immediately. + ;; - edebug wouldn't show the use of this variable. + (`(:elem . basic) octave-block-offset) + ;; Since "case" is in the same BNF rules as switch..end, SMIE by default + ;; aligns it with "switch". + (`(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset)) + (`(:after . ";") + (if (smie-rule-parent-p "function" "if" "while" "else" "elseif" "for" + "otherwise" "case" "try" "catch" "unwind_protect" + "unwind_protect_cleanup") + (smie-rule-parent octave-block-offset) + ;; For (invalid) code between switch and case. + ;; (if (smie-parent-p "switch") 4) + 0)))) + +(defvar electric-layout-rules) ;;;###autoload (define-derived-mode octave-mode prog-mode "Octave" @@ -562,14 +554,6 @@ Keybindings 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. @@ -619,36 +603,21 @@ already added. You just need to add a description of the problem, including a reproducible test case and send the message." (setq local-abbrev-table octave-abbrev-table) - (smie-setup octave-smie-op-levels octave-smie-indent-rules) + (smie-setup octave-smie-grammar #'octave-smie-rules + :forward-token #'octave-smie-forward-token + :backward-token #'octave-smie-backward-token) (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) - (set (make-local-variable 'smie-backward-token-function) - 'octave-smie-backward-token) - (set (make-local-variable 'smie-forward-token-function) - 'octave-smie-forward-token) - (set (make-local-variable 'forward-sexp-function) - 'smie-forward-sexp-command) - (set (make-local-variable 'smie-closer-alist) octave-smie-closer-alist) - ;; Only needed for interactive calls to blink-matching-open. - (set (make-local-variable 'blink-matching-check-function) - #'smie-blink-matching-check) - - (when octave-blink-matching-block - (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) + (set (make-local-variable 'smie-blink-matching-triggers) - (append smie-blink-matching-triggers '(\;) - ;; Rather than wait for SPC or ; to blink, try to blink as - ;; soon as we type the last char of a block ender. - ;; But strip ?d from this list so that we don't blink twice - ;; when the user writes "endif" (once at "end" and another - ;; time at "endif"). - (delq ?d (delete-dups - (mapcar (lambda (kw) - (aref (cdr kw) (1- (length (cdr kw))))) - smie-closer-alist)))))) - - ;; FIXME: maybe we should use (cons ?\; electric-indent-chars) - ;; since only ; is really octave-specific. - (set (make-local-variable 'electric-indent-chars) '(?\; ?\s ?\n)) + (cons ?\; smie-blink-matching-triggers)) + (unless octave-blink-matching-block + (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)) + + (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) "") @@ -686,8 +655,7 @@ including a reproducible test case and send the message." 'octave-beginning-of-defun) (easy-menu-add octave-mode-menu) - (octave-initialize-completions) - (run-mode-hooks 'octave-mode-hook)) + (octave-initialize-completions)) (defvar info-lookup-mode) @@ -749,7 +717,7 @@ The new line is properly indented." (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." @@ -842,7 +810,7 @@ The block marked is the one that contains point or follows point." (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)) @@ -1030,45 +998,6 @@ variables." (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. @@ -1226,8 +1155,6 @@ code line." 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 @@ -1241,5 +1168,4 @@ code line." (provide 'octave-mod) -;; arch-tag: 05f1ce09-be87-4c00-803e-4919ffa26c23 ;;; octave-mod.el ends here diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index acd49e71dd8..a93e97efed9 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1,8 +1,8 @@ ;;; pascal.el --- major mode for editing pascal source in Emacs -;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, +;; 2002 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Espen Skoglund <esk@gnu.org> ;; Keywords: languages @@ -274,22 +274,12 @@ are handled in another way, and should not be added to this list." ;;; Macros ;;; -(defsubst pascal-get-beg-of-line (&optional arg) - (save-excursion - (beginning-of-line arg) - (point))) - -(defsubst pascal-get-end-of-line (&optional arg) - (save-excursion - (end-of-line arg) - (point))) - (defun pascal-declaration-end () (let ((nest 1)) (while (and (> nest 0) (re-search-forward "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" - (save-excursion (end-of-line 2) (point)) t)) + (point-at-eol 2) t)) (cond ((match-beginning 1) (setq nest (1+ nest))) ((match-beginning 2) (setq nest (1- nest))) ((looking-at "[^(\n]+)") (setq nest 0)))))) @@ -298,7 +288,7 @@ are handled in another way, and should not be added to this list." (defun pascal-declaration-beg () (let ((nest 1)) (while (and (> nest 0) - (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line 0) t)) + (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (point-at-bol 0) t)) (cond ((match-beginning 1) (setq nest 0)) ((match-beginning 2) (setq nest (1- nest))) ((match-beginning 3) (setq nest (1+ nest))))) @@ -306,8 +296,7 @@ are handled in another way, and should not be added to this list." (defsubst pascal-within-string () - (save-excursion - (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point))))) + (nth 3 (parse-partial-sexp (point-at-bol) (point)))) ;;;###autoload @@ -407,8 +396,7 @@ no args, if that value is non-nil." (forward-char 1) (delete-horizontal-space)) ((and (looking-at "(\\*\\|\\*[^)]") - (not (save-excursion - (search-forward "*)" (pascal-get-end-of-line) t)))) + (not (save-excursion (search-forward "*)" (point-at-eol) t)))) (setq setstar t)))) ;; If last line was a star comment line then this one shall be too. (if (null setstar) @@ -727,7 +715,7 @@ on the line which ends a function or procedure named NAME." (if (and (looking-at "\\<end;") (not (save-excursion (end-of-line) - (search-backward "{" (pascal-get-beg-of-line) t)))) + (search-backward "{" (point-at-bol) t)))) (let ((type (car (pascal-calculate-indent)))) (if (eq type 'declaration) () @@ -999,7 +987,7 @@ indent of the current line in parameterlist." (stpos (progn (goto-char (scan-lists (point) -1 1)) (point))) (stcol (1+ (current-column))) (edpos (progn (pascal-declaration-end) - (search-backward ")" (pascal-get-beg-of-line) t) + (search-backward ")" (point-at-bol) t) (point))) (usevar (re-search-backward "\\<var\\>" stpos t))) (if arg (progn @@ -1046,7 +1034,7 @@ indent of the current line in parameterlist." (setq ind (pascal-get-lineup-indent stpos edpos lineup)) (goto-char stpos) (while (and (<= (point) edpos) (not (eobp))) - (if (search-forward lineup (pascal-get-end-of-line) 'move) + (if (search-forward lineup (point-at-eol) 'move) (forward-char -1)) (delete-horizontal-space) (indent-to ind) @@ -1073,7 +1061,7 @@ indent of the current line in parameterlist." (goto-char b) ;; Get rightmost position (while (< (point) e) - (and (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move) + (and (re-search-forward reg (min e (point-at-eol 2)) 'move) (cond ((match-beginning 1) ;; Skip record blocks (pascal-declaration-end)) @@ -1137,7 +1125,7 @@ indent of the current line in parameterlist." ;; Search through all reachable functions (while (pascal-beg-of-defun) - (if (re-search-forward pascal-str (pascal-get-end-of-line) t) + (if (re-search-forward pascal-str (point-at-eol) t) (progn (setq match (buffer-substring (match-beginning 2) (match-end 2))) (push match pascal-all))) @@ -1154,17 +1142,17 @@ indent of the current line in parameterlist." match) ;; Traverse lines (while (< (point) end) - (if (re-search-forward "[:=]" (pascal-get-end-of-line) t) + (if (re-search-forward "[:=]" (point-at-eol) t) ;; Traverse current line (while (and (re-search-backward (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" pascal-symbol-re) - (pascal-get-beg-of-line) t) + (point-at-bol) t) (not (match-end 1))) (setq match (buffer-substring (match-beginning 0) (match-end 0))) (if (string-match (concat "\\<" pascal-str) match) (push match pascal-all)))) - (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t) + (if (re-search-forward "\\<record\\>" (point-at-eol) t) (pascal-declaration-end) (forward-line 1))) @@ -1206,7 +1194,7 @@ indent of the current line in parameterlist." (if (> start (prog1 (save-excursion (pascal-end-of-defun) (point)))) () ; Declarations not reachable - (if (search-forward "(" (pascal-get-end-of-line) t) + (if (search-forward "(" (point-at-eol) t) ;; Check parameterlist ;; FIXME: pascal-get-completion-decl doesn't understand ;; the var declarations in parameter lists :-( @@ -1264,8 +1252,7 @@ indent of the current line in parameterlist." (or (eq state 'declaration) (eq state 'paramlist) (and (eq state 'defun) (save-excursion - (re-search-backward ")[ \t]*:" - (pascal-get-beg-of-line) t)))) + (re-search-backward ")[ \t]*:" (point-at-bol) t)))) (if (or (eq state 'paramlist) (eq state 'defun)) (pascal-beg-of-defun)) (nconc @@ -1554,5 +1541,4 @@ Pascal Outline mode provides some additional commands. (provide 'pascal) -;; arch-tag: 04535136-fd93-40b4-a505-c9bebdc051f5 ;;; pascal.el ends here diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index ae3acc3cda3..63b77fca43a 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -274,6 +274,11 @@ The expansion is entirely correct because it uses the C preprocessor." ;; Be careful not to match "sub { (...) ... }". ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" (1 ".")) + ;; Turn __DATA__ trailer into a comment. + ("^\\(_\\)_\\(?:DATA\\|END\\)__[ \t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)" + (1 "< c") (2 "> c") + (0 (ignore (put-text-property (match-beginning 0) (match-end 0) + 'syntax-multiline t)))) ;; Regexp and funny quotes. Distinguishing a / that starts a regexp ;; match from the division operator is ...interesting. ;; Basically, / is a regexp match if it's preceded by an infix operator @@ -540,7 +545,7 @@ create a new comment." "Normal hook to run when entering Perl mode.") ;;;###autoload -(defun perl-mode () +(define-derived-mode perl-mode prog-mode "Perl" "Major mode for editing Perl code. Expression and list commands understand all Perl brackets. Tab indents for Perl code. @@ -587,33 +592,16 @@ Various indentation styles: K&R BSD BLK GNU LW perl-label-offset -5 -8 -2 -2 -2 Turning on Perl mode runs the normal hook `perl-mode-hook'." - (interactive) - (kill-all-local-variables) - (use-local-map perl-mode-map) - (setq major-mode 'perl-mode) - (setq mode-name "Perl") - (setq local-abbrev-table perl-mode-abbrev-table) - (set-syntax-table perl-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 'perl-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-start-skip) - (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *") - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'perl-comment-indent) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) + :abbrev-table perl-mode-abbrev-table + (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 'indent-line-function) #'perl-indent-line) + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *") + (set (make-local-variable 'comment-indent-function) #'perl-comment-indent) + (set (make-local-variable 'parse-sexp-ignore-comments) t) ;; Tell font-lock.el how to handle Perl. (setq font-lock-defaults '((perl-font-lock-keywords perl-font-lock-keywords-1 @@ -631,8 +619,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." (setq imenu-case-fold-search nil) ;; Setup outline-minor-mode. (set (make-local-variable 'outline-regexp) perl-outline-regexp) - (set (make-local-variable 'outline-level) 'perl-outline-level) - (run-mode-hooks 'perl-mode-hook)) + (set (make-local-variable 'outline-level) 'perl-outline-level)) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in Perl code @@ -915,9 +902,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." (cond ((looking-at ";?#") (forward-line 1) t) ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") - (save-excursion - (end-of-line) - (setq colon-line-end (point))) + (setq colon-line-end (line-end-position)) (search-forward ":"))))) ;; The first following code counts ;; if it is before the line we want to indent. @@ -977,7 +962,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." (if (= (char-after (marker-position bof-mark)) ?=) (message "Can't indent a format statement") (message "Indenting Perl expression...") - (save-excursion (end-of-line) (setq eol (point))) + (setq eol (line-end-position)) (save-excursion ; locate matching close paren (while (and (not (eobp)) (<= (point) eol)) (parse-partial-sexp (point) (point-max) 0)) @@ -1075,5 +1060,4 @@ With argument, repeat that many times; negative args move backward." (provide 'perl-mode) -;; arch-tag: 8c7ff68d-15f3-46a2-ade2-b7c41f176826 ;;; perl-mode.el ends here diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index f3db7fad135..822e6d9b6f8 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -123,7 +123,7 @@ When nil, send actual operating system end of file." ((not (zerop (skip-syntax-backward "."))))) (point)))) -(defconst prolog-smie-op-levels +(defconst prolog-smie-grammar ;; Rather than construct the operator levels table from the BNF, ;; we directly provide the operator precedences from GNU Prolog's ;; manual (7.14.10 op/3). The only problem is that GNU Prolog's @@ -173,39 +173,31 @@ When nil, send actual operating system end of file." ) "Precedence levels of infix operators.") -(defconst prolog-smie-indent-rules - '((":-") - ("->")) - "Prolog indentation rules.") +(defun prolog-smie-rules (kind token) + (pcase (cons kind token) + (`(:elem . basic) prolog-indent-width) + (`(:after . ".") 0) ;; To work around smie-closer-alist. + (`(:after . ,(or `":-" `"->")) prolog-indent-width))) (defun prolog-mode-variables () - (make-local-variable 'paragraph-separate) - (setq paragraph-separate (concat "%%\\|$\\|" page-delimiter)) ;'%%..' - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression '((nil "^\\sw+" 0))) - (smie-setup prolog-smie-op-levels prolog-smie-indent-rules) - (set (make-local-variable 'smie-forward-token-function) - #'prolog-smie-forward-token) - (set (make-local-variable 'smie-backward-token-function) - #'prolog-smie-backward-token) - (set (make-local-variable 'forward-sexp-function) - 'smie-forward-sexp-command) - (set (make-local-variable 'smie-indent-basic) prolog-indent-width) + (set (make-local-variable 'paragraph-separate) (concat "%%\\|$\\|" page-delimiter)) ;'%%..' + (set (make-local-variable 'paragraph-ignore-fill-prefix) t) + (set (make-local-variable 'imenu-generic-expression) '((nil "^\\sw+" 0))) + + ;; Setup SMIE. + (smie-setup prolog-smie-grammar #'prolog-smie-rules + :forward-token #'prolog-smie-forward-token + :backward-token #'prolog-smie-backward-token) (set (make-local-variable 'smie-blink-matching-triggers) '(?.)) (set (make-local-variable 'smie-closer-alist) '((t . "."))) (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) ;; There's no real closer in Prolog anyway. (set (make-local-variable 'smie-blink-matching-inners) t) - (make-local-variable 'comment-start) - (setq comment-start "%") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "\\(?:%+\\|/\\*+\\)[ \t]*") - (make-local-variable 'comment-end-skip) - (setq comment-end-skip "[ \t]*\\(\n\\|\\*+/\\)") - (make-local-variable 'comment-column) - (setq comment-column 48)) + + (set (make-local-variable 'comment-start) "%") + (set (make-local-variable 'comment-start-skip) "\\(?:%+\\|/\\*+\\)[ \t]*") + (set (make-local-variable 'comment-end-skip) "[ \t]*\\(\n\\|\\*+/\\)") + (set (make-local-variable 'comment-column) 48)) (defvar prolog-mode-map (let ((map (make-sparse-keymap))) @@ -243,7 +235,7 @@ if that value is non-nil." (defun end-of-prolog-clause () "Go to end of clause in this line." (beginning-of-line 1) - (let* ((eolpos (save-excursion (end-of-line) (point)))) + (let* ((eolpos (line-end-position))) (if (re-search-forward comment-start-skip eolpos 'move) (goto-char (match-beginning 0))) (skip-chars-backward " \t"))) @@ -435,5 +427,4 @@ If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode." (provide 'prolog) -;; arch-tag: f3ec6748-1272-4ab6-8826-c50cb1607636 ;;; prolog.el ends here diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 9b83f77d3b8..6158952772a 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -979,9 +979,7 @@ plus the usually uncoded characters inserted on positions 1 through 28." (define-derived-mode ps-run-mode comint-mode "Interactive PS" "Major mode in interactive PostScript window. -This mode is invoked from `ps-mode' and should not be called directly. - -\\{ps-run-mode-map}" +This mode is invoked from `ps-mode' and should not be called directly." (set (make-local-variable 'font-lock-defaults) '((ps-run-font-lock-keywords ps-run-font-lock-keywords-1 @@ -991,7 +989,7 @@ This mode is invoked from `ps-mode' and should not be called directly. (defun ps-run-running () "Error if not in `ps-mode' or not running PostScript." - (unless (equal major-mode 'ps-mode) + (unless (derived-mode-p 'ps-mode) (error "This function can only be called from PostScript mode")) (unless (equal (process-status "ps-run") 'run) (error "No PostScript process running"))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 10e852223ce..2428ecb7555 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -110,7 +110,8 @@ (,(rx symbol-start (group "def") (1+ space) (group (1+ (or word ?_)))) (1 font-lock-keyword-face) (2 font-lock-function-name-face)) ;; Top-level assignments are worth highlighting. - (,(rx line-start (group (1+ (or word ?_))) (0+ space) "=") + (,(rx line-start (group (1+ (or word ?_))) (0+ space) + (opt (or "+" "-" "*" "**" "/" "//" "&" "%" "|" "^" "<<" ">>")) "=") (1 font-lock-variable-name-face)) ;; Decorators. (,(rx line-start (* (any " \t")) (group "@" (1+ (or word ?_)) @@ -171,21 +172,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 " ")) @@ -1328,7 +1317,7 @@ See `python-check-command' for the default." (let ((name (buffer-file-name))) (if name (file-name-nondirectory name)))))))) - (setq python-saved-check-command command) + (set (make-local-variable 'python-saved-check-command) command) (require 'compile) ;To define compilation-* variables. (save-some-buffers (not compilation-ask-about-save) nil) (let ((compilation-error-regexp-alist @@ -1473,6 +1462,16 @@ Default ignores all inputs of 0, 1, or 2 non-blank characters." :type 'regexp :group 'python) +(defcustom python-remove-cwd-from-path t + "Whether to allow loading of Python modules from the current directory. +If this is non-nil, Emacs removes '' from sys.path when starting +an inferior Python process. This is the default, for security +reasons, as it is easy for the Python process to be started +without the user's realization (e.g. to perform completion)." + :type 'boolean + :group 'python + :version "23.3") + (defun python-input-filter (str) "`comint-input-filter' function for inferior Python. Don't save anything for STR matching `inferior-python-filter-regexp'." @@ -1570,20 +1569,24 @@ print version_info >= (2, 2) and version_info < (3, 0)\"")))) ;;;###autoload (defun run-python (&optional cmd noshow new) "Run an inferior Python process, input and output via buffer *Python*. -CMD is the Python command to run. NOSHOW non-nil means don't show the -buffer automatically. - -Normally, if there is a process already running in `python-buffer', -switch to that buffer. Interactively, a prefix arg allows you to edit -the initial command line (default is `python-command'); `-i' etc. args -will be added to this as appropriate. A new process is started if: -one isn't running attached to `python-buffer', or interactively the -default `python-command', or argument NEW is non-nil. See also the -documentation for `python-buffer'. - -Runs the hook `inferior-python-mode-hook' \(after the -`comint-mode-hook' is run). \(Type \\[describe-mode] in the process -buffer for a list of commands.)" +CMD is the Python command to run. NOSHOW non-nil means don't +show the buffer automatically. + +Interactively, a prefix arg means to prompt for the initial +Python command line (default is `python-command'). + +A new process is started if one isn't running attached to +`python-buffer', or if called from Lisp with non-nil arg NEW. +Otherwise, if a process is already running in `python-buffer', +switch to that buffer. + +This command runs the hook `inferior-python-mode-hook' after +running `comint-mode-hook'. Type \\[describe-mode] in the +process buffer for a list of commands. + +By default, Emacs inhibits the loading of Python modules from the +current working directory, for security reasons. To disable this +behavior, change `python-remove-cwd-from-path' to nil." (interactive (if current-prefix-arg (list (read-string "Run Python: " python-command) nil t) (list python-command))) @@ -1597,8 +1600,9 @@ buffer for a list of commands.)" (when (or new (not (comint-check-proc python-buffer))) (with-current-buffer (let* ((cmdlist - (append (python-args-to-list cmd) - '("-i" "-c" "import sys; sys.path.remove('')"))) + (append (python-args-to-list cmd) '("-i") + (if python-remove-cwd-from-path + '("-c" "import sys; sys.path.remove('')")))) (path (getenv "PYTHONPATH")) (process-environment ; to import emacs.py (cons (concat "PYTHONPATH=" @@ -2518,7 +2522,6 @@ with skeleton expansions for compound statement templates. (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n") (set (make-local-variable 'outline-level) #'python-outline-level) (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) - (make-local-variable 'python-saved-check-command) (set (make-local-variable 'beginning-of-defun-function) 'python-beginning-of-defun) (set (make-local-variable 'end-of-defun-function) 'python-end-of-defun) @@ -2605,7 +2608,7 @@ This function is appropriate for `comint-output-filter-functions'." overlay-arrow-string "=>" python-pdbtrack-is-tracking-p t) (set-marker overlay-arrow-position - (save-excursion (beginning-of-line) (point)) + (line-beginning-position) (current-buffer))) (setq overlay-arrow-position nil python-pdbtrack-is-tracking-p nil))) @@ -2814,7 +2817,7 @@ command is used to switch to an existing process, only when a new process is started. If you use this, you will probably want to ensure that the current arguments are retained (they will be included in the prompt). This argument is ignored when this function is called -programmatically, or when running in Emacs 19.34 or older. +programmatically. Note: You can toggle between using the CPython interpreter and the JPython interpreter by hitting \\[python-toggle-shells]. This toggles @@ -2891,5 +2894,4 @@ filter." (provide 'python) (provide 'python-21) -;; arch-tag: 6fce1d99-a704-4de9-ba19-c6e4912b0554 ;;; python.el ends here diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 4d015de5198..b6158a0e581 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1,7 +1,7 @@ ;;; ruby-mode.el --- Major mode for editing Ruby files -;; Copyright (C) 1994, 1995, 1996 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 1994, 1995, 1996 1997, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; Authors: Yukihiro Matsumoto @@ -135,11 +135,9 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (defconst ruby-symbol-re (concat "[" ruby-symbol-chars "]") "Regexp to match symbols.") -(defvar ruby-mode-abbrev-table nil +(define-abbrev-table 'ruby-mode-abbrev-table () "Abbrev table in use in Ruby mode buffers.") -(define-abbrev-table 'ruby-mode-abbrev-table ()) - (defvar ruby-mode-map (let ((map (make-sparse-keymap))) (define-key map "{" 'ruby-electric-brace) @@ -618,7 +616,7 @@ and `\\' when preceded by `?'." (setq re (regexp-quote (or (match-string 4) (match-string 2)))) (if (match-beginning 1) (setq re (concat "\\s *" re))) (let* ((id-end (goto-char (match-end 0))) - (line-end-position (save-excursion (end-of-line) (point))) + (line-end-position (point-at-eol)) (state (list in-string nest depth pcol indent))) ;; parse the rest of the line (while (and (> line-end-position (point)) @@ -1110,6 +1108,8 @@ See `add-log-current-defun-function'." (if mlist (concat mlist mname) mname) mlist))))) +(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit)) + (if (eval-when-compile (fboundp #'syntax-propertize-rules)) ;; New code that works independently from font-lock. (progn @@ -1164,7 +1164,7 @@ See `add-log-current-defun-function'." ;; inf-loop. (if (< (point) start) (goto-char start)))))) ) - + ;; For Emacsen where syntax-propertize-rules is not (yet) available, ;; fallback on the old font-lock-syntactic-keywords stuff. @@ -1256,7 +1256,7 @@ buffer position `limit' or the end of the buffer." (save-excursion (beginning-of-line) (catch 'done - (let ((eol (save-excursion (end-of-line) (point))) + (let ((eol (point-at-eol)) (case-fold-search nil) ;; Fake match data such that (match-end 0) is at eol (end-match-data (progn (looking-at ".*$") (match-data))) @@ -1430,8 +1430,6 @@ See `font-lock-syntax-table'.") ) "Additional expressions to highlight in Ruby mode.") -(defvar electric-indent-chars) - ;;;###autoload (define-derived-mode ruby-mode prog-mode "Ruby" "Major mode for editing Ruby scripts. @@ -1456,8 +1454,7 @@ The variable `ruby-indent-level' controls the amount of indentation. 'ruby-mode-set-encoding nil 'local) (set (make-local-variable 'electric-indent-chars) - (append '(?\{ ?\}) (if (boundp 'electric-indent-chars) - (default-value 'electric-indent-chars)))) + (append '(?\{ ?\}) electric-indent-chars)) (set (make-local-variable 'font-lock-defaults) '((ruby-font-lock-keywords) nil nil)) @@ -1483,5 +1480,4 @@ The variable `ruby-indent-level' controls the amount of indentation. (provide 'ruby-mode) -;; arch-tag: e6ecc893-8005-420c-b7f9-34ab99a1fff9 ;;; ruby-mode.el ends here diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index da143db5ffb..fa4c02a7442 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -126,39 +126,27 @@ (defun scheme-mode-variables () (set-syntax-table scheme-mode-syntax-table) (setq local-abbrev-table scheme-mode-abbrev-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 'fill-paragraph-function) - (setq fill-paragraph-function 'lisp-fill-paragraph) + (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 'fill-paragraph-function) 'lisp-fill-paragraph) ;; Adaptive fill mode gets in the way of auto-fill, ;; and should make no difference for explicit fill ;; because lisp-fill-paragraph should do the job. - (make-local-variable 'adaptive-fill-mode) - (setq adaptive-fill-mode nil) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'lisp-indent-line) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (make-local-variable 'outline-regexp) - (setq outline-regexp ";;; \\|(....") - (make-local-variable 'comment-start) - (setq comment-start ";") + (set (make-local-variable 'adaptive-fill-mode) nil) + (set (make-local-variable 'indent-line-function) 'lisp-indent-line) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'outline-regexp) ";;; \\|(....") + (set (make-local-variable 'comment-start) ";") (set (make-local-variable 'comment-add) 1) - (make-local-variable 'comment-start-skip) ;; Look within the line for a ; following an even number of backslashes ;; after either a non-backslash or the line beginning. - (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") + (set (make-local-variable 'comment-start-skip) + "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") (set (make-local-variable 'font-lock-comment-start-skip) ";+ *") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (make-local-variable 'lisp-indent-function) - (setq lisp-indent-function 'scheme-indent-function) + (set (make-local-variable 'comment-column) 40) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'lisp-indent-function) 'scheme-indent-function) (setq mode-line-process '("" scheme-mode-line-process)) (set (make-local-variable 'imenu-case-fold-search) t) (setq imenu-generic-expression scheme-imenu-generic-expression) @@ -206,7 +194,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (define-key map "\e\C-q" 'indent-sexp)) ;;;###autoload -(defun scheme-mode () +(define-derived-mode scheme-mode prog-mode "Scheme" "Major mode for editing Scheme code. Editing commands are similar to those of `lisp-mode'. @@ -225,13 +213,7 @@ Blank lines separate paragraphs. Semicolons start comments. \\{scheme-mode-map} Entry to this mode calls the value of `scheme-mode-hook' if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map scheme-mode-map) - (setq major-mode 'scheme-mode) - (setq mode-name "Scheme") - (scheme-mode-variables) - (run-mode-hooks 'scheme-mode-hook)) + (scheme-mode-variables)) (defgroup scheme nil "Editing Scheme code." @@ -404,10 +386,7 @@ Blank lines separate paragraphs. Semicolons start comments. Entering this mode runs the hooks `scheme-mode-hook' and then `dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if that variable's value is a string." - (make-local-variable 'page-delimiter) - (setq page-delimiter "^;;;" ; ^L not valid SGML char - major-mode 'dsssl-mode - mode-name "DSSSL") + (set (make-local-variable 'page-delimiter) "^;;;") ; ^L not valid SGML char ;; Insert a suitable SGML declaration into an empty buffer. ;; FIXME: This should use `auto-insert-alist' instead. (and (zerop (buffer-size)) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index d41a81e38a6..ee7e4c3b1b6 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -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 @@ -361,8 +362,6 @@ the car and cdr are the same symbol.") "The shell being programmed. This is set by \\[sh-set-shell].") ;;;###autoload(put 'sh-shell 'safe-local-variable 'symbolp) -(defvar sh-mode-abbrev-table nil) - (define-abbrev-table 'sh-mode-abbrev-table ()) @@ -565,19 +564,6 @@ This is buffer-local in every such buffer.") :type '(repeat function) :group 'sh-script) - -(defcustom sh-require-final-newline - '((csh . t) - (pdksh . t)) - "Value of `require-final-newline' in Shell-Script mode buffers. -\(SHELL . t) means use the value of `mode-require-final-newline' for SHELL. -See `sh-feature'." - :type '(repeat (cons (symbol :tag "Shell") - (choice (const :tag "require" t) - (sexp :format "Evaluate: %v")))) - :group 'sh-script) - - (defcustom sh-assignment-regexp '((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=") ;; actually spaces are only supported in let/(( ... )) @@ -1716,10 +1702,6 @@ Calls the value of `sh-set-shell-hook' if set." (setq sh-shell-file (executable-set-magic shell (sh-feature sh-shell-arg) no-query-flag insert-flag))) - (let ((tem (sh-feature sh-require-final-newline))) - (if (eq tem t) - (set (make-local-variable 'require-final-newline) - mode-require-final-newline))) (setq mode-line-process (format "[%s]" sh-shell)) (set (make-local-variable 'sh-shell-variables) nil) (set (make-local-variable 'sh-shell-variables-initialized) nil) @@ -2136,11 +2118,7 @@ Return new point if successful, nil if an error occurred." (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 +3818,4 @@ shell command and conveniently use this command." (provide 'sh-script) -;; arch-tag: eccd8b72-f337-4fc2-ae86-18155a69d937 ;;; sh-script.el ends here diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 34c50b6cfe5..bccbbf245df 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -371,33 +371,20 @@ Variables controlling indentation style: Turning on SIMULA mode calls the value of the variable simula-mode-hook with no arguments, if that value is non-nil." - (make-local-variable 'comment-column) - (setq comment-column 40) -; (make-local-variable 'end-comment-column) -; (setq end-comment-column 75) - (make-local-variable 'paragraph-start) - (setq paragraph-start "[ \t]*$\\|\\f") - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'simula-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-start-skip) - (setq comment-start-skip "!+ *") - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments nil) - (make-local-variable 'comment-multi-line) - (setq comment-multi-line t) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - '((simula-font-lock-keywords simula-font-lock-keywords-1 - simula-font-lock-keywords-2 simula-font-lock-keywords-3) - nil t ((?_ . "w")))) + (set (make-local-variable 'comment-column) 40) + ;; (set (make-local-variable 'end-comment-column) 75) + (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\\f") + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'indent-line-function) 'simula-indent-line) + (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) nil) + (set (make-local-variable 'comment-multi-line) t) + (set (make-local-variable 'font-lock-defaults) + '((simula-font-lock-keywords simula-font-lock-keywords-1 + simula-font-lock-keywords-2 simula-font-lock-keywords-3) + nil t ((?_ . "w")))) (set (make-local-variable 'syntax-propertize-function) simula-syntax-propertize-function) (abbrev-mode 1)) @@ -964,7 +951,7 @@ If COUNT is negative, move backward instead." (simula-previous-statement 1) (simula-skip-comment-backward))) (setq start-line - (save-excursion (beginning-of-line) (point)) + (line-beginning-position) ;; - perhaps this is a continued statement continued (save-excursion @@ -1023,7 +1010,7 @@ If COUNT is negative, move backward instead." (car simula-continued-statement-offset) simula-continued-statement-offset)))) (setq start-line - (save-excursion (beginning-of-line) (point)) + (line-beginning-position) continued nil)) ;; search failed .. point is at beginning of line ;; determine if we should continue searching @@ -1064,7 +1051,7 @@ If COUNT is negative, move backward instead." simula-continued-statement-offset)))) ;; while ends if point is at beginning of line at loop test (if (not temp) - (setq start-line (save-excursion (beginning-of-line) (point))) + (setq start-line (line-beginning-position)) (beginning-of-line)))) ;; ;; return indentation @@ -1659,5 +1646,4 @@ If not nil and not t, move to limit of search and return nil." (provide 'simula) -;; arch-tag: 488c1bb0-eebf-4f06-93df-1df603f06255 ;;; simula.el ends here diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 7148027f487..053816d0287 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -7,7 +7,8 @@ ;; Maintainer: Michael Mauger <mmaug@yahoo.com> ;; Version: 2.8 ;; Keywords: comm languages processes -;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el +;; URL: http://savannah.gnu.org/projects/emacs/ +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode ;; This file is part of GNU Emacs. @@ -2302,20 +2303,21 @@ also be configured." '((?_ . "w") (?. . "w"))))) ;; Get the product-specific keywords. - (setq sql-mode-font-lock-keywords - (append - (unless (eq sql-product 'ansi) - (sql-get-product-feature sql-product :font-lock)) - ;; Always highlight ANSI keywords - (sql-get-product-feature 'ansi :font-lock) - ;; Fontify object names in CREATE, DROP and ALTER DDL - ;; statements - (list sql-mode-font-lock-object-name))) + (set (make-local-variable 'sql-mode-font-lock-keywords) + (append + (unless (eq sql-product 'ansi) + (sql-get-product-feature sql-product :font-lock)) + ;; Always highlight ANSI keywords + (sql-get-product-feature 'ansi :font-lock) + ;; Fontify object names in CREATE, DROP and ALTER DDL + ;; statements + (list sql-mode-font-lock-object-name))) ;; Setup font-lock. Force re-parsing of `font-lock-defaults'. (kill-local-variable 'font-lock-set-defaults) - (setq font-lock-defaults (list 'sql-mode-font-lock-keywords - keywords-only t syntax-alist)) + (set (make-local-variable 'font-lock-defaults) + (list 'sql-mode-font-lock-keywords + keywords-only t syntax-alist)) ;; Force font lock to reinitialize if it is already on ;; Otherwise, we can wait until it can be started. @@ -3231,7 +3233,7 @@ buffer is popped into a view window. " ;;; SQL mode -- uses SQL interactive mode ;;;###autoload -(defun sql-mode () +(define-derived-mode sql-mode prog-mode "SQL" "Major mode to edit SQL. You can send SQL statements to the SQLi buffer using @@ -3258,18 +3260,11 @@ you must tell Emacs. Here's how to do that in your `~/.emacs' file: \(add-hook 'sql-mode-hook (lambda () (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" - (interactive) - (kill-all-local-variables) - (setq major-mode 'sql-mode) - (setq mode-name "SQL") - (use-local-map sql-mode-map) + :abbrev-table sql-mode-abbrev-table (if sql-mode-menu (easy-menu-add sql-mode-menu)); XEmacs - (set-syntax-table sql-mode-syntax-table) - (make-local-variable 'font-lock-defaults) - (make-local-variable 'sql-mode-font-lock-keywords) - (make-local-variable 'comment-start) - (setq comment-start "--") + + (set (make-local-variable 'comment-start) "--") ;; Make each buffer in sql-mode remember the "current" SQLi buffer. (make-local-variable 'sql-buffer) ;; Add imenu support for sql-mode. Note that imenu-generic-expression @@ -3279,17 +3274,11 @@ you must tell Emacs. Here's how to do that in your `~/.emacs' file: imenu-case-fold-search t) ;; Make `sql-send-paragraph' work on paragraphs that contain indented ;; lines. - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (setq paragraph-separate "[\f]*$" - paragraph-start "[\n\f]") + (set (make-local-variable 'paragraph-separate) "[\f]*$") + (set (make-local-variable 'paragraph-start) "[\n\f]") ;; Abbrevs - (setq local-abbrev-table sql-mode-abbrev-table) (setq abbrev-all-caps 1) - ;; Run hook - (run-mode-hooks 'sql-mode-hook) ;; Catch changes to sql-product and highlight accordingly - (sql-highlight-product) (add-hook 'hack-local-variables-hook 'sql-highlight-product t t)) @@ -3374,15 +3363,14 @@ you entered, right above the output it created. sql-product)) ;; Setup the mode. - (setq major-mode 'sql-interactive-mode) - (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name) - (symbol-name sql-product)) "]")) + (setq major-mode 'sql-interactive-mode) ;FIXME: Use define-derived-mode. + (setq mode-name + (concat "SQLi[" (or (sql-get-product-feature sql-product :name) + (symbol-name sql-product)) "]")) (use-local-map sql-interactive-mode-map) (if sql-interactive-mode-menu (easy-menu-add sql-interactive-mode-menu)) ; XEmacs (set-syntax-table sql-mode-syntax-table) - (make-local-variable 'sql-mode-font-lock-keywords) - (make-local-variable 'font-lock-defaults) ;; Note that making KEYWORDS-ONLY nil will cause havoc if you try ;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column @@ -3391,8 +3379,7 @@ you entered, right above the output it created. (sql-product-font-lock t nil) ;; Enable commenting and uncommenting of the region. - (make-local-variable 'comment-start) - (setq comment-start "--") + (set (make-local-variable 'comment-start) "--") ;; Abbreviation table init and case-insensitive. It is not activated ;; by default. (setq local-abbrev-table sql-mode-abbrev-table) @@ -3402,8 +3389,8 @@ you entered, right above the output it created. ;; Save the connection name (make-local-variable 'sql-connection) ;; Create a usefull name for renaming this buffer later. - (make-local-variable 'sql-alternate-buffer-name) - (setq sql-alternate-buffer-name (sql-make-alternate-buffer-name)) + (set (make-local-variable 'sql-alternate-buffer-name) + (sql-make-alternate-buffer-name)) ;; User stuff. Initialize before the hook. (set (make-local-variable 'sql-prompt-regexp) (sql-get-product-feature sql-product :prompt-regexp)) @@ -4270,6 +4257,5 @@ buffer. (provide 'sql) -;; arch-tag: 7e1fa1c4-9ca2-402e-87d2-83a5eccb7ac3 ;;; sql.el ends here diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 8f80d13bab6..44ccd134a37 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -572,10 +572,7 @@ documentation for details): Turning on Tcl mode runs `tcl-mode-hook'. Read the documentation for `tcl-mode-hook' to see what kinds of interesting hook functions -already exist. - -Commands: -\\{tcl-mode-map}" +already exist." (unless (and (boundp 'filladapt-mode) filladapt-mode) (set (make-local-variable 'paragraph-ignore-fill-prefix) t)) @@ -607,15 +604,11 @@ Commands: (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) @@ -1068,7 +1061,7 @@ With argument, positions cursor at end of buffer." (defun inferior-tcl-proc () "Return current inferior Tcl process. See variable `inferior-tcl-buffer'." - (let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode) + (let ((proc (get-buffer-process (if (derived-mode-p 'inferior-tcl-mode) (current-buffer) inferior-tcl-buffer)))) (or proc @@ -1201,15 +1194,10 @@ semicolon, opening brace, or opening bracket on the same line." "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)) @@ -1296,7 +1284,7 @@ to update the alist.") If FLAG is nil, just uses `current-word'. Otherwise scans backward for most likely Tcl command word." (if (and flag - (memq major-mode '(tcl-mode inferior-tcl-mode))) + (derived-mode-p 'tcl-mode 'inferior-tcl-mode)) (condition-case nil (save-excursion ;; Look backward for first word actually in alist. @@ -1372,7 +1360,7 @@ Prefix argument means switch to the Tcl buffer afterwards." ;; filename. (car (comint-get-source "Load Tcl file: " (or (and - (eq major-mode 'tcl-mode) + (derived-mode-p 'tcl-mode) (buffer-file-name)) tcl-previous-dir/file) '(tcl-mode) t)) @@ -1392,12 +1380,12 @@ Prefix argument means switch to the Tcl buffer afterwards." (list (car (comint-get-source "Restart with Tcl file: " (or (and - (eq major-mode 'tcl-mode) + (derived-mode-p 'tcl-mode) (buffer-file-name)) tcl-previous-dir/file) '(tcl-mode) t)) current-prefix-arg)) - (let* ((buf (if (eq major-mode 'inferior-tcl-mode) + (let* ((buf (if (derived-mode-p 'inferior-tcl-mode) (current-buffer) inferior-tcl-buffer)) (proc (and buf (get-process buf)))) @@ -1557,5 +1545,4 @@ The first line is assumed to look like \"#!.../program ...\"." (provide 'tcl) -;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d ;;; tcl.el ends here diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 96877a000a1..7a22bec4259 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -253,7 +253,7 @@ If nil, TAB always indents current line." ;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) ;;;###autoload -(defun vera-mode () +(define-derived-mode vera-mode prog-mode "Vera" "Major mode for editing Vera code. Usage: @@ -301,13 +301,6 @@ Key bindings: ------------- \\{vera-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'vera-mode) - (setq mode-name "Vera") - ;; set maps and tables - (use-local-map vera-mode-map) - (set-syntax-table vera-mode-syntax-table) ;; set local variables (require 'cc-cmds) (set (make-local-variable 'comment-start) "//") @@ -328,9 +321,7 @@ Key bindings: ;; add menu (XEmacs) (easy-menu-add vera-mode-menu) ;; miscellaneous - (message "Vera Mode %s. Type C-c C-h for documentation." vera-version) - ;; run hooks - (run-hooks 'vera-mode-hook)) + (message "Vera Mode %s. Type C-c C-h for documentation." vera-version)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -770,7 +761,7 @@ the offset is simply returned." relpos 0) (setq offset (vera-evaluate-offset offset langelem symbol))) (+ (if (and relpos - (< relpos (save-excursion (beginning-of-line) (point)))) + (< relpos (line-beginning-position))) (save-excursion (goto-char relpos) (current-column)) @@ -1482,5 +1473,4 @@ If `vera-intelligent-tab' is nil, always indent line." (provide 'vera-mode) -;; arch-tag: 22eae722-7ac5-47ac-a713-c4db1cf623a9 ;;; vera-mode.el ends here diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 5e7699b3543..77dcac7f675 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -3,12 +3,12 @@ ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -;; Author: Michael McNamara (mac@verilog.com) -;; http://www.verilog.com +;; Author: Michael McNamara (mac@verilog.com), +;; Wilson Snyder (wsnyder@wsnyder.org) +;; Please see our web sites: +;; http://www.verilog.com +;; http://www.veripool.org ;; -;; AUTO features, signal, modsig; by: Wilson Snyder -;; (wsnyder@wsnyder.org) -;; http://www.veripool.org ;; Keywords: languages ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this @@ -81,15 +81,21 @@ ; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t ) ; (add-to-list 'auto-mode-alist '("\\.[ds]?vh?\\'" . verilog-mode)) +;; Be sure to examine at the help for verilog-auto, and the other +;; verilog-auto-* functions for some major coding time savers. +;; ;; If you want to customize Verilog mode to fit your needs better, -;; you may add these lines (the values of the variables presented +;; you may add the below lines (the values of the variables presented ;; here are the defaults). Note also that if you use an Emacs that ;; supports custom, it's probably better to use the custom menu to -;; edit these. -;; -;; Be sure to examine at the help for verilog-auto, and the other -;; verilog-auto-* functions for some major coding time savers. +;; edit these. If working as a member of a large team these settings +;; should be common across all users (in a site-start file), or set +;; in Local Variables in every file. Otherwise, different people's +;; AUTO expansion may result different whitespace changes. ;; +; ;; Enable syntax highlighting of **all** languages +; (global-font-lock-mode t) +; ; ;; User customization for Verilog mode ; (setq verilog-indent-level 3 ; verilog-indent-level-module 3 @@ -118,9 +124,9 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "565" +(defconst verilog-mode-version "650" "Version of this Verilog mode.") -(defconst verilog-mode-release-date "2010-03-01-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.") @@ -213,7 +219,14 @@ STRING should be given if the last search was by `string-match' on STRING." ;; We have an intermediate custom-library, hack around it! (defmacro customize-group (var &rest args) `(customize ,var)) - )) + ) + + (unless (boundp 'inhibit-point-motion-hooks) + (defvar inhibit-point-motion-hooks nil)) + (unless (boundp 'deactivate-mark) + (defvar deactivate-mark nil)) + ) + ;; ;; OK, do this stuff if we are NOT XEmacs: (unless (featurep 'xemacs) (unless (fboundp 'region-active-p) @@ -260,10 +273,21 @@ STRING should be given if the last search was by `string-match' on STRING." ;; Emacs. (defalias 'verilog-regexp-opt 'regexp-opt))) +(eval-and-compile + ;; Both xemacs and emacs + (condition-case nil + (unless (fboundp 'buffer-chars-modified-tick) ;; Emacs 22 added + (defmacro buffer-chars-modified-tick () (buffer-modified-tick))) + (error nil))) + (eval-when-compile (defun verilog-regexp-words (a) "Call 'regexp-opt' with word delimiters for the words A." (concat "\\<" (verilog-regexp-opt a t) "\\>"))) +(defun verilog-regexp-words (a) + "Call 'regexp-opt' with word delimiters for the words A." + ;; The FAQ references this function, so user LISP sometimes calls it + (concat "\\<" (verilog-regexp-opt a t) "\\>")) (defun verilog-easy-menu-filter (menu) "Filter `easy-menu-define' MENU to support new features." @@ -338,6 +362,9 @@ This function may be removed when Emacs 21 is no longer supported." "Customize AUTO actions when expanding Verilog source text." :group 'verilog-mode) +(defvar verilog-debug nil + "If set, enable debug messages for `verilog-mode' internals.") + (defcustom verilog-linter "echo 'No verilog-linter set, see \"M-x describe-variable verilog-linter\"'" "*Unix program and arguments to call to run a lint checker on Verilog source. @@ -378,11 +405,27 @@ you to the next lint error." :group 'verilog-mode-actions) ;; We don't mark it safe, as it's used as a shell command +(defcustom verilog-preprocessor + ;; Very few tools give preprocessed output, so we'll default to Verilog-Perl + "vppreproc __FLAGS__ __FILE__" + "*Program and arguments to use to preprocess Verilog source. +This is invoked with `verilog-preprocess', and depending on the +`verilog-set-compile-command', may also be invoked when you type +\\[compile]. When the compile completes, \\[next-error] will +take you to the next lint error." + :type 'string + :group 'verilog-mode-actions) +;; We don't mark it safe, as it's used as a shell command + +(defvar verilog-preprocess-history nil + "History for `verilog-preprocess'.") + (defvar verilog-tool 'verilog-linter "Which tool to use for building compiler-command. -Either nil, `verilog-linter, `verilog-coverage, `verilog-simulator, or -`verilog-compiler. Alternatively use the \"Choose Compilation Action\" -menu. See `verilog-set-compile-command' for more information.") +Either nil, `verilog-linter, `verilog-compiler, +`verilog-coverage, `verilog-preprocessor, or `verilog-simulator. +Alternatively use the \"Choose Compilation Action\" menu. See +`verilog-set-compile-command' for more information.") (defcustom verilog-highlight-translate-off nil "*Non-nil means background-highlight code excluded from translation. @@ -572,6 +615,23 @@ grouping constructs allow the structure of the code to be understood at a glance :type 'boolean) (put 'verilog-highlight-grouping-keywords 'safe-local-variable 'verilog-booleanp) +(defcustom verilog-highlight-modules nil + "*True means highlight module statements for `verilog-load-file-at-point'. +When true, mousing over module names will allow jumping to the +module definition. If false, this is not supported. Setting +this is experimental, and may lead to bad performance." + :group 'verilog-mode-indent + :type 'boolean) +(put 'verilog-highlight-modules 'safe-local-variable 'verilog-booleanp) + +(defcustom verilog-highlight-includes t + "*True means highlight module statements for `verilog-load-file-at-point'. +When true, mousing over include file names will allow jumping to the +file referenced. If false, this is not supported." + :group 'verilog-mode-indent + :type 'boolean) +(put 'verilog-highlight-includes 'safe-local-variable 'verilog-booleanp) + (defcustom verilog-auto-endcomments t "*True means insert a comment /* ... */ after 'end's. The name of the function or case will be set between the braces." @@ -640,9 +700,7 @@ always be saved." ;;; Compile support (require 'compile) (defvar verilog-error-regexp-added nil) -; List of regexps for Verilog compilers, like verilint. See compilation-error-regexp-alist -; for the formatting. -; Here is the version for Emacs 22: + (defvar verilog-error-regexp-emacs-alist '( (verilog-xl-1 @@ -650,7 +708,7 @@ always be saved." (verilog-xl-2 "([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\(line[ \t]+\\)?\\([0-9]+\\):.*$" 1 3) (verilog-IES - ".*\\*[WE],[0-9A-Z]+ (\\([^ \t,]+\\),\\([0-9]+\\)" 1 2) + ".*\\*[WE],[0-9A-Z]+\\(\[[0-9A-Z_,]+\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)" 2 3) (verilog-surefire-1 "[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 2) (verilog-surefire-2 @@ -672,87 +730,64 @@ always be saved." (verilog-verilator "%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 4) (verilog-leda - "In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\): -.* -.* -.* -\\(Warning\\|Error\\|Failure\\)" 1 2) - )) -;; And the version for XEmacs: -(defvar verilog-error-regexp-xemacs-alist - '(verilog - ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 2) - ("\\(WARNING\\|ERROR\\|INFO\\)[^:]*: \\([^,]+\\),\\s-+\\(line \\)?\\([0-9]+\\):" 2 4 ) - ("\ -\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\ -:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5) -; xsim -; Error! in file /homes/mac/Axis/Xsim/test.v at line 13 [OBJ_NOT_DECLARED] - ("\\(Error\\|Warning\\).*in file (\\([^ \t]+\\) at line *\\([0-9]+\\))" 2 3) -; vcs - ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 2 3) - ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 2) - ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 2 3) - ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 2) -; Verilator - ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 4) -; verilog-xl - ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 3) - ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 1 2) ; vxl - ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 1 2) -; nc-verilog - (".*\\*[WE],[0-9A-Z]+ (\\([^ \t,]+\\),\\([0-9]+\\)|" 1 2) -; Leda - ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 2) + "^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 2) ) - ) + "List of regexps for Verilog compilers. +See `compilation-error-regexp-alist' for the formatting. For Emacs 22+.") + +(defvar verilog-error-regexp-xemacs-alist + ;; Emacs form is '((v-tool "re" 1 2) ...) + ;; XEmacs form is '(verilog ("re" 1 2) ...) + ;; So we can just map from Emacs to Xemacs + (cons 'verilog (mapcar 'cdr verilog-error-regexp-emacs-alist)) + "List of regexps for Verilog compilers. +See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.") (defvar verilog-error-font-lock-keywords '( + ;; verilog-xl-1 + ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t) + ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t) + ;; verilog-xl-2 + ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\(line[ \t]+\\)?\\([0-9]+\\):.*$" 1 bold t) + ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\(line[ \t]+\\)?\\([0-9]+\\):.*$" 3 bold t) + ;; verilog-IES (nc-verilog) + (".*\\*[WE],[0-9A-Z]+\\(\[[0-9A-Z_,]+\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)|" 2 bold t) + (".*\\*[WE],[0-9A-Z]+\\(\[[0-9A-Z_,]+\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)|" 3 bold t) + ;; verilog-surefire-1 ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 bold t) ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 2 bold t) - + ;; verilog-surefire-2 ("\\(WARNING\\|ERROR\\|INFO\\): \\([^,]+\\), line \\([0-9]+\\):" 2 bold t) ("\\(WARNING\\|ERROR\\|INFO\\): \\([^,]+\\), line \\([0-9]+\\):" 3 bold t) - + ;; verilog-verbose ("\ \\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\ :\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 bold t) ("\ \\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\ :\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 bold t) - + ;; verilog-vcs-1 ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 2 bold t) ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 3 bold t) - - ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t) - ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t) - + ;; verilog-vcs-2 ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 bold t) ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 bold t) - + ;; verilog-vcs-3 ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t) ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 3 bold t) - + ;; verilog-vcs-4 ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 bold t) ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t) - ; vxl - ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t) - ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t) - - ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 1 bold t) - ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 2 bold t) - - ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 1 bold t) - ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 2 bold t) - ; nc-verilog - (".*[WE],[0-9A-Z]+ (\\([^ \t,]+\\),\\([0-9]+\\)|" 1 bold t) - (".*[WE],[0-9A-Z]+ (\\([^ \t,]+\\),\\([0-9]+\\)|" 2 bold t) - ; Leda - ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t) - ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t) + ;; verilog-verilator + (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t) + (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t) + ;; verilog-leda + ("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 bold t) + ("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 2 bold t) ) - "*Keywords to also highlight in Verilog *compilation* buffers.") + "*Keywords to also highlight in Verilog *compilation* buffers. +Only used in XEmacs; GNU Emacs uses `verilog-error-regexp-emacs-alist'.") (defcustom verilog-library-flags '("") "*List of standard Verilog arguments to use for /*AUTOINST*/. @@ -888,6 +923,16 @@ it's bad practice to rely on order based instantiations anyhow." :type 'boolean) (put 'verilog-auto-arg-sort 'safe-local-variable 'verilog-booleanp) +(defcustom verilog-auto-inst-dot-name nil + "*If true, when creating ports with AUTOINST, use .name syntax. +This will use \".port\" instead of \".port(port)\" when possible. +This is only legal in SystemVerilog files, and will confuse older +simulators. Setting `verilog-auto-inst-vector' to nil may also +be desirable to increase how often .name will be used." + :group 'verilog-mode-auto + :type 'boolean) +(put 'verilog-auto-inst-dot-name 'safe-local-variable 'verilog-booleanp) + (defcustom verilog-auto-inst-param-value nil "*If set, AUTOINST will replace parameters with the parameter value. If nil, leave parameters as symbolic names. @@ -899,7 +944,7 @@ be replaced, and will remain symbolic. For example, imagine a submodule uses parameters to declare the size of its inputs. This is then used by a upper module: - module InstModule (o,i) + module InstModule (o,i); parameter WIDTH; input [WIDTH-1:0] i; endmodule @@ -971,6 +1016,13 @@ See the \\[verilog-faq] for examples on using this." :type 'string) (put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp) +(defcustom verilog-auto-tieoff-ignore-regexp nil + "*If set, when creating AUTOTIEOFF list, ignore signals matching this regexp. +See the \\[verilog-faq] for examples on using this." + :group 'verilog-mode-auto + :type 'string) +(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp) + (defcustom verilog-auto-unused-ignore-regexp nil "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." @@ -1080,6 +1132,7 @@ If set will become buffer local.") (define-key map "\C-c\C-k" 'verilog-delete-auto) (define-key map "\C-c\C-a" 'verilog-auto) (define-key map "\C-c\C-s" 'verilog-auto-save-compile) + (define-key map "\C-c\C-p" 'verilog-preprocess) (define-key map "\C-c\C-z" 'verilog-inject-auto) (define-key map "\C-c\C-e" 'verilog-expand-vector) (define-key map "\C-c\C-h" 'verilog-header) @@ -1127,6 +1180,13 @@ If set will become buffer local.") :style radio :selected (equal verilog-tool `verilog-compiler) :help "When invoking compilation, compile Verilog source"] + ["Preprocessor" + (progn + (setq verilog-tool 'verilog-preprocessor) + (verilog-set-compile-command)) + :style radio + :selected (equal verilog-tool `verilog-preprocessor) + :help "When invoking compilation, preprocess Verilog source, see also `verilog-preprocess'"] ) ("Move" ["Beginning of function" verilog-beg-of-defun @@ -1318,6 +1378,9 @@ If set will become buffer local.") ;; Macros ;; +(defsubst verilog-within-string () + (nth 3 (parse-partial-sexp (point-at-bol) (point)))) + (defsubst verilog-string-replace-matches (from-string to-string fixedcase literal string) "Replace occurrences of FROM-STRING with TO-STRING. FIXEDCASE and LITERAL as in `replace-match`. STRING is what to replace. @@ -1394,19 +1457,45 @@ so there may be a large up front penalty for the first search." (setq pt (match-end 0)))) pt)) -(defsubst verilog-get-beg-of-line (&optional arg) - (save-excursion - (beginning-of-line arg) - (point))) - -(defsubst verilog-get-end-of-line (&optional arg) - (save-excursion - (end-of-line arg) - (point))) - -(defsubst verilog-within-string () - (save-excursion - (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point))))) +(defsubst verilog-re-search-forward-substr (substr regexp bound noerror) + "Like `re-search-forward', but first search for SUBSTR constant. +Then searched for the normal REGEXP (which contains SUBSTR), with given +BOUND and NOERROR. The REGEXP must fit within a single line. +This speeds up complicated regexp matches." + ;; Problem with overlap: search-forward BAR then FOOBARBAZ won't match. + ;; thus require matches to be on one line, and use beginning-of-line. + (let (done) + (while (and (not done) + (search-forward substr bound noerror)) + (save-excursion + (beginning-of-line) + (setq done (re-search-forward regexp (point-at-eol) noerror))) + (unless (and (<= (match-beginning 0) (point)) + (>= (match-end 0) (point))) + (setq done nil))) + (when done (goto-char done)) + done)) +;;(verilog-re-search-forward-substr "-end" "get-end-of" nil t) ;;-end (test bait) + +(defsubst verilog-re-search-backward-substr (substr regexp bound noerror) + "Like `re-search-backward', but first search for SUBSTR constant. +Then searched for the normal REGEXP (which contains SUBSTR), with given +BOUND and NOERROR. The REGEXP must fit within a single line. +This speeds up complicated regexp matches." + ;; Problem with overlap: search-backward BAR then FOOBARBAZ won't match. + ;; thus require matches to be on one line, and use beginning-of-line. + (let (done) + (while (and (not done) + (search-backward substr bound noerror)) + (save-excursion + (end-of-line) + (setq done (re-search-backward regexp (point-at-bol) noerror))) + (unless (and (<= (match-beginning 0) (point)) + (>= (match-end 0) (point))) + (setq done nil))) + (when done (goto-char done)) + done)) +;;(verilog-re-search-backward-substr "-end" "get-end-of" nil t) ;;-end (test bait) (defvar compile-command) @@ -1418,10 +1507,11 @@ This reads `verilog-tool' and sets `compile-command'. This specifies the program that executes when you type \\[compile] or \\[verilog-auto-save-compile]. -By default `verilog-tool' uses a Makefile if one exists in the current -directory. If not, it is set to the `verilog-linter', `verilog-coverage', -`verilog-simulator', or `verilog-compiler' variables, as selected with the -Verilog -> \"Choose Compilation Action\" menu. +By default `verilog-tool' uses a Makefile if one exists in the +current directory. If not, it is set to the `verilog-linter', +`verilog-compiler', `verilog-coverage', `verilog-preprocessor', +or `verilog-simulator' variables, as selected with the Verilog -> +\"Choose Compilation Action\" menu. You should set `verilog-tool' or the other variables to the path and arguments for your Verilog simulator. For example: @@ -1433,36 +1523,49 @@ In the former case, the path to the current buffer is concat'ed to the value of `verilog-tool'; in the later, the path to the current buffer is substituted for the %s. -Where __FILE__ appears in the string, the `buffer-file-name' of the -current buffer, without the directory portion, will be substituted." +Where __FLAGS__ appears in the string `verilog-current-flags' +will be substituted. + +Where __FILE__ appears in the string, the variable +`buffer-file-name' of the current buffer, without the directory +portion, will be substituted." (interactive) (cond ((or (file-exists-p "makefile") ;If there is a makefile, use it (file-exists-p "Makefile")) - (make-local-variable 'compile-command) - (setq compile-command "make ")) + (set (make-local-variable 'compile-command) "make ")) (t - (make-local-variable 'compile-command) - (setq compile-command - (if verilog-tool - (if (string-match "%s" (eval verilog-tool)) - (format (eval verilog-tool) (or buffer-file-name "")) - (concat (eval verilog-tool) " " (or buffer-file-name ""))) - "")))) + (set (make-local-variable 'compile-command) + (if verilog-tool + (if (string-match "%s" (eval verilog-tool)) + (format (eval verilog-tool) (or buffer-file-name "")) + (concat (eval verilog-tool) " " (or buffer-file-name ""))) + "")))) (verilog-modify-compile-command)) +(defun verilog-expand-command (command) + "Replace meta-information in COMMAND and return it. +Where __FLAGS__ appears in the string `verilog-current-flags' +will be substituted. Where __FILE__ appears in the string, the +current buffer's file-name, without the directory portion, will +be substituted." + (setq command (verilog-string-replace-matches + ;; Note \\b only works if under verilog syntax table + "\\b__FLAGS__\\b" (verilog-current-flags) + t t command)) + (setq command (verilog-string-replace-matches + "\\b__FILE__\\b" (file-name-nondirectory + (or (buffer-file-name) "")) + t t command)) + command) + (defun verilog-modify-compile-command () - "Replace meta-information in `compile-command'. -Where __FILE__ appears in the string, the current buffer's file-name, -without the directory portion, will be substituted." + "Update `compile-command' using `verilog-expand-command'." (when (and (stringp compile-command) - (string-match "\\b__FILE__\\b" compile-command)) - (make-local-variable 'compile-command) - (setq compile-command - (verilog-string-replace-matches - "\\b__FILE__\\b" (file-name-nondirectory (buffer-file-name)) - t t compile-command)))) + (string-match "\\b\\(__FLAGS__\\|__FILE__\\)\\b" compile-command)) + (set (make-local-variable 'compile-command) + (verilog-expand-command compile-command)))) (if (featurep 'xemacs) ;; Following code only gets called from compilation-mode-hook on XEmacs to add error handling. @@ -1483,8 +1586,8 @@ find the errors." (cdr compilation-error-regexp-alist-alist))))) (if (boundp 'compilation-font-lock-keywords) (progn - (make-local-variable 'compilation-font-lock-keywords) - (setq compilation-font-lock-keywords verilog-error-font-lock-keywords) + (set (make-local-variable 'compilation-font-lock-keywords) + verilog-error-font-lock-keywords) (font-lock-set-defaults))) ;; Need to re-run compilation-error-regexp builder (if (fboundp 'compilation-build-compilation-error-regexp-alist) @@ -1511,11 +1614,13 @@ find the errors." (if (featurep 'emacs) (add-hook 'compilation-mode-hook 'verilog-error-regexp-add-emacs)) (defconst verilog-directive-re - ;; "`case" "`default" "`define" "`define" "`else" "`endfor" "`endif" - ;; "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef" - ;; "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale" - ;; "`time_scale" "`undef" "`while" - "\\<`\\(case\\|def\\(ault\\|ine\\(\\)?\\)\\|e\\(lse\\|nd\\(for\\|if\\|protect\\|switch\\|while\\)\\)\\|for\\(mat\\)?\\|i\\(f\\(def\\|ndef\\)?\\|nclude\\)\\|let\\|protect\\|switch\\|time\\(_scale\\|scale\\)\\|undef\\|while\\)\\>") + (eval-when-compile + (verilog-regexp-words + '( + "`case" "`default" "`define" "`else" "`elsif" "`endfor" "`endif" + "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef" + "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale" + "`time_scale" "`undef" "`while" )))) (defconst verilog-directive-re-1 (concat "[ \t]*" verilog-directive-re)) @@ -1524,7 +1629,7 @@ find the errors." "\\<`\\(for\\|i\\(f\\|fdef\\|fndef\\)\\|switch\\|while\\)\\>") (defconst verilog-directive-middle - "\\<`\\(else\\|default\\|case\\)\\>") + "\\<`\\(else\\|elsif\\|default\\|case\\)\\>") (defconst verilog-directive-end "`\\(endfor\\|endif\\|endswitch\\|endwhile\\)\\>") @@ -1703,6 +1808,11 @@ find the errors." ;; b : (defconst verilog-label-re (concat verilog-symbol-re "\\s-*:\\s-*")) +(defconst verilog-property-re + (concat "\\(" verilog-label-re "\\)?" + "\\(\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(assert\\)")) + ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>" + (defconst verilog-no-indent-begin-re "\\<\\(if\\|else\\|while\\|for\\|repeat\\|always\\|always_comb\\|always_ff\\|always_latch\\)\\>") @@ -1837,6 +1947,8 @@ find the errors." "\\(\\<fork\\>\\)\\|" ; 7 "\\(\\<always\\>\\(\[ \t\]*@\\)?\\)\\|" "\\(\\<if\\>\\)\\|" + verilog-property-re "\\|" + "\\(\\(" verilog-label-re "\\)?\\<assert\\>\\)\\|" "\\(\\<clocking\\>\\)\\|" "\\(\\<task\\>\\)\\|" "\\(\\<function\\>\\)\\|" @@ -2051,7 +2163,7 @@ find the errors." "`case" "`default" "`define" "`undef" - "`if" "`ifdef" "`ifndef" "`else" "`endif" + "`if" "`ifdef" "`ifndef" "`else" "`elsif" "`endif" "`while" "`endwhile" "`for" "`endfor" "`format" @@ -2120,7 +2232,7 @@ find the errors." (defconst verilog-fork-wait-re "fork\\s-+wait\\>") (defconst verilog-extended-case-re "\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?") (defconst verilog-extended-complete-re - (concat "\\(\\<extern\\s-+\\|\\<virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)" + (concat "\\(\\<extern\\s-+\\|\\<\\(\\<pure\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)" "\\|\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)" "\\|\\(\\<import\\>\\s-+\\)?\"DPI-C\"\\s-+\\(function\\>\\|task\\>\\)" "\\|" verilog-extended-case-re )) @@ -2468,7 +2580,7 @@ See also `verilog-font-lock-extra-types'.") '("\\(@\\)\\|\\(#\\s-*\\(\\(\[0-9_.\]+\\('s?[hdxbo][0-9a-fA-F_xz]*\\)?\\)\\|\\(([^()]+)\\|\\sw+\\)\\)\\)" 0 font-lock-type-face append) ;; Fontify instantiation names - '("\\([A-Za-z][A-Za-z0-9_]+\\)\\s-*(" 1 font-lock-function-name-face) + '("\\([A-Za-z][A-Za-z0-9_]*\\)\\s-*(" 1 font-lock-function-name-face) ))) (setq verilog-font-lock-keywords-3 @@ -2480,22 +2592,145 @@ See also `verilog-font-lock-extra-types'.") (0 'verilog-font-lock-translate-off-face prepend)) ))))) +;; +;; Buffer state preservation + +(defmacro verilog-save-buffer-state (&rest body) + "Execute BODY forms, saving state around insignificant change. +Changes in text properties like `face' or `syntax-table' are +considered insignificant. This macro allows text properties to +be changed, even in a read-only buffer. + +A change is considered significant if it affects the buffer text +in any way that isn't completely restored again. Any +user-visible changes to the buffer must not be within a +`verilog-save-buffer-state'." + ;; From c-save-buffer-state + `(let* ((modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-point-motion-hooks t) + before-change-functions + after-change-functions + deactivate-mark + buffer-file-name ; Prevent primitives checking + buffer-file-truename) ; for file modification + (unwind-protect + (progn ,@body) + (and (not modified) + (buffer-modified-p) + (set-buffer-modified-p nil))))) + +(defmacro verilog-save-no-change-functions (&rest body) + "Execute BODY forms, disabling all change hooks in BODY. +For insigificant changes, see instead `verilog-save-buffer-state'." + `(let* ((inhibit-point-motion-hooks t) + before-change-functions + after-change-functions) + (progn ,@body))) -(defun verilog-inside-comment-p () - "Check if point inside a nested comment." +;; +;; Comment detection and caching + +(defvar verilog-scan-cache-preserving nil + "If set, the specified buffer's comment properties are static. +Buffer changes will be ignored. See `verilog-inside-comment-p' +and `verilog-scan'.") + +(defvar verilog-scan-cache-tick nil + "Modification tick at which `verilog-scan' was last completed.") +(make-variable-buffer-local 'verilog-scan-cache-tick) + +(defun verilog-scan-cache-ok-p () + "Return t iff the scan cache is up to date." + (or (and verilog-scan-cache-preserving + (eq verilog-scan-cache-preserving (current-buffer)) + verilog-scan-cache-tick) + (equal verilog-scan-cache-tick (buffer-chars-modified-tick)))) + +(defmacro verilog-save-scan-cache (&rest body) + "Execute the BODY forms, allowing scan cache preservation within BODY. +This requires that insertions must use `verilog-insert'." + ;; If the buffer is out of date, trash it, as we'll not check later the tick + ;; Note this must work properly if there's multiple layers of calls + ;; to verilog-save-scan-cache even with differing ticks. + `(progn + (unless (verilog-scan-cache-ok-p) ;; Must be before let + (setq verilog-scan-cache-tick nil)) + (let* ((verilog-scan-cache-preserving (current-buffer))) + (progn ,@body)))) + +(defun verilog-scan-region (beg end) + "Parse comments between BEG and END for `verilog-inside-comment-p'. +This creates v-cmt properties where comments are in force." + ;; Why properties and not overlays? Overlays have much slower non O(1) + ;; lookup times. + ;; This function is warm - called on every verilog-insert (save-excursion - (let ((st-point (point)) hitbeg) - (or (search-backward "//" (verilog-get-beg-of-line) t) - (if (progn - ;; This is for tricky case //*, we keep searching if /* - ;; is proceeded by // on same line. - (while - (and (setq hitbeg (search-backward "/*" nil t)) - (progn - (forward-char 1) - (search-backward "//" (verilog-get-beg-of-line) t)))) - hitbeg) - (not (search-forward "*/" st-point t))))))) + (save-match-data + (verilog-save-buffer-state + (let (pt) + (goto-char beg) + (while (< (point) end) + (cond ((looking-at "//") + (setq pt (point)) + (or (search-forward "\n" end t) + (goto-char end)) + ;; "1+": The leading // or /* itself isn't considered as + ;; being "inside" the comment, so that a (search-backward) + ;; that lands at the start of the // won't mis-indicate + ;; it's inside a comment + (put-text-property (1+ pt) (point) 'v-cmt t)) + ((looking-at "/\\*") + (setq pt (point)) + (or (search-forward "*/" end t) + ;; No error - let later code indicate it so we can + ;; use inside functions on-the-fly + ;;(error "%s: Unmatched /* */, at char %d" + ;; (verilog-point-text) (point)) + (goto-char end)) + (put-text-property (1+ pt) (point) 'v-cmt t)) + (t + (forward-char 1) + (if (re-search-forward "/[/*]" end t) + (backward-char 2) + (goto-char end)))))))))) + +(defun verilog-scan () + "Parse the buffer, marking all comments with properties. +Also assumes any text inserted since `verilog-scan-cache-tick' +either is ok to parse as a non-comment, or `verilog-insert' was used." + (unless (verilog-scan-cache-ok-p) + (save-excursion + (verilog-save-buffer-state + (when verilog-debug + (message "Scanning %s cache=%s cachetick=%S tick=%S" (current-buffer) + verilog-scan-cache-preserving verilog-scan-cache-tick + (buffer-chars-modified-tick))) + (remove-text-properties (point-min) (point-max) '(v-cmt nil)) + (verilog-scan-region (point-min) (point-max)) + (setq verilog-scan-cache-tick (buffer-chars-modified-tick)) + (when verilog-debug (message "Scaning... done")))))) + +(defun verilog-inside-comment-p () + "Check if point inside a comment. +This may require a slow pre-parse of the buffer with `verilog-scan' +to establish comment properties on all text." + ;; This function is very hot + (verilog-scan) + (get-text-property (point) 'v-cmt)) + +(defun verilog-insert (&rest stuff) + "Insert STUFF arguments, tracking comments for `verilog-inside-comment-p'. +Any insert that includes a comment must have the entire commente +inserted using a single call to `verilog-insert'." + (let ((pt (point))) + (while stuff + (insert (car stuff)) + (setq stuff (cdr stuff))) + (verilog-scan-region pt (point)))) + +;; More searching (defun verilog-declaration-end () (search-forward ";")) @@ -2738,7 +2973,7 @@ Use filename, if current buffer being edited shorten to just buffer name." ;; (defvar verilog-which-tool 1) ;;;###autoload -(defun verilog-mode () +(define-derived-mode verilog-mode prog-mode "Verilog" "Major mode for editing Verilog code. \\<verilog-mode-map> See \\[describe-function] verilog-auto (\\[verilog-auto]) for details on how @@ -2866,30 +3101,21 @@ All key bindings can be seen in a Verilog-buffer with \\[describe-bindings]. Key bindings specific to `verilog-mode-map' are: \\{verilog-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map verilog-mode-map) - (setq major-mode 'verilog-mode) - (setq mode-name "Verilog") - (setq local-abbrev-table verilog-mode-abbrev-table) + :abbrev-table verilog-mode-abbrev-table (set (make-local-variable 'beginning-of-defun-function) 'verilog-beg-of-defun) (set (make-local-variable 'end-of-defun-function) 'verilog-end-of-defun) (set-syntax-table verilog-mode-syntax-table) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'verilog-indent-line-relative) + (set (make-local-variable 'indent-line-function) + #'verilog-indent-line-relative) (setq comment-indent-function 'verilog-comment-indent) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments nil) - (make-local-variable 'comment-start) - (make-local-variable 'comment-end) - (make-local-variable 'comment-multi-line) - (make-local-variable 'comment-start-skip) - (setq comment-start "// " - comment-end "" - comment-start-skip "/\\*+ *\\|// *" - comment-multi-line nil) + (set (make-local-variable 'parse-sexp-ignore-comments) nil) + + (set (make-local-variable 'comment-start) "// ") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|// *") + (set (make-local-variable 'comment-multi-line) nil) ;; Set up for compilation (setq verilog-which-tool 1) (setq verilog-tool 'verilog-linter) @@ -2917,19 +3143,20 @@ Key bindings specific to `verilog-mode-map' are: nil 'verilog-beg-of-defun))) ;;------------------------------------------------------------ - ;; now hook in 'verilog-colorize-include-files (eldo-mode.el&spice-mode.el) + ;; now hook in 'verilog-highlight-include-files (eldo-mode.el&spice-mode.el) ;; all buffer local: - (when (featurep 'xemacs) - (make-local-hook 'font-lock-mode-hook) - (make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in Emacs - (make-local-hook 'after-change-functions)) - (add-hook 'font-lock-mode-hook 'verilog-colorize-include-files-buffer t t) - (add-hook 'font-lock-after-fontify-buffer-hook 'verilog-colorize-include-files-buffer t t) ; not in Emacs - (add-hook 'after-change-functions 'verilog-colorize-include-files t t) + (unless noninteractive ;; Else can't see the result, and change hooks are slow + (when (featurep 'xemacs) + (make-local-hook 'font-lock-mode-hook) + (make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in Emacs + (make-local-hook 'after-change-functions)) + (add-hook 'font-lock-mode-hook 'verilog-highlight-buffer t t) + (add-hook 'font-lock-after-fontify-buffer-hook 'verilog-highlight-buffer t t) ; not in Emacs + (add-hook 'after-change-functions 'verilog-highlight-region t t)) ;; Tell imenu how to handle Verilog. - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression verilog-imenu-generic-expression) + (set (make-local-variable 'imenu-generic-expression) + verilog-imenu-generic-expression) ;; Tell which-func-modes that imenu knows about verilog (when (boundp 'which-function-modes) (add-to-list 'which-func-modes 'verilog-mode)) @@ -2942,8 +3169,7 @@ Key bindings specific to `verilog-mode-map' are: hs-special-modes-alist)))) ;; Stuff for autos - (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local - (run-hooks 'verilog-mode-hook)) + (add-hook 'write-contents-hooks 'verilog-auto-save-check nil 'local)) ;; @@ -3355,34 +3581,53 @@ With ARG, first kill any existing labels." (interactive) ;; Move back token by token until we see the end ;; of some ealier line. - (while - ;; If the current point does not begin a new - ;; statement, as in the character ahead of us is a ';', or SOF - ;; or the string after us unambiguously starts a statement, - ;; or the token before us unambiguously ends a statement, - ;; then move back a token and test again. - (not (or - (bolp) - (= (preceding-char) ?\;) - (looking-at "\\w+\\W*:\\W*\\(coverpoint\\|cross\\|constraint\\)") - (not (or - (looking-at "\\<") - (forward-word -1))) - (and - (looking-at verilog-complete-reg) - (not (save-excursion - (verilog-backward-token) - (looking-at verilog-extended-complete-re)))) - (looking-at verilog-basic-complete-re) - (save-excursion - (verilog-backward-token) - (or - (looking-at verilog-end-block-re) - (looking-at verilog-preprocessor-re))))) + (let (h) + (while + ;; If the current point does not begin a new + ;; statement, as in the character ahead of us is a ';', or SOF + ;; or the string after us unambiguously starts a statement, + ;; or the token before us unambiguously ends a statement, + ;; then move back a token and test again. + (not (or + ;; stop if beginning of buffer + (bolp) + ;; stop if we find a ; + (= (preceding-char) ?\;) + ;; stop if we see a named coverpoint + (looking-at "\\w+\\W*:\\W*\\(coverpoint\\|cross\\|constraint\\)") + ;; keep going if we are in the middle of a word + (not (or (looking-at "\\<") (forward-word -1))) + ;; stop if we see an assertion (perhaps labled) + (and + (looking-at "\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)") + (progn + (setq h (point)) + (save-excursion + (verilog-backward-token) + (if (looking-at verilog-label-re) + (setq h (point)))) + (goto-char h))) + ;; stop if we see a complete reg, perhaps an extended one + (and + (looking-at verilog-complete-reg) + (let* ((p (point))) + (while (and (looking-at verilog-extended-complete-re) + (progn (setq p (point)) + (verilog-backward-token) + (/= p (point))))) + (goto-char p))) + ;; stop if we see a complete reg (previous found extended ones) + (looking-at verilog-basic-complete-re) + ;; stop if previous token is an ender + (save-excursion + (verilog-backward-token) + (or + (looking-at verilog-end-block-re) + (looking-at verilog-preprocessor-re))))) ;; end of test (verilog-backward-syntactic-ws) (verilog-backward-token)) - ;; Now point is where the previous line ended. - (verilog-forward-syntactic-ws)) + ;; Now point is where the previous line ended. + (verilog-forward-syntactic-ws))) (defun verilog-beg-of-statement-1 () "Move backward to beginning of statement." @@ -3395,7 +3640,10 @@ With ARG, first kill any existing labels." (setq pt (point)) (verilog-backward-syntactic-ws) (if (or (bolp) - (= (preceding-char) ?\;)) + (= (preceding-char) ?\;) + (save-excursion + (verilog-backward-token) + (looking-at verilog-ends-re))) (progn (goto-char pt) (throw 'done t)) @@ -3494,6 +3742,14 @@ More specifically, point @ in the line foo : @ begin" (t (throw 'found (= nest 0))))))) nil))) +(defun verilog-backward-up-list (arg) + "Like backward-up-list, but deal with comments." + (let (saved-psic parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments 1) + (backward-up-list arg) + (setq parse-sexp-ignore-comments saved-psic) + )) + (defun verilog-in-struct-region-p () "Return true if in a struct region. More specifically, in a list after a struct|union keyword." @@ -3502,7 +3758,7 @@ More specifically, in a list after a struct|union keyword." (let* ((state (verilog-syntax-ppss)) (depth (nth 0 state))) (if depth - (progn (backward-up-list depth) + (progn (verilog-backward-up-list depth) (verilog-beg-of-statement) (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>")))))) @@ -3628,7 +3884,8 @@ Limit search to point LIM." "\\(`endif\\>\\)\\|" "\\(`if\\>\\)\\|" "\\(`ifdef\\>\\)\\|" - "\\(`ifndef\\>\\)")) + "\\(`ifndef\\>\\)\\|" + "\\(`elsif\\>\\)")) (defun verilog-set-auto-endcomments (indent-str kill-existing-comment) "Add ending comment with given INDENT-STR. With KILL-EXISTING-COMMENT, remove what was there before. @@ -3645,7 +3902,7 @@ primitive or interface named NAME." (or kill-existing-comment (not (save-excursion (end-of-line) - (search-backward "//" (verilog-get-beg-of-line) t))))) + (search-backward "//" (point-at-bol) t))))) (let ((nest 1) b e m (else (if (match-end 2) "!" " "))) @@ -3668,7 +3925,12 @@ primitive or interface named NAME." ((match-end 4) ; `ifdef (setq nest (1- nest))) ((match-end 5) ; `ifndef - (setq nest (1- nest))))) + (setq nest (1- nest))) + ((match-end 6) ; `elsif + (if (= nest 1) + (progn + (setq else "!") + (setq nest 0)))))) (if (match-end 0) (setq m (buffer-substring @@ -3685,7 +3947,7 @@ primitive or interface named NAME." (if (> (count-lines (point) b) verilog-minimum-comment-distance) (insert (concat " // " else m " " (buffer-substring b e)))) (progn - (insert " // unmatched `else or `endif") + (insert " // unmatched `else, `elsif or `endif") (ding 't))))) (; Comment close case/class/function/task/module and named block @@ -3693,7 +3955,7 @@ primitive or interface named NAME." (or kill-existing-comment (not (save-excursion (end-of-line) - (search-backward "//" (verilog-get-beg-of-line) t))))) + (search-backward "//" (point-at-bol) t))))) (let ((type (car indent-str))) (unless (eq type 'declaration) (unless (looking-at (concat "\\(" verilog-end-block-ordered-re "\\)[ \t]*:")) ;; ignore named ends @@ -3764,8 +4026,8 @@ primitive or interface named NAME." (cond (; (eq here (progn - (verilog-backward-token) - (verilog-beg-of-statement-1) + ;; (verilog-backward-token) + (verilog-beg-of-statement) (point))) (setq err nil) (setq str "")) @@ -3789,7 +4051,7 @@ primitive or interface named NAME." (;- else (match-end 2) (let ((nest 0) - ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")) + ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)")) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -3805,13 +4067,21 @@ primitive or interface named NAME." (setq err nil) (setq str (verilog-get-expr)) (setq str (concat " // else: !if" str )) + (throw 'skip 1)))) + ((match-end 4) + (if (= 0 nest) + (progn + (goto-char (match-end 0)) + (setq there (point)) + (setq err nil) + (setq str (verilog-get-expr)) + (setq str (concat " // else: !assert " str )) (throw 'skip 1))))))))) - (;- end else (match-end 3) (goto-char there) (let ((nest 0) - (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")) + (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)")) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -3827,7 +4097,17 @@ primitive or interface named NAME." (setq err nil) (setq str (verilog-get-expr)) (setq str (concat " // else: !if" str )) + (throw 'skip 1)))) + ((match-end 4) + (if (= 0 nest) + (progn + (goto-char (match-end 0)) + (setq there (point)) + (setq err nil) + (setq str (verilog-get-expr)) + (setq str (concat " // else: !assert " str )) (throw 'skip 1))))))))) + (; always_comb, always_ff, always_latch (or (match-end 4) (match-end 5) (match-end 6)) (goto-char (match-end 0)) @@ -3960,6 +4240,10 @@ primitive or interface named NAME." (setq b (progn (skip-chars-forward "^ \t") (verilog-forward-ws&directives) + (if (looking-at "static\\|automatic") + (progn + (goto-char (match-end 0)) + (verilog-forward-ws&directives))) (if (and name-re (verilog-re-search-forward name-re nil 'move)) (progn (goto-char (match-beginning 0)) @@ -4205,7 +4489,7 @@ becomes: (cond ((looking-at "// surefire lint_off_line ") (goto-char (match-end 0)) - (let ((lim (save-excursion (end-of-line) (point)))) + (let ((lim (point-at-eol))) (if (re-search-forward code lim 'move) (throw 'already t) (insert (concat " " code))))) @@ -4243,6 +4527,30 @@ becomes: (save-buffer) (compile compile-command)) +(defun verilog-preprocess (&optional command filename) + "Preprocess the buffer, similar to `compile', but leave output in Verilog-Mode. +Takes optional COMMAND or defaults to `verilog-preprocessor', and +FILENAME or defaults to `buffer-file-name`." + (interactive + (list + (let ((default (verilog-expand-command verilog-preprocessor))) + (set (make-local-variable `verilog-preprocessor) + (read-from-minibuffer "Run Preprocessor (like this): " + default nil nil + 'verilog-preprocess-history default))))) + (unless command (setq command (verilog-expand-command verilog-preprocessor))) + (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*" + (with-current-buffer (get-buffer "*Verilog-Preprocessed*") + (insert (concat "// " cmd "\n")) + (shell-command cmd "*Verilog-Preprocessed*") + (verilog-mode) + ;; Without this force, it takes a few idle seconds + ;; to get the color, which is very jarring + (when fontlocked (font-lock-fontify-buffer)))))) ;; @@ -4385,7 +4693,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ;; if we have a directive, done. (if (save-excursion (beginning-of-line) (and (looking-at verilog-directive-re-1) - (not (or (looking-at "[ \t]*`ovm_") + (not (or (looking-at "[ \t]*`ovm_") (looking-at "[ \t]*`vmm_"))))) (throw 'nesting 'directive)) ;; indent structs as if there were module level @@ -4449,8 +4757,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ((match-end 3) ; assert block (setq elsec (1- elsec)) (verilog-beg-of-statement) ;; doesn't get to beginning - (if (looking-at (concat "\\(" verilog-label-re "\\)?" - "\\(assert\\|assume\\|cover\\)\\s-+property\\>")) + (if (looking-at verilog-property-re) (throw 'nesting 'statement) ; We don't need an endproperty for these (throw 'nesting 'block) ;We still need a endproperty )) @@ -4584,6 +4891,13 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (goto-char here) (throw 'nesting 'block))))) + ((match-end 27) ; *sigh* might be a clocking declaration + (let ((here (point))) + (if (verilog-in-paren) + t ; this is a normal statement + (progn ; or is fork, starts a new block + (goto-char here) + (throw 'nesting 'block))))) ;; need to consider typedef struct here... ((looking-at "\\<class\\|struct\\|function\\|task\\>") @@ -4607,8 +4921,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ; but ; property ID () ... needs end_property (verilog-beg-of-statement) - (if (looking-at (concat "\\(" verilog-label-re "\\)?" - "\\(assert\\|assume\\|cover\\)\\s-+property\\>")) + (if (looking-at verilog-property-re) (throw 'continue 'statement) ; We don't need an endproperty for these (throw 'nesting 'block) ;We still need a endproperty )) @@ -4857,7 +5170,7 @@ Set point to where line starts." (= (preceding-char) ?\)) (progn (backward-char) - (backward-up-list 1) + (verilog-backward-up-list 1) (verilog-backward-syntactic-ws) (let ((back (point))) (forward-word -1) @@ -4981,14 +5294,19 @@ Optional BOUND limits search." (let ((state (save-excursion (verilog-syntax-ppss)))) (cond ((nth 7 state) ;; in // comment - (verilog-re-search-forward "//" nil 'move)) + (end-of-line) + (forward-char 1) + (skip-chars-forward " \t\n\f") + ) ((nth 4 state) ;; in /* */ comment - (verilog-re-search-forward "/\*" nil 'move)))) + (verilog-re-search-forward "\*\/\\s-*" nil 'move)))) (narrow-to-region (point) bound) (while (/= here (point)) (setq here (point) jump nil) (forward-comment (buffer-size)) + (and (looking-at "\\s-*(\\*.*\\*)\\s-*") ;; Attribute + (goto-char (match-end 0))) (save-excursion (beginning-of-line) (if (looking-at verilog-directive-re-1) @@ -5020,6 +5338,12 @@ Optional BOUND limits search." (let ((state (save-excursion (verilog-syntax-ppss)))) (or (nth 3 state) (nth 4 state) (nth 7 state)))) ; Inside string or comment) +(defun verilog-in-attribute-p () + "Return true if point is in an attribute (* [] attribute *)." + (save-excursion + (verilog-re-search-backward "\\((\\*\\)\\|\\(\\*)\\)" nil 'move) + (numberp (match-beginning 1)))) + (defun verilog-in-escaped-name-p () "Return true if in an escaped name." (save-excursion @@ -5029,7 +5353,7 @@ Optional BOUND limits search." t nil))) (defun verilog-in-directive-p () - "Return true if in a star or // comment." + "Return true if in a directive." (save-excursion (beginning-of-line) (looking-at verilog-directive-re-1))) @@ -5045,7 +5369,7 @@ Optional BOUND limits search." (save-excursion (if (verilog-in-paren) (progn - (backward-up-list 1) + (verilog-backward-up-list 1) (verilog-at-struct-p) ) nil))) @@ -5056,7 +5380,7 @@ Optional BOUND limits search." (save-excursion (if (verilog-in-paren) (progn - (backward-up-list 1) + (verilog-backward-up-list 1) (verilog-at-constraint-p) ) nil))) @@ -5147,30 +5471,70 @@ Optional BOUND limits search." (search-backward "/*") (skip-chars-backward " \t\n\f") t) - ((if (and (not (bobp)) - (= (char-before) ?\/) - (= (char-before (1- (point))) ?\*)) - (goto-char (- (point) 2)) - (/= (skip-chars-backward " \t\n\f") 0))))))))) + ((and (not (bobp)) + (= (char-before) ?\/) + (= (char-before (1- (point))) ?\*)) + (goto-char (- (point) 2)) + t) ;; Let nth 4 state handle the rest + ((and (not (bobp)) + (= (char-before) ?\)) + (= (char-before (1- (point))) ?\*)) + (goto-char (- (point) 2)) + (if (search-backward "(*" nil t) + (progn + (skip-chars-backward " \t\n\f") + t) + (progn + (goto-char (+ (point) 2)) + nil))) + (t + (/= (skip-chars-backward " \t\n\f") 0)))))))) (defun verilog-skip-forward-comment-p () "If in comment, move to end and return true." - (let (state) - (progn - (setq state (save-excursion (verilog-syntax-ppss))) - (cond - ((nth 3 state) ;Inside string - t) - ((nth 7 state) ;Inside // comment - (end-of-line) - (forward-char 1) - t) - ((nth 4 state) ;Inside any comment - (search-forward "*/") - (skip-chars-forward " \t\n\f") - t) - (t - (skip-chars-forward " \t\n\f")))))) + (let* (h + (state (save-excursion (verilog-syntax-ppss))) + (skip (cond + ((nth 3 state) ;Inside string + t) + ((nth 7 state) ;Inside // comment + (end-of-line) + (forward-char 1) + t) + ((nth 4 state) ;Inside /* comment + (search-forward "*/") + t) + ((verilog-in-attribute-p) ;Inside (* attribute + (search-forward "*)" nil t) + t) + (t nil)))) + (skip-chars-forward " \t\n\f") + (while + (cond + ((looking-at "\\/\\*") + (progn + (setq h (point)) + (goto-char (match-end 0)) + (if (search-forward "*/" nil t) + (progn + (skip-chars-forward " \t\n\f") + (setq skip 't)) + (progn + (goto-char h) + nil)))) + ((looking-at "(\\*") + (progn + (setq h (point)) + (goto-char (match-end 0)) + (if (search-forward "*)" nil t) + (progn + (skip-chars-forward " \t\n\f") + (setq skip 't)) + (progn + (goto-char h) + nil)))) + (t nil))) + skip)) (defun verilog-indent-line-relative () "Cheap version of indent line. @@ -5237,7 +5601,7 @@ Only look at a few lines to determine indent level." ((= (following-char) ?\[) (progn (forward-char 1) - (backward-up-list -1) + (verilog-backward-up-list -1) (skip-chars-forward " \t")))) (current-column)) (progn @@ -5262,13 +5626,24 @@ Only look at a few lines to determine indent level." (; handle inside parenthetical expressions (eq type 'cparenexp) - (let ((val (save-excursion - (backward-up-list 1) - (forward-char 1) - (skip-chars-forward " \t") - (current-column)))) - (indent-line-to val) - )) + (let* ( here + (val (save-excursion + (verilog-backward-up-list 1) + (forward-char 1) + (if verilog-indent-lists + (skip-chars-forward " \t") + (verilog-forward-syntactic-ws)) + (setq here (point)) + (current-column))) + + (decl (save-excursion + (goto-char here) + (verilog-forward-syntactic-ws) + (setq here (point)) + (looking-at verilog-declaration-re)))) + (indent-line-to val) + (if decl + (verilog-pretty-declarations)))) (;-- Handle the ends (or @@ -5419,16 +5794,16 @@ Be verbose about progress unless optional QUIET set." (if (progn ; (verilog-beg-of-statement-1) (beginning-of-line) - (verilog-forward-syntactic-ws) + (verilog-forward-syntactic-ws) (and (not (verilog-in-directive-p)) ;; could have `define input foo (looking-at verilog-declaration-re))) (progn - (if (verilog-parenthesis-depth) - ;; in an argument list or parameter block - (setq el (backward-up-list -1) + (if (verilog-parenthesis-depth) + ;; in an argument list or parameter block + (setq el (verilog-backward-up-list -1) start (progn (goto-char e) - (backward-up-list 1) + (verilog-backward-up-list 1) (forward-line) ;; ignore ( input foo, (verilog-re-search-forward verilog-declaration-re el 'move) (goto-char (match-beginning 0)) @@ -5437,19 +5812,19 @@ Be verbose about progress unless optional QUIET set." startpos (set-marker (make-marker) start) end (progn (goto-char start) - (backward-up-list -1) + (verilog-backward-up-list -1) (forward-char -1) (verilog-backward-syntactic-ws) (point)) endpos (set-marker (make-marker) end) base-ind (progn (goto-char start) - (verilog-do-indent (verilog-calculate-indent)) - (verilog-forward-ws&directives) - (current-column)) + (forward-char 1) + (skip-chars-forward " \t") + (current-column)) ) ;; in a declaration block (not in argument list) - (setq + (setq start (progn (verilog-beg-of-statement-1) (while (and (looking-at verilog-declaration-re) @@ -5468,7 +5843,6 @@ Be verbose about progress unless optional QUIET set." (setq e (point)) ;Might be on last line (verilog-forward-syntactic-ws) (while (looking-at verilog-declaration-re) - ;;(beginning-of-line) (verilog-end-of-statement) (setq e (point)) (verilog-forward-syntactic-ws)) @@ -5488,7 +5862,7 @@ Be verbose about progress unless optional QUIET set." (while (progn (setq e (marker-position endpos)) (< (point) e)) (cond - ((save-excursion (skip-chars-backward " \t") + ((save-excursion (skip-chars-backward " \t") (bolp)) (verilog-forward-ws&directives) (indent-line-to base-ind) @@ -5509,7 +5883,7 @@ Be verbose about progress unless optional QUIET set." (> r 0)) (setq e (point)) (unless quiet (message "%d" r)) - (verilog-indent-line) + ;;(verilog-do-indent (verilog-calculate-indent))) (verilog-forward-ws&directives) (cond ((or (and verilog-indent-declaration-macros @@ -5543,12 +5917,12 @@ Be verbose about progress unless optional QUIET set." (defun verilog-pretty-expr (&optional quiet myre) "Line up expressions around point, optionally QUIET with regexp MYRE." - (interactive "sRegular Expression: ((<|:)?=) ") + (interactive "i\nsRegular Expression: ((<|:)?=) ") (save-excursion (if (or (eq myre nil) (string-equal myre "")) (setq myre "\\(<\\|:\\)?=")) - ;; want to match the first <= | := | = + ;; want to match the first <= | := | = (setq myre (concat "\\(^.*?\\)\\(" myre "\\)")) (let ((rexp(concat "^\\s-*" verilog-complete-reg))) (beginning-of-line) @@ -5873,6 +6247,39 @@ will be completed at runtime and should not be added to this list.") Variables and function names defined within the Verilog program will be completed at runtime and should not be added to this list.") +(defvar verilog-gate-ios + ;; All these have an implied {"input"...} at the end + '(("and" "output") + ("buf" "output") + ("bufif0" "output") + ("bufif1" "output") + ("cmos" "output") + ("nand" "output") + ("nmos" "output") + ("nor" "output") + ("not" "output") + ("notif0" "output") + ("notif1" "output") + ("or" "output") + ("pmos" "output") + ("pulldown" "output") + ("pullup" "output") + ("rcmos" "output") + ("rnmos" "output") + ("rpmos" "output") + ("rtran" "inout" "inout") + ("rtranif0" "inout" "inout") + ("rtranif1" "inout" "inout") + ("tran" "inout" "inout") + ("tranif0" "inout" "inout") + ("tranif1" "inout" "inout") + ("xnor" "output") + ("xor" "output")) + "*Map of direction for each positional argument to each gate primitive.") + +(defvar verilog-gate-keywords (mapcar `car verilog-gate-ios) + "*Keywords for gate primitives.") + (defun verilog-string-diff (str1 str2) "Return index of first letter where STR1 and STR2 differs." (catch 'done @@ -6203,7 +6610,7 @@ VERILOG-STR is an exact match, nil otherwise." (verilog-completion-response)))) (defun verilog-goto-defun () - "Move to specified Verilog module/task/function. + "Move to specified Verilog module/interface/task/function. The default is a name found in the buffer around point. If search fails, other files are checked based on `verilog-library-flags'." @@ -6447,6 +6854,8 @@ See also `verilog-sk-header' for an alternative format." ;; ;; Elements of a signal list +(defsubst verilog-sig-new (name bits comment mem enum signed type multidim modport) + (list name bits comment mem enum signed type multidim modport)) (defsubst verilog-sig-name (sig) (car sig)) (defsubst verilog-sig-bits (sig) @@ -6475,37 +6884,96 @@ See also `verilog-sk-header' for an alternative format." (defsubst verilog-sig-width (sig) (verilog-make-width-expression (verilog-sig-bits sig))) -(defsubst verilog-alw-get-inputs (sigs) - (nth 2 sigs)) +(defsubst verilog-alw-new (outputs temps inputs delayed) + (list outputs temps inputs delayed)) (defsubst verilog-alw-get-outputs (sigs) (nth 0 sigs)) +(defsubst verilog-alw-get-temps (sigs) + (nth 1 sigs)) +(defsubst verilog-alw-get-inputs (sigs) + (nth 2 sigs)) (defsubst verilog-alw-get-uses-delayed (sigs) (nth 3 sigs)) +(defsubst verilog-modi-new (name fob pt type) + (vector name fob pt type)) +(defsubst verilog-modi-name (modi) + (aref modi 0)) +(defsubst verilog-modi-file-or-buffer (modi) + (aref modi 1)) +(defsubst verilog-modi-get-point (modi) + (aref modi 2)) +(defsubst verilog-modi-get-type (modi) ;; "module" or "interface" + (aref modi 3)) +(defsubst verilog-modi-get-decls (modi) + (verilog-modi-cache-results modi 'verilog-read-decls)) +(defsubst verilog-modi-get-sub-decls (modi) + (verilog-modi-cache-results modi 'verilog-read-sub-decls)) + +;; Signal reading for given module +;; Note these all take modi's - as returned from verilog-modi-current +(defsubst verilog-decls-new (out inout in wires regs assigns consts gparams interfaces) + (vector out inout in wires regs assigns consts gparams interfaces)) +(defsubst verilog-decls-get-outputs (decls) + (aref decls 0)) +(defsubst verilog-decls-get-inouts (decls) + (aref decls 1)) +(defsubst verilog-decls-get-inputs (decls) + (aref decls 2)) +(defsubst verilog-decls-get-wires (decls) + (aref decls 3)) +(defsubst verilog-decls-get-regs (decls) + (aref decls 4)) +(defsubst verilog-decls-get-assigns (decls) + (aref decls 5)) +(defsubst verilog-decls-get-consts (decls) + (aref decls 6)) +(defsubst verilog-decls-get-gparams (decls) + (aref decls 7)) +(defsubst verilog-decls-get-interfaces (decls) + (aref decls 8)) + +(defsubst verilog-subdecls-new (out inout in intf intfd) + (vector out inout in intf intfd)) +(defsubst verilog-subdecls-get-outputs (subdecls) + (aref subdecls 0)) +(defsubst verilog-subdecls-get-inouts (subdecls) + (aref subdecls 1)) +(defsubst verilog-subdecls-get-inputs (subdecls) + (aref subdecls 2)) +(defsubst verilog-subdecls-get-interfaces (subdecls) + (aref subdecls 3)) +(defsubst verilog-subdecls-get-interfaced (subdecls) + (aref subdecls 4)) + (defun verilog-signals-not-in (in-list not-list) "Return list of signals in IN-LIST that aren't also in NOT-LIST. Also remove any duplicates in IN-LIST. Signals must be in standard (base vector) form." - (let (out-list) - (while in-list - (if (not (or (assoc (car (car in-list)) not-list) - (assoc (car (car in-list)) out-list))) - (setq out-list (cons (car in-list) out-list))) - (setq in-list (cdr in-list))) - (nreverse out-list))) + ;; This function is hot, so implemented as O(1) + (cond ((eval-when-compile (fboundp 'make-hash-table)) + (let ((ht (make-hash-table :test 'equal :rehash-size 4.0)) + out-list) + (while not-list + (puthash (car (car not-list)) t ht) + (setq not-list (cdr not-list))) + (while in-list + (when (not (gethash (car (car in-list)) ht)) + (setq out-list (cons (car in-list) out-list)) + (puthash (car (car in-list)) t ht)) + (setq in-list (cdr in-list))) + (nreverse out-list))) + ;; Slower Fallback if no hash tables (pre Emacs 21.1/XEmacs 21.4) + (t + (let (out-list) + (while in-list + (if (not (or (assoc (car (car in-list)) not-list) + (assoc (car (car in-list)) out-list))) + (setq out-list (cons (car in-list) out-list))) + (setq in-list (cdr in-list))) + (nreverse out-list))))) ;;(verilog-signals-not-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("EXT" ""))) -(defun verilog-signals-in (in-list other-list) - "Return list of signals in IN-LIST that are also in OTHER-LIST. -Signals must be in standard (base vector) form." - (let (out-list) - (while in-list - (if (assoc (car (car in-list)) other-list) - (setq out-list (cons (car in-list) out-list))) - (setq in-list (cdr in-list))) - (nreverse out-list))) -;;(verilog-signals-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("EXT" ""))) - (defun verilog-signals-memory (in-list) "Return list of signals in IN-LIST that are memoried (multidimensional)." (let (out-list) @@ -6599,15 +7067,15 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." ;; Note sig may also be nil for the last signal in the list (t (setq out-list - (cons - (list sv-name + (cons (verilog-sig-new + sv-name (or sv-busstring (if sv-highbit (concat "[" (int-to-string sv-highbit) ":" (int-to-string sv-lowbit) "]"))) (concat sv-comment combo buswarn) sv-memory sv-enum sv-signed sv-type sv-multidim sv-modport) - out-list) + out-list) sv-name nil)))) ;; out-list)) @@ -6645,20 +7113,26 @@ Ignore width if optional NO-WIDTH is set." (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|\\]\\)" nil nil)) (skip-chars-backward "a-zA-Z0-9`_$")) +(defun verilog-read-inst-module-matcher () + "Set match data 0 with module_name when point is inside instantiation." + (verilog-read-inst-backward-name) + ;; Skip over instantiation name + (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|)\\)" nil nil) ; ) isn't word boundary + ;; Check for parameterized instantiations + (when (looking-at ")") + (verilog-backward-open-paren) + (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil)) + (skip-chars-backward "a-zA-Z0-9'_$") + (looking-at "[a-zA-Z0-9`_\$]+") + ;; Important: don't use match string, this must work with Emacs 19 font-lock on + (buffer-substring-no-properties (match-beginning 0) (match-end 0)) + ;; Caller assumes match-beginning/match-end is still set + ) + (defun verilog-read-inst-module () "Return module_name when point is inside instantiation." (save-excursion - (verilog-read-inst-backward-name) - ;; Skip over instantiation name - (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|)\\)" nil nil) ; ) isn't word boundary - ;; Check for parameterized instantiations - (when (looking-at ")") - (verilog-backward-open-paren) - (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil)) - (skip-chars-backward "a-zA-Z0-9'_$") - (looking-at "[a-zA-Z0-9`_\$]+") - ;; Important: don't use match string, this must work with Emacs 19 font-lock on - (buffer-substring-no-properties (match-beginning 0) (match-end 0)))) + (verilog-read-inst-module-matcher))) (defun verilog-read-inst-name () "Return instance_name when point is inside instantiation." @@ -6730,6 +7204,7 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." Return a array of [outputs inouts inputs wire reg assign const]." (let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max))) (functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t) + in-modport sigs-in sigs-out sigs-inout sigs-wire sigs-reg sigs-assign sigs-const sigs-gparam sigs-intf vec expect-signal keywd newsig rvalue enum io signed typedefed multidim @@ -6738,7 +7213,7 @@ Return a array of [outputs inouts inputs wire reg assign const]." (verilog-beg-of-defun) (setq sigs-const (verilog-read-auto-constants (point) end-mod-point)) (while (< (point) end-mod-point) - ;;(if dbg (setq dbg (cons (format "Pt %s Vec %s Kwd'%s'\n" (point) vec keywd) dbg))) + ;;(if dbg (setq dbg (concat dbg (format "Pt %s Vec %s C%c Kwd'%s'\n" (point) vec (following-char) keywd)))) (cond ((looking-at "//") (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") @@ -6746,7 +7221,7 @@ Return a array of [outputs inouts inputs wire reg assign const]." (search-forward "\n")) ((looking-at "/\\*") (forward-char 2) - (if (looking-at "[^*]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") + (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") (setq enum (match-string 1))) (or (search-forward "*/") (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point)))) @@ -6760,7 +7235,7 @@ Return a array of [outputs inouts inputs wire reg assign const]." (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point)))) ((eq ?\; (following-char)) (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil - v2kargs-ok nil) + v2kargs-ok nil in-modport nil) (forward-char 1)) ((eq ?= (following-char)) (setq rvalue t newsig nil) @@ -6781,7 +7256,10 @@ Return a array of [outputs inouts inputs wire reg assign const]." ((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 @@ -6818,7 +7296,9 @@ Return a array of [outputs inouts inputs wire reg assign const]." expect-signal 'sigs-wire modport nil))) ((member keywd '("reg" "trireg" "byte" "shortint" "int" "longint" "integer" "time" - "bit" "logic")) + "bit" "logic" + "shortreal" "real" "realtime" + "string" "event" "chandle")) (unless io (setq vec nil enum nil rvalue nil signed nil typedefed nil multidim nil sig-paren paren expect-signal 'sigs-reg modport nil))) ((equal keywd "assign") @@ -6836,8 +7316,10 @@ Return a array of [outputs inouts inputs wire reg assign const]." ((member keywd '("endclass" "endclocking" "endgroup" "endfunction" "endproperty" "endsequence" "endtask")) (setq functask (1- functask))) + ((equal keywd "modport") + (setq in-modport t)) ;; Ifdef? Ignore name of define - ((member keywd '("`ifdef" "`ifndef")) + ((member keywd '("`ifdef" "`ifndef" "`elsif")) (setq rvalue t)) ;; Type? ((verilog-typedef-name-p keywd) @@ -6846,32 +7328,45 @@ Return a array of [outputs inouts inputs wire reg assign const]." ;; Skip over parsing modport, and take the interface name as the type ((and v2kargs-ok (eq paren 1) - (looking-at "\\s-*\\(\\.\\(\\s-*[a-zA-Z0-9`_$]+\\)\\|\\)\\s-*[a-zA-Z0-9`_$]+")) + (not rvalue) + (looking-at "\\s-*\\(\\.\\(\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*\\)\\|\\)\\s-*[a-zA-Z`_$][a-zA-Z0-9`_$]*")) (when (match-end 2) (goto-char (match-end 2))) (setq vec nil enum nil rvalue nil newsig nil signed nil typedefed keywd multidim nil sig-paren paren expect-signal 'sigs-intf io t modport (match-string 2))) + ;; Ignore dotted LHS assignments: "assign foo.bar = z;" + ((looking-at "\\s-*\\.") + (goto-char (match-end 0)) + (when (not rvalue) + (setq expect-signal nil))) ;; New signal, maybe? ((and expect-signal - (eq functask 0) (not rvalue) + (eq functask 0) + (not in-modport) (not (member keywd verilog-keywords))) ;; Add new signal to expect-signal's variable - (setq newsig (list keywd vec nil nil enum signed typedefed multidim modport)) + (setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport)) (set expect-signal (cons newsig (symbol-value expect-signal)))))) (t (forward-char 1))) (skip-syntax-forward " ")) ;; Return arguments - (vector (nreverse sigs-out) - (nreverse sigs-inout) - (nreverse sigs-in) - (nreverse sigs-wire) - (nreverse sigs-reg) - (nreverse sigs-assign) - (nreverse sigs-const) - (nreverse sigs-gparam) - (nreverse sigs-intf))))) + (verilog-decls-new (nreverse sigs-out) + (nreverse sigs-inout) + (nreverse sigs-in) + (nreverse sigs-wire) + (nreverse sigs-reg) + (nreverse sigs-assign) + (nreverse sigs-const) + (nreverse sigs-gparam) + (nreverse sigs-intf))))) + +(defvar verilog-read-sub-decls-in-interfaced nil + "For `verilog-read-sub-decls', process next signal as under interfaced block.") + +(defvar verilog-read-sub-decls-gate-ios nil + "For `verilog-read-sub-decls', gate IO pins remaining, nil if non-primitive.") (eval-when-compile ;; Prevent compile warnings; these are let's, not globals @@ -6880,82 +7375,87 @@ Return a array of [outputs inouts inputs wire reg assign const]." (defvar sigs-in) (defvar sigs-inout) (defvar sigs-out) - (defvar sigs-intf)) - - -(defsubst verilog-modi-get-decls (modi) - (verilog-modi-cache-results modi 'verilog-read-decls)) - -(defsubst verilog-modi-get-sub-decls (modi) - (verilog-modi-cache-results modi 'verilog-read-sub-decls)) - - -;; Signal reading for given module -;; Note these all take modi's - as returned from the -;; verilog-modi-current function. -(defsubst verilog-decls-get-outputs (decls) - (aref decls 0)) -(defsubst verilog-decls-get-inouts (decls) - (aref decls 1)) -(defsubst verilog-decls-get-inputs (decls) - (aref decls 2)) -(defsubst verilog-decls-get-wires (decls) - (aref decls 3)) -(defsubst verilog-decls-get-regs (decls) - (aref decls 4)) -(defsubst verilog-decls-get-assigns (decls) - (aref decls 5)) -(defsubst verilog-decls-get-consts (decls) - (aref decls 6)) -(defsubst verilog-decls-get-gparams (decls) - (aref decls 7)) -(defsubst verilog-decls-get-interfaces (decls) - (aref decls 8)) -(defsubst verilog-subdecls-get-outputs (subdecls) - (aref subdecls 0)) -(defsubst verilog-subdecls-get-inouts (subdecls) - (aref subdecls 1)) -(defsubst verilog-subdecls-get-inputs (subdecls) - (aref subdecls 2)) -(defsubst verilog-subdecls-get-interfaces (subdecls) - (aref subdecls 3)) - + (defvar sigs-intf) + (defvar sigs-intfd)) (defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim) "For `verilog-read-sub-decls-line', add a signal." - (let (portdata) + ;; sig eq t to indicate .name syntax + ;;(message "vrsds: %s(%S)" port sig) + (let ((dotname (eq sig t)) + portdata) (when sig (setq port (verilog-symbol-detick-denumber port)) - (setq sig (verilog-symbol-detick-denumber sig)) - (if sig (setq sig (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil sig))) + (setq sig (if dotname port (verilog-symbol-detick-denumber sig))) (if vec (setq vec (verilog-symbol-detick-denumber vec))) (if multidim (setq multidim (mapcar `verilog-symbol-detick-denumber multidim))) (unless (or (not sig) (equal sig "")) ;; Ignore .foo(1'b1) assignments - (cond ((setq portdata (assoc port (verilog-decls-get-inouts submoddecls))) - (setq sigs-inout (cons (list sig vec (concat "To/From " comment) nil nil - (verilog-sig-signed portdata) - (verilog-sig-type portdata) - multidim) - sigs-inout))) - ((setq portdata (assoc port (verilog-decls-get-outputs submoddecls))) - (setq sigs-out (cons (list sig vec (concat "From " comment) nil nil - (verilog-sig-signed portdata) - (verilog-sig-type portdata) - multidim) - sigs-out))) - ((setq portdata (assoc port (verilog-decls-get-inputs submoddecls))) - (setq sigs-in (cons (list sig vec (concat "To " comment) nil nil - (verilog-sig-signed portdata) - (verilog-sig-type portdata) - multidim) - sigs-in))) + (cond ((or (setq portdata (assoc port (verilog-decls-get-inouts submoddecls))) + (equal "inout" verilog-read-sub-decls-gate-ios)) + (setq sigs-inout + (cons (verilog-sig-new + sig + (if dotname (verilog-sig-bits portdata) vec) + (concat "To/From " comment) + (verilog-sig-memory portdata) + nil + (verilog-sig-signed portdata) + (verilog-sig-type portdata) + multidim nil) + sigs-inout))) + ((or (setq portdata (assoc port (verilog-decls-get-outputs submoddecls))) + (equal "output" verilog-read-sub-decls-gate-ios)) + (setq sigs-out + (cons (verilog-sig-new + sig + (if dotname (verilog-sig-bits portdata) vec) + (concat "From " comment) + (verilog-sig-memory portdata) + nil + (verilog-sig-signed portdata) + (verilog-sig-type portdata) + multidim nil) + sigs-out))) + ((or (setq portdata (assoc port (verilog-decls-get-inputs submoddecls))) + (equal "input" verilog-read-sub-decls-gate-ios)) + (setq sigs-in + (cons (verilog-sig-new + sig + (if dotname (verilog-sig-bits portdata) vec) + (concat "To " comment) + (verilog-sig-memory portdata) + nil + (verilog-sig-signed portdata) + (verilog-sig-type portdata) + multidim nil) + sigs-in))) ((setq portdata (assoc port (verilog-decls-get-interfaces submoddecls))) - (setq sigs-intf (cons (list sig vec (concat "To/From " comment) nil nil - (verilog-sig-signed portdata) - (verilog-sig-type portdata) - multidim) - sigs-intf))) + (setq sigs-intf + (cons (verilog-sig-new + sig + (if dotname (verilog-sig-bits portdata) vec) + (concat "To/From " comment) + (verilog-sig-memory portdata) + nil + (verilog-sig-signed portdata) + (verilog-sig-type portdata) + multidim nil) + sigs-intf))) + ((setq portdata (and verilog-read-sub-decls-in-interfaced + (or (assoc port (verilog-decls-get-regs submoddecls)) + (assoc port (verilog-decls-get-wires submoddecls))))) + (setq sigs-intfd + (cons (verilog-sig-new + sig + (if dotname (verilog-sig-bits portdata) vec) + (concat "To/From " comment) + (verilog-sig-memory portdata) + nil + (verilog-sig-signed portdata) + (verilog-sig-type portdata) + multidim nil) + sigs-intf))) ;; (t -- warning pin isn't defined.) ; Leave for lint tool ))))) @@ -6969,21 +7469,25 @@ Return a array of [outputs inouts inputs wire reg assign const]." ;; (cond ;; {..., a, b} requires us to recurse on a,b - ((string-match "^\\s-*{\\([^{}]*\\)}\\s-*$" expr) + ;; To support {#{},{#{a,b}} we'll just split everything on [{},] + ((string-match "^\\s-*{\\(.*\\)}\\s-*$" expr) (unless verilog-auto-ignore-concat - (let ((mlst (split-string (match-string 1 expr) ",")) + (let ((mlst (split-string (match-string 1 expr) "[{},]")) mstr) (while (setq mstr (pop mlst)) (verilog-read-sub-decls-expr submoddecls comment port mstr))))) (t (let (sig vec multidim) + ;; Remove leading reduction operators, etc + (setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil expr)) + ;;(message "vrsde-ptop: '%s'" expr) (cond ;; Find \signal. Final space is part of escaped signal name ((string-match "^\\s-*\\(\\\\[^ \t\n\f]+\\s-\\)" expr) ;;(message "vrsde-s: '%s'" (match-string 1 expr)) (setq sig (match-string 1 expr) expr (substring expr (match-end 0)))) ;; Find signal - ((string-match "^\\s-*\\([^[({).\\]+\\)" expr) + ((string-match "^\\s-*\\([a-zA-Z_][a-zA-Z_0-9]*\\)" expr) ;;(message "vrsde-s: '%s'" (match-string 1 expr)) (setq sig (verilog-string-remove-spaces (match-string 1 expr)) expr (substring expr (match-end 0))))) @@ -6999,8 +7503,8 @@ Return a array of [outputs inouts inputs wire reg assign const]." (verilog-read-sub-decls-sig submoddecls comment port sig vec multidim)))))) (defun verilog-read-sub-decls-line (submoddecls comment) - "For `verilog-read-sub-decls', read lines of port defs until none match anymore. -Return the list of signals found, using submodi to look up each port." + "For `verilog-read-sub-decls', read lines of port defs until none match. +Inserts the list of signals found, using submodi to look up each port." (let (done port) (save-excursion (forward-line 1) @@ -7009,9 +7513,23 @@ Return the list of signals found, using submodi to look up each port." (cond ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*(\\s-*") (setq port (match-string 1)) (goto-char (match-end 0))) + ;; .\escaped ( ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*(\\s-*") (setq port (concat (match-string 1) " ")) ;; escaped id's need trailing space (goto-char (match-end 0))) + ;; .name + ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*[,)/]") + (verilog-read-sub-decls-sig + submoddecls comment (match-string 1) t ; sig==t for .name + nil nil) ; vec multidim + (setq port nil)) + ;; .\escaped_name + ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*[,)/]") + (verilog-read-sub-decls-sig + submoddecls comment (concat (match-string 1) " ") t ; sig==t for .name + nil nil) ; vec multidim + (setq port nil)) + ;; random ((looking-at "\\s-*\\.[^(]*(") (setq port nil) ;; skip this line (goto-char (match-end 0))) @@ -7021,13 +7539,13 @@ Return the list of signals found, using submodi to look up each port." ;; We intentionally ignore (non-escaped) signals with .s in them ;; this prevents AUTOWIRE etc from noticing hierarchical sigs. (when port - (cond ((looking-at "\\([^[({).\\]*\\)\\s-*)") + (cond ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls comment port (verilog-string-remove-spaces (match-string 1)) ; sig nil nil)) ; vec multidim ;; - ((looking-at "\\([^[({).\\]*\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*)") + ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls comment port (verilog-string-remove-spaces (match-string 1)) ; sig @@ -7043,6 +7561,35 @@ Return the list of signals found, using submodi to look up each port." ;; (forward-line 1))))) +(defun verilog-read-sub-decls-gate (submoddecls comment submod end-inst-point) + "For `verilog-read-sub-decls', read lines of UDP gate decl until none match. +Inserts the list of signals found." + (save-excursion + (let ((iolist (cdr (assoc submod verilog-gate-ios)))) + (while (< (point) end-inst-point) + ;; Get primitive's signal name, as will never have port, and no trailing ) + (cond ((looking-at "//") + (search-forward "\n")) + ((looking-at "/\\*") + (or (search-forward "*/") + (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point)))) + ((looking-at "(\\*") + (or (looking-at "(\\*\\s-*)") ; It's a "always @ (*)" + (search-forward "*)") + (error "%s: Unmatched (* *), at char %d" (verilog-point-text) (point)))) + ;; On pins, parse and advance to next pin + ;; Looking at pin, but *not* an // Output comment, or ) to end the inst + ((looking-at "\\s-*[a-zA-Z0-9`_$({}\\\\][^,]*") + (goto-char (match-end 0)) + (setq verilog-read-sub-decls-gate-ios (or (car iolist) "input") + iolist (cdr iolist)) + (verilog-read-sub-decls-expr + submoddecls comment "primitive_port" + (match-string 0))) + (t + (forward-char 1) + (skip-syntax-forward " "))))))) + (defun verilog-read-sub-decls () "Internally parse signals going to modules under this module. Return a array of [ outputs inouts inputs ] signals for modules that are @@ -7065,7 +7612,7 @@ Outputs comments above subcell signals, for example: (let ((end-mod-point (verilog-get-end-of-defun t)) st-point end-inst-point ;; below 3 modified by verilog-read-sub-decls-line - sigs-out sigs-inout sigs-in sigs-intf) + sigs-out sigs-inout sigs-in sigs-intf sigs-intfd) (verilog-beg-of-defun) (while (verilog-re-search-forward "\\(/\\*AUTOINST\\*/\\|\\.\\*\\)" end-mod-point t) (save-excursion @@ -7074,33 +7621,53 @@ Outputs comments above subcell signals, for example: ;; Attempt to snarf a comment (let* ((submod (verilog-read-inst-module)) (inst (verilog-read-inst-name)) + (subprim (member submod verilog-gate-keywords)) (comment (concat inst " of " submod ".v")) submodi submoddecls) - (when (setq submodi (verilog-modi-lookup submod t)) - (setq submoddecls (verilog-modi-get-decls submodi)) - ;; This could have used a list created by verilog-auto-inst - ;; However I want it to be runnable even on user's manually added signals + (cond + (subprim + (setq submodi `primitive + submoddecls (verilog-decls-new nil nil nil nil nil nil nil nil nil) + comment (concat inst " of " submod)) (verilog-backward-open-paren) (setq end-inst-point (save-excursion (forward-sexp 1) (point)) st-point (point)) - (while (re-search-forward "\\s *(?\\s *// Interfaces" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-out - (goto-char st-point) - (while (re-search-forward "\\s *(?\\s *// Outputs" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-out - (goto-char st-point) - (while (re-search-forward "\\s *(?\\s *// Inouts" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-inout - (goto-char st-point) - (while (re-search-forward "\\s *(?\\s *// Inputs" end-inst-point t) - (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-in - ))))) + (forward-char 1) + (verilog-read-sub-decls-gate submoddecls comment submod end-inst-point)) + ;; Non-primitive + (t + (when (setq submodi (verilog-modi-lookup submod t)) + (setq submoddecls (verilog-modi-get-decls submodi) + verilog-read-sub-decls-gate-ios nil) + (verilog-backward-open-paren) + (setq end-inst-point (save-excursion (forward-sexp 1) (point)) + st-point (point)) + ;; This could have used a list created by verilog-auto-inst + ;; However I want it to be runnable even on user's manually added signals + (let ((verilog-read-sub-decls-in-interfaced t)) + (while (re-search-forward "\\s *(?\\s *// Interfaced" end-inst-point t) + (verilog-read-sub-decls-line submoddecls comment))) ;; Modifies sigs-ifd + (goto-char st-point) + (while (re-search-forward "\\s *(?\\s *// Interfaces" end-inst-point t) + (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-out + (goto-char st-point) + (while (re-search-forward "\\s *(?\\s *// Outputs" end-inst-point t) + (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-out + (goto-char st-point) + (while (re-search-forward "\\s *(?\\s *// Inouts" end-inst-point t) + (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-inout + (goto-char st-point) + (while (re-search-forward "\\s *(?\\s *// Inputs" end-inst-point t) + (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-in + ))))))) ;; Combine duplicate bits ;;(setq rr (vector sigs-out sigs-inout sigs-in)) - (vector (verilog-signals-combine-bus (nreverse sigs-out)) - (verilog-signals-combine-bus (nreverse sigs-inout)) - (verilog-signals-combine-bus (nreverse sigs-in)) - (verilog-signals-combine-bus (nreverse sigs-intf)))))) + (verilog-subdecls-new + (verilog-signals-combine-bus (nreverse sigs-out)) + (verilog-signals-combine-bus (nreverse sigs-inout)) + (verilog-signals-combine-bus (nreverse sigs-in)) + (verilog-signals-combine-bus (nreverse sigs-intf)) + (verilog-signals-combine-bus (nreverse sigs-intfd)))))) (defun verilog-read-inst-pins () "Return an array of [ pins ] for the current instantiation at point. @@ -7148,16 +7715,27 @@ For example if declare A A (.B(SIG)) then B will be included in the list." (setq sig-list (cons (list (match-string 1) nil nil) sig-list)))) sig-list))) -(defun verilog-read-auto-lisp (start end) - "Look for and evaluate a AUTO_LISP between START and END." +(defvar verilog-cache-has-lisp nil "True if any AUTO_LISP in buffer.") +(make-variable-buffer-local 'verilog-cache-has-lisp) + +(defun verilog-read-auto-lisp-present () + "Set `verilog-cache-has-lisp' if any AUTO_LISP in this buffer." (save-excursion - (goto-char start) - (while (re-search-forward "\\<AUTO_LISP(" end t) - (backward-char) - (let* ((beg-pt (prog1 (point) - (forward-sexp 1))) ;; Closing paren - (end-pt (point))) - (eval-region beg-pt end-pt nil))))) + (setq verilog-cache-has-lisp (re-search-forward "\\<AUTO_LISP(" nil t)))) + +(defun verilog-read-auto-lisp (start end) + "Look for and evaluate a AUTO_LISP between START and END. +Must call `verilog-read-auto-lisp-present' before this function." + ;; This function is expensive for large buffers, so we cache if any AUTO_LISP exists + (when verilog-cache-has-lisp + (save-excursion + (goto-char start) + (while (re-search-forward "\\<AUTO_LISP(" end t) + (backward-char) + (let* ((beg-pt (prog1 (point) + (forward-sexp 1))) ;; Closing paren + (end-pt (point))) + (eval-region beg-pt end-pt nil)))))) (eval-when-compile ;; Prevent compile warnings; these are let's, not globals @@ -7165,20 +7743,20 @@ For example if declare A A (.B(SIG)) then B will be included in the list." ;; - we want a error when we are debugging this code if they are refed. (defvar sigs-in) (defvar sigs-out) - (defvar got-sig) - (defvar got-rvalue) + (defvar sigs-temp) (defvar uses-delayed) (defvar vector-skip-list)) (defun verilog-read-always-signals-recurse - (exit-keywd rvalue ignore-next) + (exit-keywd rvalue temp-next) "Recursive routine for parentheses/bracket matching. EXIT-KEYWD is expression to stop at, nil if top level. RVALUE is true if at right hand side of equal. IGNORE-NEXT is true to ignore next token, fake from inside case statement." (let* ((semi-rvalue (equal "endcase" exit-keywd)) ;; true if after a ; we are looking for rvalue - keywd last-keywd sig-tolk sig-last-tolk gotend got-sig got-rvalue end-else-check) - ;;(if dbg (setq dbg (concat dbg (format "Recursion %S %S %S\n" exit-keywd rvalue ignore-next)))) + keywd last-keywd sig-tolk sig-last-tolk gotend got-sig got-list end-else-check + ignore-next) + ;;(if dbg (setq dbg (concat dbg (format "Recursion %S %S %S\n" exit-keywd rvalue temp-next)))) (while (not (or (eobp) gotend)) (cond ((looking-at "//") @@ -7256,7 +7834,9 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (cond (sig-last-tolk ;; Function call; zap last signal (setq got-sig nil))) (cond ((equal last-keywd "for") - (verilog-read-always-signals-recurse ";" nil nil) + ;; temp-next: Variables on LHS are lvalues, but generally we want + ;; to ignore them, assuming they are loop increments + (verilog-read-always-signals-recurse ";" nil t) (verilog-read-always-signals-recurse ";" t nil) (verilog-read-always-signals-recurse ")" nil nil)) (t (verilog-read-always-signals-recurse ")" t nil)))) @@ -7266,16 +7846,13 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." ;;(if dbg (setq dbg (concat dbg (format "\tgot-end %s\n" exit-keywd)))) (setq ignore-next nil rvalue semi-rvalue) (if (not exit-keywd) (setq end-else-check t))) - ((or (equal keywd "case") - (equal keywd "casex") - (equal keywd "casez")) + ((member keywd '("case" "casex" "casez")) (skip-syntax-forward "w_") (verilog-read-always-signals-recurse "endcase" t nil) (setq ignore-next nil rvalue semi-rvalue) (if (not exit-keywd) (setq gotend t))) ;; top level begin/end ((string-match "^[$`a-zA-Z_]" keywd) ;; not exactly word constituent - (cond ((or (equal keywd "`ifdef") - (equal keywd "`ifndef")) + (cond ((member keywd '("`ifdef" "`ifndef" "`elsif")) (setq ignore-next t)) ((or ignore-next (member keywd verilog-keywords) @@ -7284,14 +7861,16 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (t (setq keywd (verilog-symbol-detick-denumber keywd)) (when got-sig - (if got-rvalue (setq sigs-in (cons got-sig sigs-in)) - (setq sigs-out (cons got-sig sigs-out))) - ;;(if dbg (setq dbg (concat dbg (format "\t\tgot-sig=%S rv=%S\n" got-sig got-rvalue)))) + (set got-list (cons got-sig (symbol-value got-list))) + ;;(if dbg (setq dbg (concat dbg (format "\t\tgot-sig=%S got-list=%S\n" got-sig got-list)))) ) - (setq got-rvalue rvalue + (setq got-list (cond (temp-next 'sigs-temp) + (rvalue 'sigs-in) + (t 'sigs-out)) got-sig (if (or (not keywd) - (assoc keywd (if got-rvalue sigs-in sigs-out))) + (assoc keywd (symbol-value got-list))) nil (list keywd nil nil)) + temp-next nil sig-tolk t))) (skip-chars-forward "a-zA-Z0-9$_.%`")) (t @@ -7301,25 +7880,23 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (skip-syntax-forward " ")) ;; Append the final pending signal (when got-sig - (if got-rvalue (setq sigs-in (cons got-sig sigs-in)) - (setq sigs-out (cons got-sig sigs-out))) - ;;(if dbg (setq dbg (concat dbg (format "\t\tgot-sig=%S rv=%S\n" got-sig got-rvalue)))) + ;;(if dbg (setq dbg (concat dbg (format "\t\tfinal got-sig=%S got-list=%s\n" got-sig got-list)))) + (set got-list (cons got-sig (symbol-value got-list))) (setq got-sig nil)) ;;(if dbg (setq dbg (concat dbg (format "ENDRecursion %s\n" exit-keywd)))) )) (defun verilog-read-always-signals () "Parse always block at point and return list of (outputs inout inputs)." - ;; Insert new (save-excursion (let* (;;(dbg "") - sigs-in sigs-out + sigs-out sigs-temp sigs-in uses-delayed) ;; Found signal/rvalue; push if not function (search-forward ")") (verilog-read-always-signals-recurse nil nil nil) ;;(if dbg (with-current-buffer (get-buffer-create "*vl-dbg*")) (delete-region (point-min) (point-max)) (insert dbg) (setq dbg "")) ;; Return what was found - (list sigs-out nil sigs-in uses-delayed)))) + (verilog-alw-new sigs-out sigs-temp sigs-in uses-delayed)))) (defun verilog-read-instants () "Parse module at point and return list of ( ( file instance ) ... )." @@ -7356,15 +7933,29 @@ list of ( (signal_name connection_name)... )." (let ((tpl-regexp "\\([0-9]+\\)") (lineno 0) (templateno 0) + (pt (point)) tpl-sig-list tpl-wild-list tpl-end-pt rep) + ;; Note this search is expensive, as we hunt from mod-begin to point + ;; for every instantiation. Likewise in verilog-read-auto-lisp. + ;; So, we look first for an exact string rather than a slow regexp. + ;; Someday we may keep a cache of every template, but this would also + ;; need to record the relative position of each AUTOINST, as multiple + ;; templates exist for each module, and we're inserting lines. (cond ((or - (re-search-backward (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t) - (progn - (goto-char (point-min)) - (re-search-forward (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t))) + (verilog-re-search-backward-substr + "AUTO_TEMPLATE" + (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t) + ;; Also try forward of this AUTOINST + ;; This is for historical support; this isn't speced as working + (progn + (goto-char pt) + (verilog-re-search-forward-substr + "AUTO_TEMPLATE" + (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t))) (goto-char (match-end 0)) ;; Parse "REGEXP" - ;; We reserve @"..." for future lisp expressions that evaluate once-per-AUTOINST + ;; We reserve @"..." for future lisp expressions that evaluate + ;; once-per-AUTOINST (when (looking-at "\\s-*\"\\([^\"]*\\)\"") (setq tpl-regexp (match-string 1)) (goto-char (match-end 0))) @@ -7439,8 +8030,7 @@ Optionally associate it with the specified enumeration ENUMNAME." (let ((enumvar (intern (concat "venum-" enumname)))) ;;(message "Define %s=%s" defname defvalue) (sleep-for 1) (unless (boundp enumvar) (set enumvar nil)) - (make-local-variable enumvar) - (add-to-list enumvar defname))))) + (add-to-list (make-local-variable enumvar) defname))))) (defun verilog-read-defines (&optional filename recurse subcall) "Read `defines and parameters for the current file, or optional FILENAME. @@ -7495,7 +8085,8 @@ warning message, you need to add to your .emacs file: (when recurse (goto-char (point-min)) (while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n\f]+\\)" nil t) - (let ((inc (verilog-string-replace-matches "\"" "" nil nil (match-string-no-properties 1)))) + (let ((inc (verilog-string-replace-matches + "\"" "" nil nil (match-string-no-properties 1)))) (unless (verilog-inside-comment-p) (verilog-read-defines inc recurse t))))) ;; Read `defines @@ -7518,7 +8109,8 @@ warning message, you need to add to your .emacs file: (setq enumname (match-string-no-properties 1))) (forward-comment 999) (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*") - (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname) + (verilog-set-define (match-string-no-properties 1) + (match-string-no-properties 2) origbuf enumname) (goto-char (match-end 0)) (forward-comment 999))))))) @@ -7671,8 +8263,7 @@ Some macros and such are also found and included. For dinotrace.el." ": Can't find verilog-getopt-file -f file: " filename))) (goto-char (point-min)) (while (not (eobp)) - (setq line (buffer-substring (point) - (save-excursion (end-of-line) (point)))) + (setq line (buffer-substring (point) (point-at-eol))) (forward-line 1) (when (string-match "//" line) (setq line (substring line 0 (match-beginning 0)))) @@ -7702,6 +8293,20 @@ unless it is already a member of the variable's list." varref) ;;(progn (setq l '()) (verilog-add-list-unique `l "a") (verilog-add-list-unique `l "a") l) +(defun verilog-current-flags () + "Convert `verilog-library-flags' and similar variables to command line. +Used for __FLAGS__ in `verilog-expand-command'." + (let ((cmd (mapconcat `concat verilog-library-flags " "))) + (when (equal cmd "") + (setq cmd (concat + "+libext+" (mapconcat `concat verilog-library-extensions "+") + (mapconcat (lambda (i) (concat " -y " i " +incdir+" i)) + verilog-library-directories "") + (mapconcat (lambda (i) (concat " -v " i)) + verilog-library-files "")))) + cmd)) +;;(verilog-current-flags) + ;; ;; Cached directory support @@ -7721,7 +8326,7 @@ See `verilog-dir-exists-p' and `verilog-dir-files'.") "Execute the BODY forms, allowing directory cache preservation within BODY. This means that changes inside BODY made to the file system will not be seen by the `verilog-dir-files' and related functions." - `(let ((verilog-dir-cache-preserving t) + `(let ((verilog-dir-cache-preserving (current-buffer)) verilog-dir-cache-list verilog-dir-cache-lib-filenames) (progn ,@body))) @@ -7771,23 +8376,24 @@ Like `file-exists-p' but results are cached if inside ;; (defun verilog-module-inside-filename-p (module filename) - "Return point if MODULE is specified inside FILENAME, else nil. + "Return modi if MODULE is specified inside FILENAME, else nil. Allows version control to check out the file if need be." (and (or (file-exists-p filename) (and (fboundp 'vc-backend) (vc-backend filename))) - (let (pt) + (let (modi type) (with-current-buffer (find-file-noselect filename) (save-excursion (goto-char (point-min)) (while (and ;; It may be tempting to look for verilog-defun-re, ;; don't, it slows things down a lot! - (verilog-re-search-forward-quick "\\<module\\>" nil t) + (verilog-re-search-forward-quick "\\<\\(module\\|interface\\)\\>" nil t) + (setq type (match-string-no-properties 0)) (verilog-re-search-forward-quick "[(;]" nil t)) (if (equal module (verilog-read-module-name)) - (setq pt (point)))) - pt))))) + (setq modi (verilog-modi-new module filename (point) type)))) + modi))))) (defun verilog-is-number (symbol) "Return true if SYMBOL is number-like." @@ -7953,7 +8559,6 @@ variables to build the path." "Cache of ((Module Function) Buf-Tick Buf-Modtime Func-Returns)... For speeding up verilog-modi-get-* commands. Buffer-local.") - (make-variable-buffer-local 'verilog-modi-cache-list) (defvar verilog-modi-cache-preserve-tick nil @@ -7962,47 +8567,80 @@ Use `verilog-preserve-modi-cache' to set it.") (defvar verilog-modi-cache-preserve-buffer nil "Modification tick after which the cache is still considered valid. Use `verilog-preserve-modi-cache' to set it.") +(defvar verilog-modi-cache-current-enable nil + "If true, allow caching `verilog-modi-current', set by let().") +(defvar verilog-modi-cache-current nil + "Currently active `verilog-modi-current', if any, set by let().") +(defvar verilog-modi-cache-current-max nil + "Current endmodule point for `verilog-modi-cache-current', if any.") (defun verilog-modi-current () + "Return the modi structure for the module currently at point, possibly cached." + (cond ((and verilog-modi-cache-current + (>= (point) (verilog-modi-get-point verilog-modi-cache-current)) + (<= (point) verilog-modi-cache-current-max)) + ;; Slow assertion, for debugging the cache: + ;;(or (equal verilog-modi-cache-current (verilog-modi-current-get)) (debug)) + verilog-modi-cache-current) + (verilog-modi-cache-current-enable + (setq verilog-modi-cache-current (verilog-modi-current-get) + verilog-modi-cache-current-max + ;; The cache expires when we pass "endmodule" as then the + ;; current modi may change to the next module + ;; This relies on the AUTOs generally inserting, not deleting text + (save-excursion + (verilog-re-search-forward-quick verilog-end-defun-re nil nil))) + verilog-modi-cache-current) + (t + (verilog-modi-current-get)))) + +(defun verilog-modi-current-get () "Return the modi structure for the module currently at point." - (let* (name pt) + (let* (name type pt) ;; read current module's name (save-excursion (verilog-re-search-backward-quick verilog-defun-re nil nil) + (setq type (match-string-no-properties 0)) (verilog-re-search-forward-quick "(" nil nil) (setq name (verilog-read-module-name)) (setq pt (point))) - ;; return - (vector name (or (buffer-file-name) (current-buffer)) pt))) + ;; return modi - note this vector built two places + (verilog-modi-new name (or (buffer-file-name) (current-buffer)) pt type))) -(defvar verilog-modi-lookup-last-mod nil "Cache of last module looked up.") -(defvar verilog-modi-lookup-last-modi nil "Cache of last modi returned.") -(defvar verilog-modi-lookup-last-current nil "Cache of last `current-buffer' looked up.") -(defvar verilog-modi-lookup-last-tick nil "Cache of last `buffer-modified-tick' looked up.") +(defvar verilog-modi-lookup-cache nil "Hash of (modulename modi).") +(make-variable-buffer-local 'verilog-modi-lookup-cache) +(defvar verilog-modi-lookup-last-current nil "Cache of `current-buffer' at last lookup.") +(defvar verilog-modi-lookup-last-tick nil "Cache of `buffer-chars-modified-tick' at last lookup.") (defun verilog-modi-lookup (module allow-cache &optional ignore-error) "Find the file and point at which MODULE is defined. If ALLOW-CACHE is set, check and remember cache of previous lookups. Return modi if successful, else print message unless IGNORE-ERROR is true." - (let* ((current (or (buffer-file-name) (current-buffer)))) - (cond ((and verilog-modi-lookup-last-modi + (let* ((current (or (buffer-file-name) (current-buffer))) + modi) + ;; Check cache + ;;(message "verilog-modi-lookup: %s" module) + (cond ((and verilog-modi-lookup-cache verilog-cache-enabled allow-cache - (equal verilog-modi-lookup-last-mod module) + (setq modi (gethash module verilog-modi-lookup-cache)) (equal verilog-modi-lookup-last-current current) - (equal verilog-modi-lookup-last-tick (buffer-modified-tick))) - ;; ok as is - ) + ;; Iff hit is in current buffer, then tick must match + (or (equal verilog-modi-lookup-last-tick (buffer-chars-modified-tick)) + (not (equal current (verilog-modi-file-or-buffer modi))))) + ;;(message "verilog-modi-lookup: HIT %S" modi) + modi) + ;; Miss (t (let* ((realmod (verilog-symbol-detick module t)) (orig-filenames (verilog-module-filenames realmod current)) (filenames orig-filenames) - pt) - (while (and filenames (not pt)) - (if (not (setq pt (verilog-module-inside-filename-p realmod (car filenames)))) + mif) + (while (and filenames (not mif)) + (if (not (setq mif (verilog-module-inside-filename-p realmod (car filenames)))) (setq filenames (cdr filenames)))) - (cond (pt (setq verilog-modi-lookup-last-modi - (vector realmod (car filenames) pt))) - (t (setq verilog-modi-lookup-last-modi nil) + ;; mif has correct form to become later elements of modi + (cond (mif (setq modi mif)) + (t (setq modi nil) (or ignore-error (error (concat (verilog-point-text) ": Can't locate " module " module definition" @@ -8012,17 +8650,14 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." "\n Check the verilog-library-directories variable." "\n I looked in (if not listed, doesn't exist):\n\t" (mapconcat 'concat orig-filenames "\n\t")))))) - (setq verilog-modi-lookup-last-mod module - verilog-modi-lookup-last-current current - verilog-modi-lookup-last-tick (buffer-modified-tick))))) - verilog-modi-lookup-last-modi)) - -(defsubst verilog-modi-name (modi) - (aref modi 0)) -(defsubst verilog-modi-file-or-buffer (modi) - (aref modi 1)) -(defsubst verilog-modi-point (modi) - (aref modi 2)) + (when (eval-when-compile (fboundp 'make-hash-table)) + (unless verilog-modi-lookup-cache + (setq verilog-modi-lookup-cache + (make-hash-table :test 'equal :rehash-size 4.0))) + (puthash module modi verilog-modi-lookup-cache)) + (setq verilog-modi-lookup-last-current current + verilog-modi-lookup-last-tick (buffer-chars-modified-tick))))) + modi)) (defun verilog-modi-filename (modi) "Filename of MODI, or name of buffer if it's never been saved." @@ -8039,7 +8674,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." (find-file-noselect (verilog-modi-file-or-buffer modi)))) (or (equal major-mode `verilog-mode) ;; Put into Verilog mode to get syntax (verilog-mode)) - (goto-char (verilog-modi-point modi))) + (goto-char (verilog-modi-get-point modi))) (defun verilog-goto-defun-file (module) "Move point to the file at which a given MODULE is defined." @@ -8059,7 +8694,7 @@ Cache the output of function so next call may have faster access." verilog-modi-cache-list)) ;; Destroy caching when incorrect; Modified or file changed (not (and verilog-cache-enabled - (or (equal (buffer-modified-tick) (nth 1 fass)) + (or (equal (buffer-chars-modified-tick) (nth 1 fass)) (and verilog-modi-cache-preserve-tick (<= verilog-modi-cache-preserve-tick (nth 1 fass)) (equal verilog-modi-cache-preserve-buffer (current-buffer)))) @@ -8082,7 +8717,7 @@ Cache the output of function so next call may have faster access." ;; Cache for next time (setq verilog-modi-cache-list (cons (list (list modi function) - (buffer-modified-tick) + (buffer-chars-modified-tick) (visited-file-modtime) func-returns) verilog-modi-cache-list)) @@ -8108,7 +8743,7 @@ flushed. If the changes affect the modsig state, they must call the modsig-cache-add-* function, else the results of later calls may be incorrect. Without this, changes are assumed to be adding/removing signals and invalidating the cache." - `(let ((verilog-modi-cache-preserve-tick (buffer-modified-tick)) + `(let ((verilog-modi-cache-preserve-tick (buffer-chars-modified-tick)) (verilog-modi-cache-preserve-buffer (current-buffer))) (progn ,@body))) @@ -8229,7 +8864,9 @@ with appropriate INDENT-PT indentation." (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, @@ -8254,7 +8891,7 @@ format. Sort unless DONT-SORT. DIRECTION is normally wire/reg/output." (equal "" (verilog-sig-comment sig))) (insert "\n") (indent-to (max 48 (+ indent-pt 40))) - (insert (concat "// " (verilog-sig-comment sig) "\n"))) + (verilog-insert "// " (verilog-sig-comment sig) "\n")) (setq sigs (cdr sigs))))) (eval-when-compile @@ -8268,7 +8905,7 @@ Presumes that any newlines end a list element." (while stuff (if need-indent (indent-to indent-pt)) (setq need-indent nil) - (insert (car stuff)) + (verilog-insert (car stuff)) (setq need-indent (string-match "\n$" (car stuff)) stuff (cdr stuff))))) ;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n")) @@ -8500,42 +9137,44 @@ called before and after this function, respectively." (save-excursion (if (buffer-file-name) (find-file-noselect (buffer-file-name))) ;; To check we have latest version - ;; Allow user to customize - (run-hooks 'verilog-before-delete-auto-hook) - - ;; Remove those that have multi-line insertions, possibly with parameters - (verilog-auto-re-search-do - (concat "/\\*" - (eval-when-compile - (verilog-regexp-words - `("AUTOASCIIENUM" "AUTOCONCATCOMMENT" "AUTODEFINEVALUE" - "AUTOINOUT" "AUTOINOUTCOMP" "AUTOINOUTMODULE" - "AUTOINPUT" "AUTOINSERTLISP" "AUTOOUTPUT" "AUTOOUTPUTEVERY" - "AUTOREG" "AUTOREGINPUT" "AUTORESET" "AUTOTIEOFF" - "AUTOUNUSED" "AUTOWIRE"))) - ;; Optional parens or quoted parameter or .* for (((...))) - "\\(\\|([^)]*)\\|(\"[^\"]*\")\\).*?" - "\\*/") - 'verilog-delete-autos-lined) - ;; Remove those that are in parenthesis - (verilog-auto-re-search-do - (concat "/\\*" - (eval-when-compile - (verilog-regexp-words - `("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" - "AUTOSENSE"))) - "\\*/") - 'verilog-delete-to-paren) - ;; Do .* instantiations, but avoid removing any user pins by looking for our magic comments - (verilog-auto-re-search-do "\\.\\*" - 'verilog-delete-auto-star-all) - ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed - (goto-char (point-min)) - (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)[ \tLT0-9]*$" nil t) - (replace-match "")) + (verilog-save-no-change-functions + (verilog-save-scan-cache + ;; Allow user to customize + (run-hooks 'verilog-before-delete-auto-hook) + + ;; Remove those that have multi-line insertions, possibly with parameters + (verilog-auto-re-search-do + (concat "/\\*" + (eval-when-compile + (verilog-regexp-words + `("AUTOASCIIENUM" "AUTOCONCATCOMMENT" "AUTODEFINEVALUE" + "AUTOINOUT" "AUTOINOUTCOMP" "AUTOINOUTMODULE" + "AUTOINPUT" "AUTOINSERTLISP" "AUTOOUTPUT" "AUTOOUTPUTEVERY" + "AUTOREG" "AUTOREGINPUT" "AUTORESET" "AUTOTIEOFF" + "AUTOUNUSED" "AUTOWIRE"))) + ;; Optional parens or quoted parameter or .* for (((...))) + "\\(\\|([^)]*)\\|(\"[^\"]*\")\\).*?" + "\\*/") + 'verilog-delete-autos-lined) + ;; Remove those that are in parenthesis + (verilog-auto-re-search-do + (concat "/\\*" + (eval-when-compile + (verilog-regexp-words + `("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" + "AUTOSENSE"))) + "\\*/") + 'verilog-delete-to-paren) + ;; Do .* instantiations, but avoid removing any user pins by looking for our magic comments + (verilog-auto-re-search-do "\\.\\*" + 'verilog-delete-auto-star-all) + ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed + (goto-char (point-min)) + (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)[ \tLT0-9]*$" nil t) + (replace-match "")) - ;; Final customize - (run-hooks 'verilog-delete-auto-hook))) + ;; Final customize + (run-hooks 'verilog-delete-auto-hook))))) ;; ;; Auto inject @@ -8600,7 +9239,7 @@ Typing \\[verilog-inject-auto] will make this into: (verilog-backward-syntactic-ws) (backward-char 1) ; Moves to paren that closes argdecl's (when (looking-at ")") - (insert "/*AUTOARG*/"))))))) + (verilog-insert "/*AUTOARG*/"))))))) (defun verilog-inject-sense () "Inject AUTOSENSE into new code. See `verilog-inject-auto'." @@ -8622,7 +9261,7 @@ Typing \\[verilog-inject-auto] will make this into: (when (not (or (verilog-signals-not-in pre-sigs got-sigs) ; Both are equal? (verilog-signals-not-in got-sigs pre-sigs))) (delete-region start-pt (point)) - (insert "/*AS*/"))))))) + (verilog-insert "/*AS*/"))))))) (defun verilog-inject-inst () "Inject AUTOINST into new code. See `verilog-inject-auto'." @@ -8656,9 +9295,8 @@ Typing \\[verilog-inject-auto] will make this into: ;; Not verilog-re-search, as we don't want to strip comments (while (re-search-backward "[ \t\n\f]+" (- (point) 1) t) (delete-region (match-beginning 0) (match-end 0))) - (insert "\n") - (indent-to indent-pt) - (insert "/*AUTOINST*/"))))))))) + (verilog-insert "\n") + (verilog-insert-indent "/*AUTOINST*/"))))))))) ;; ;; Auto save @@ -8675,14 +9313,14 @@ Typing \\[verilog-inject-auto] will make this into: ((eq verilog-auto-save-policy 'force) (verilog-auto)) ((not (buffer-modified-p))) - ((eq verilog-auto-update-tick (buffer-modified-tick))) ; up-to-date + ((eq verilog-auto-update-tick (buffer-chars-modified-tick))) ; up-to-date ((eq verilog-auto-save-policy 'detect) (verilog-auto)) (t (when (yes-or-no-p "AUTO statements not recomputed, do it now? ") (verilog-auto)) ;; Don't ask again if didn't update - (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick)))) + (set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick)))) (when (not verilog-auto-star-save) (verilog-delete-auto-star-implicit)) nil) ;; Always return nil -- we don't write the file ourselves @@ -8698,10 +9336,9 @@ Typing \\[verilog-inject-auto] will make this into: (defun verilog-auto-reeval-locals (&optional force) "Read file local variable segment at bottom of file if it has changed. If FORCE, always reread it." - (make-local-variable 'verilog-auto-last-file-locals) (let ((curlocal (verilog-auto-read-locals))) (when (or force (not (equal verilog-auto-last-file-locals curlocal))) - (setq verilog-auto-last-file-locals curlocal) + (set (make-local-variable 'verilog-auto-last-file-locals) curlocal) ;; Note this may cause this function to be recursively invoked, ;; because hack-local-variables may call (verilog-mode) ;; The above when statement will prevent it from recursing forever. @@ -8828,7 +9465,7 @@ If PAR-VALUES replace final strings with these parameter values." (vl-name (verilog-sig-name port-st)) (vl-width (verilog-sig-width port-st)) (vl-modport (verilog-sig-modport port-st)) - (vl-mbits (if (verilog-sig-multidim port-st) + (vl-mbits (if (verilog-sig-multidim port-st) (verilog-sig-multidim-string port-st) "")) (vl-bits (if (or verilog-auto-inst-vector (not (assoc port vector-skip-list)) @@ -8892,19 +9529,23 @@ If PAR-VALUES replace final strings with these parameter values." ;; Insert it (indent-to indent-pt) (insert "." port) - (indent-to verilog-auto-inst-column) - (insert "(" tpl-net "),") + (unless (and verilog-auto-inst-dot-name + (equal port tpl-net)) + (indent-to verilog-auto-inst-column) + (insert "(" tpl-net ")")) + (insert ",") (cond (tpl-ass (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) verilog-auto-inst-column)) - (insert " // Templated") - (when verilog-auto-inst-template-numbers - (insert " T" (int-to-string (nth 2 tpl-ass)) - " L" (int-to-string (nth 3 tpl-ass))))) + (if verilog-auto-inst-template-numbers + (verilog-insert " // Templated" + " T" (int-to-string (nth 2 tpl-ass)) + " L" (int-to-string (nth 3 tpl-ass))) + (verilog-insert " // Templated"))) (for-star (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) verilog-auto-inst-column)) - (insert " // Implicit .\*"))) ;For some reason the . or * must be escaped... + (verilog-insert " // Implicit .\*"))) ;For some reason the . or * must be escaped... (insert "\n"))) ;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3") ;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]") @@ -8944,8 +9585,9 @@ See `verilog-auto-inst' for examples, templates, and more information." (defun verilog-auto-inst () "Expand AUTOINST statements, as part of \\[verilog-auto]. -Replace the pin connections to an instantiation with ones -automatically derived from the module header of the instantiated netlist. +Replace the pin connections to an instantiation or interface +declaration with ones automatically derived from the module or +interface header of the instantiated item. If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports, and delete them before saving unless `verilog-auto-star-save' is set. @@ -8965,12 +9607,18 @@ Limitations: SystemVerilog multidimensional input/output has only experimental support. + SystemVerilog .name syntax is used if `verilog-auto-inst-dot-name' is set. + Parameters referenced by the instantiation will remain symbolic, unless `verilog-auto-inst-param-value' is set. + Gate primitives (and/or) may have AUTOINST for the purpose of + AUTOWIRE declarations, etc. Gates are the only case when + position based connections are passed. + For example, first take the submodule InstModule.v: - module InstModule (o,i) + module InstModule (o,i); output [31:0] o; input i; wire [31:0] o = {32{i}}; @@ -8978,7 +9626,7 @@ For example, first take the submodule InstModule.v: This is then used in a upper level module: - module ExampInst (o,i) + module ExampInst (o,i); output o; input i; InstModule instName @@ -8987,7 +9635,7 @@ This is then used in a upper level module: Typing \\[verilog-auto] will make this into: - module ExampInst (o,i) + module ExampInst (o,i); output o; input i; InstModule instName @@ -9238,7 +9886,8 @@ For more information see the \\[verilog-faq] and forums at URL ;; Lookup position, etc of submodule ;; Note this may raise an error - (when (setq submodi (verilog-modi-lookup submod t)) + (when (and (not (member submod verilog-gate-keywords)) + (setq submodi (verilog-modi-lookup submod t))) (setq submoddecls (verilog-modi-get-decls submodi)) ;; If there's a number in the instantiation, it may be a argument to the ;; automatic variable instantiation program. @@ -9249,15 +9898,28 @@ For more information see the \\[verilog-faq] and forums at URL "") tpl-list (aref tpl-info 1))) ;; Find submodule's signals and dump + (let ((sig-list (and (equal (verilog-modi-get-type submodi) "interface") + (verilog-signals-not-in + (append (verilog-decls-get-wires submoddecls) + (verilog-decls-get-regs submoddecls)) + skip-pins))) + (vl-dir "interfaced")) + (when sig-list + (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) + ;; Note these are searched for in verilog-read-sub-decls. + (verilog-insert-indent "// Interfaced\n") + (mapc (lambda (port) + (verilog-auto-inst-port port indent-pt + tpl-list tpl-num for-star par-values)) + sig-list))) (let ((sig-list (verilog-signals-not-in (verilog-decls-get-interfaces submoddecls) skip-pins)) (vl-dir "interface")) (when sig-list (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (indent-to indent-pt) ;; Note these are searched for in verilog-read-sub-decls. - (insert "// Interfaces\n") + (verilog-insert-indent "// Interfaces\n") (mapc (lambda (port) (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star par-values)) @@ -9268,8 +9930,7 @@ For more information see the \\[verilog-faq] and forums at URL (vl-dir "output")) (when sig-list (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (indent-to indent-pt) - (insert "// Outputs\n") + (verilog-insert-indent "// Outputs\n") (mapc (lambda (port) (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star par-values)) @@ -9280,8 +9941,7 @@ For more information see the \\[verilog-faq] and forums at URL (vl-dir "inout")) (when sig-list (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (indent-to indent-pt) - (insert "// Inouts\n") + (verilog-insert-indent "// Inouts\n") (mapc (lambda (port) (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star par-values)) @@ -9292,8 +9952,7 @@ For more information see the \\[verilog-faq] and forums at URL (vl-dir "input")) (when sig-list (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (indent-to indent-pt) - (insert "// Inputs\n") + (verilog-insert-indent "// Inputs\n") (mapc (lambda (port) (verilog-auto-inst-port port indent-pt tpl-list tpl-num for-star par-values)) @@ -9321,13 +9980,13 @@ output. For example, first take the submodule InstModule.v: - module InstModule (o,i) + module InstModule (o,i); parameter PAR; endmodule This is then used in a upper level module: - module ExampInst (o,i) + module ExampInst (o,i); parameter PAR; InstModule #(/*AUTOINSTPARAM*/) instName (/*AUTOINST*/); @@ -9335,7 +9994,7 @@ This is then used in a upper level module: Typing \\[verilog-auto] will make this into: - module ExampInst (o,i) + module ExampInst (o,i); output o; input i; InstModule #(/*AUTOINSTPARAM*/ @@ -9398,9 +10057,8 @@ Templates: (vl-dir "parameter")) (when sig-list (when (not did-first) (verilog-auto-inst-first) (setq did-first t)) - (indent-to indent-pt) ;; Note these are searched for in verilog-read-sub-decls. - (insert "// Parameters\n") + (verilog-insert-indent "// Parameters\n") (mapc (lambda (port) (verilog-auto-inst-port port indent-pt tpl-list tpl-num nil nil)) @@ -9428,7 +10086,7 @@ Limitations: An example: - module ExampReg (o,i) + module ExampReg (o,i); output o; input i; /*AUTOREG*/ @@ -9437,7 +10095,7 @@ An example: Typing \\[verilog-auto] will make this into: - module ExampReg (o,i) + module ExampReg (o,i); output o; input i; /*AUTOREG*/ @@ -9459,6 +10117,7 @@ Typing \\[verilog-auto] will make this into: (verilog-decls-get-assigns moddecls) (verilog-decls-get-consts moddecls) (verilog-decls-get-gparams moddecls) + (verilog-subdecls-get-interfaced modsubdecls) (verilog-subdecls-get-outputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls))))) (forward-line 1) @@ -9481,7 +10140,7 @@ Limitations: An example (see `verilog-auto-inst' for what else is going on here): - module ExampRegInput (o,i) + module ExampRegInput (o,i); output o; input i; /*AUTOREGINPUT*/ @@ -9491,7 +10150,7 @@ An example (see `verilog-auto-inst' for what else is going on here): Typing \\[verilog-auto] will make this into: - module ExampRegInput (o,i) + module ExampRegInput (o,i); output o; input i; /*AUTOREGINPUT*/ @@ -9543,7 +10202,7 @@ Limitations: An example (see `verilog-auto-inst' for what else is going on here): - module ExampWire (o,i) + module ExampWire (o,i); output o; input i; /*AUTOWIRE*/ @@ -9553,7 +10212,7 @@ An example (see `verilog-auto-inst' for what else is going on here): Typing \\[verilog-auto] will make this into: - module ExampWire (o,i) + module ExampWire (o,i); output o; input i; /*AUTOWIRE*/ @@ -9613,7 +10272,7 @@ Limitations: An example (see `verilog-auto-inst' for what else is going on here): - module ExampOutput (ov,i) + module ExampOutput (ov,i); input i; /*AUTOOUTPUT*/ InstModule instName @@ -9622,7 +10281,7 @@ An example (see `verilog-auto-inst' for what else is going on here): Typing \\[verilog-auto] will make this into: - module ExampOutput (ov,i) + module ExampOutput (ov,i); input i; /*AUTOOUTPUT*/ // Beginning of automatic outputs (from unused autoinst outputs) @@ -9679,7 +10338,7 @@ won't optimize away the outputs. An example: - module ExampOutputEvery (o,i,tempa,tempb) + module ExampOutputEvery (o,i,tempa,tempb); output o; input i; /*AUTOOUTPUTEVERY*/ @@ -9690,7 +10349,7 @@ An example: Typing \\[verilog-auto] will make this into: - module ExampOutputEvery (o,i,tempa,tempb) + module ExampOutputEvery (o,i,tempa,tempb); output o; input i; /*AUTOOUTPUTEVERY*/ @@ -9742,7 +10401,7 @@ Limitations: An example (see `verilog-auto-inst' for what else is going on here): - module ExampInput (ov,i) + module ExampInput (ov,i); output [31:0] ov; /*AUTOINPUT*/ InstModule instName @@ -9751,7 +10410,7 @@ An example (see `verilog-auto-inst' for what else is going on here): Typing \\[verilog-auto] will make this into: - module ExampInput (ov,i) + module ExampInput (ov,i); output [31:0] ov; /*AUTOINPUT*/ // Beginning of automatic inputs (from unused autoinst inputs) @@ -9786,6 +10445,7 @@ same expansion will result from only extracting inputs starting with i: (verilog-decls-get-regs moddecls) (verilog-decls-get-consts moddecls) (verilog-decls-get-gparams moddecls) + (verilog-subdecls-get-interfaced modsubdecls) (verilog-subdecls-get-outputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls))))) (when regexp @@ -9822,7 +10482,7 @@ Limitations: An example (see `verilog-auto-inst' for what else is going on here): - module ExampInout (ov,i) + module ExampInout (ov,i); input i; /*AUTOINOUT*/ InstModule instName @@ -9831,7 +10491,7 @@ An example (see `verilog-auto-inst' for what else is going on here): Typing \\[verilog-auto] will make this into: - module ExampInout (ov,i) + module ExampInout (ov,i); input i; /*AUTOINOUT*/ // Beginning of automatic inouts (from unused autoinst inouts) @@ -9886,6 +10546,7 @@ Take input/output/inout statements from the specified module and insert into the current module. This is useful for making null templates and shell modules which need to have identical I/O with another module. Any I/O which are already defined in this module will not be redefined. +For the complement of this function, see `verilog-auto-inout-comp'. Limitations: If placed inside the parenthesis of a module declaration, it creates @@ -9901,11 +10562,11 @@ Limitations: An example: - module ExampShell (/*AUTOARG*/) + module ExampShell (/*AUTOARG*/); /*AUTOINOUTMODULE(\"ExampMain\")*/ endmodule - module ExampMain (i,o,io) + module ExampMain (i,o,io); input i; output o; inout io; @@ -9913,7 +10574,7 @@ An example: Typing \\[verilog-auto] will make this into: - module ExampShell (/*AUTOARG*/i,o,io) + module ExampShell (/*AUTOARG*/i,o,io); /*AUTOINOUTMODULE(\"ExampMain\")*/ // Beginning of automatic in/out/inouts (from specific module) output o; @@ -10004,7 +10665,8 @@ insert the inverse into the current module (inputs become outputs and vice-versa.) This is useful for making test and stimulus modules which need to have complementing I/O with another module. Any I/O which are already defined in this module will not be -redefined. +redefined. For the complement of this function, see +`verilog-auto-inout-module'. Limitations: If placed inside the parenthesis of a module declaration, it creates @@ -10020,11 +10682,11 @@ Limitations: An example: - module ExampShell (/*AUTOARG*/) + module ExampShell (/*AUTOARG*/); /*AUTOINOUTCOMP(\"ExampMain\")*/ endmodule - module ExampMain (i,o,io) + module ExampMain (i,o,io); input i; output o; inout io; @@ -10032,7 +10694,7 @@ An example: Typing \\[verilog-auto] will make this into: - module ExampShell (/*AUTOARG*/i,o,io) + module ExampShell (/*AUTOARG*/i,o,io); /*AUTOINOUTCOMP(\"ExampMain\")*/ // Beginning of automatic in/out/inouts (from specific module) output i; @@ -10106,6 +10768,7 @@ text: (forward-line -1) (eval (read cmd)) (forward-line -1) + (setq verilog-scan-cache-tick nil) ;; Clear cache; inserted unknown text (verilog-delete-empty-auto-pair)))) (defun verilog-auto-sense-sigs (moddecls presense-sigs) @@ -10115,6 +10778,7 @@ text: (verilog-signals-not-in (verilog-alw-get-inputs sigss) (append (and (not verilog-auto-sense-include-inputs) (verilog-alw-get-outputs sigss)) + (verilog-alw-get-temps sigss) (verilog-decls-get-consts moddecls) (verilog-decls-get-gparams moddecls) presense-sigs))))) @@ -10197,7 +10861,7 @@ operator. (This was added to the language in part due to AUTOSENSE!) (when sig-memories (let ((tlen (length sig-list))) (setq sig-list (verilog-signals-not-in sig-list sig-memories)) - (if (not (eq tlen (length sig-list))) (insert " /*memory or*/ ")))) + (if (not (eq tlen (length sig-list))) (verilog-insert " /*memory or*/ ")))) (if (and presense-sigs ;; Add a "or" if not "(.... or /*AUTOSENSE*/" (save-excursion (goto-char (point)) (verilog-re-search-backward "[a-zA-Z0-9$_.%`]+" start-pt t) @@ -10297,12 +10961,13 @@ Typing \\[verilog-auto] will make this into: (concat " <= " verilog-assignment-delay) " = ")) (setq sig-list (verilog-signals-not-in (verilog-alw-get-outputs sigss) - prereset-sigs)) + (append + (verilog-alw-get-temps sigss) + prereset-sigs))) (setq sig-list (sort sig-list `verilog-signals-sort-compare)) (when sig-list (insert "\n"); - (indent-to indent-pt) - (insert "// Beginning of autoreset for uninitialized flops\n"); + (verilog-insert-indent "// Beginning of autoreset for uninitialized flops\n"); (indent-to indent-pt) (while sig-list (let ((sig (or (assoc (verilog-sig-name (car sig-list)) all-list) ;; As sig-list has no widths @@ -10313,7 +10978,7 @@ Typing \\[verilog-auto] will make this into: ";\n") (indent-to indent-pt) (setq sig-list (cdr sig-list)))) - (insert "// End of automatics"))))) + (verilog-insert "// End of automatics"))))) (defun verilog-auto-tieoff () "Expand AUTOTIEOFF statements, as part of \\[verilog-auto]. @@ -10329,6 +10994,9 @@ AUTORESET ties signals to deasserted, which is presumed to be zero. Signals that match `verilog-active-low-regexp' will be deasserted by tieing them to a one. +You can add signals you do not want included in AUTOTIEOFF with +`verilog-auto-tieoff-ignore-regexp'. + An example of making a stub for another module: module ExampStub (/*AUTOINST*/); @@ -10369,8 +11037,11 @@ Typing \\[verilog-auto] will make this into: (verilog-decls-get-assigns moddecls) (verilog-decls-get-consts moddecls) (verilog-decls-get-gparams moddecls) + (verilog-subdecls-get-interfaced modsubdecls) (verilog-subdecls-get-outputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls))))) + (setq sig-list (verilog-signals-not-matching-regexp + sig-list verilog-auto-tieoff-ignore-regexp)) (when sig-list (forward-line 1) (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n") @@ -10622,13 +11293,16 @@ Typing \\[verilog-auto] will make this into: "Replace Templated relative line numbers with absolute line numbers. Internal use only. This hacks around the line numbers in AUTOINST Templates being different from the final output's line numbering." - (let ((templateno 0) (template-line (list 0))) + (let ((templateno 0) (template-line (list 0)) (buf-line 1)) ;; Find line number each template is on + ;; Count lines as we go, as otherwise it's O(n^2) to use count-lines (goto-char (point-min)) - (while (search-forward "AUTO_TEMPLATE" nil t) - (setq templateno (1+ templateno)) - (setq template-line - (cons (count-lines (point-min) (point)) template-line))) + (while (not (eobp)) + (when (looking-at ".*AUTO_TEMPLATE") + (setq templateno (1+ templateno)) + (setq template-line (cons buf-line template-line))) + (setq buf-line (1+ buf-line)) + (forward-line 1)) (setq template-line (nreverse template-line)) ;; Replace T# L# with absolute line number (goto-char (point-min)) @@ -10661,7 +11335,7 @@ The hooks `verilog-before-auto-hook' and `verilog-auto-hook' are called before and after this function, respectively. For example: - module ModuleName (/*AUTOARG*/) + module ModuleName (/*AUTOARG*/); /*AUTOINPUT*/ /*AUTOOUTPUT*/ /*AUTOWIRE*/ @@ -10717,89 +11391,102 @@ Wilson Snyder (wsnyder@wsnyder.org)." (font-lock-mode 0) t)) ;; Cache directories; we don't write new files, so can't change - (verilog-dir-cache-preserving t)) - (unwind-protect - (save-excursion - ;; If we're not in verilog-mode, change syntax table so parsing works right - (unless (eq major-mode `verilog-mode) (verilog-mode)) - ;; Allow user to customize - (run-hooks 'verilog-before-auto-hook) - ;; Try to save the user from needing to revert-file to reread file local-variables - (verilog-auto-reeval-locals) - (verilog-read-auto-lisp (point-min) (point-max)) - (verilog-getopt-flags) - ;; From here on out, we can cache anything we read from disk - (verilog-preserve-dir-cache - ;; These two may seem obvious to do always, but on large includes it can be way too slow - (when verilog-auto-read-includes - (verilog-read-includes) - (verilog-read-defines nil nil t)) - ;; This particular ordering is important - ;; INST: Lower modules correct, no internal dependencies, FIRST - (verilog-preserve-modi-cache - ;; Clear existing autos else we'll be screwed by existing ones - (verilog-delete-auto) - ;; Injection if appropriate - (when inject - (verilog-inject-inst) - (verilog-inject-sense) - (verilog-inject-arg)) - ;; - ;; Do user inserts first, so their code can insert AUTOs - ;; We may provide a AUTOINSERTLISPLAST if another cleanup pass is needed - (verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/" - 'verilog-auto-insert-lisp) - ;; Expand instances before need the signals the instances input/output - (verilog-auto-re-search-do "/\\*AUTOINSTPARAM\\*/" 'verilog-auto-inst-param) - (verilog-auto-re-search-do "/\\*AUTOINST\\*/" 'verilog-auto-inst) - (verilog-auto-re-search-do "\\.\\*" 'verilog-auto-star) - ;; Doesn't matter when done, but combine it with a common changer - (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) - (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) - ;; Must be done before autoin/out as creates a reg - (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum) - ;; - ;; first in/outs from other files - (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module) - (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP([^)]*)\\*/" 'verilog-auto-inout-comp) - ;; next in/outs which need previous sucked inputs first - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((\"[^\"]*\")\\)\\*/" - '(lambda () (verilog-auto-output t))) - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\*/" 'verilog-auto-output) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\((\"[^\"]*\")\\)\\*/" - '(lambda () (verilog-auto-input t))) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\*/" 'verilog-auto-input) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\((\"[^\"]*\")\\)\\*/" - '(lambda () (verilog-auto-inout t))) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\*/" 'verilog-auto-inout) - ;; Then tie off those in/outs - (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) - ;; Wires/regs must be after inputs/outputs - (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) - (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) - (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) - ;; outputevery needs AUTOOUTPUTs done first - (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\*/" 'verilog-auto-output-every) - ;; After we've created all new variables - (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) - ;; Must be after all inputs outputs are generated - (verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg) - ;; Fix line numbers (comments only) - (verilog-auto-templated-rel))) - ;; - (run-hooks 'verilog-auto-hook) - ;; - (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick)) - ;; - ;; If end result is same as when started, clear modified flag - (cond ((and oldbuf (equal oldbuf (buffer-string))) - (set-buffer-modified-p nil) - (unless noninteractive (message "Updating AUTOs...done (no changes)"))) - (t (unless noninteractive (message "Updating AUTOs...done"))))) - ;; Unwind forms - (progn - ;; Restore font-lock - (when fontlocked (font-lock-mode t)))))) + (verilog-dir-cache-preserving t) + ;; Cache current module + (verilog-modi-cache-current-enable t) + (verilog-modi-cache-current-max (point-min)) ; IE it's invalid + verilog-modi-cache-current) + (unwind-protect + ;; Disable change hooks for speed + ;; This let can't be part of above let; must restore + ;; after-change-functions before font-lock resumes + (verilog-save-no-change-functions + (verilog-save-scan-cache + (save-excursion + ;; If we're not in verilog-mode, change syntax table so parsing works right + (unless (eq major-mode `verilog-mode) (verilog-mode)) + ;; Allow user to customize + (run-hooks 'verilog-before-auto-hook) + ;; Try to save the user from needing to revert-file to reread file local-variables + (verilog-auto-reeval-locals) + (verilog-read-auto-lisp-present) + (verilog-read-auto-lisp (point-min) (point-max)) + (verilog-getopt-flags) + ;; From here on out, we can cache anything we read from disk + (verilog-preserve-dir-cache + ;; These two may seem obvious to do always, but on large includes it can be way too slow + (when verilog-auto-read-includes + (verilog-read-includes) + (verilog-read-defines nil nil t)) + ;; This particular ordering is important + ;; INST: Lower modules correct, no internal dependencies, FIRST + (verilog-preserve-modi-cache + ;; Clear existing autos else we'll be screwed by existing ones + (verilog-delete-auto) + ;; Injection if appropriate + (when inject + (verilog-inject-inst) + (verilog-inject-sense) + (verilog-inject-arg)) + ;; + ;; Do user inserts first, so their code can insert AUTOs + ;; We may provide a AUTOINSERTLISPLAST if another cleanup pass is needed + (verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/" + 'verilog-auto-insert-lisp) + ;; Expand instances before need the signals the instances input/output + (verilog-auto-re-search-do "/\\*AUTOINSTPARAM\\*/" 'verilog-auto-inst-param) + (verilog-auto-re-search-do "/\\*AUTOINST\\*/" 'verilog-auto-inst) + (verilog-auto-re-search-do "\\.\\*" 'verilog-auto-star) + ;; Doesn't matter when done, but combine it with a common changer + (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) + (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) + ;; Must be done before autoin/out as creates a reg + (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum) + ;; + ;; first in/outs from other files + (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module) + (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP([^)]*)\\*/" 'verilog-auto-inout-comp) + ;; next in/outs which need previous sucked inputs first + (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((\"[^\"]*\")\\)\\*/" + '(lambda () (verilog-auto-output t))) + (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\*/" 'verilog-auto-output) + (verilog-auto-re-search-do "/\\*AUTOINPUT\\((\"[^\"]*\")\\)\\*/" + '(lambda () (verilog-auto-input t))) + (verilog-auto-re-search-do "/\\*AUTOINPUT\\*/" 'verilog-auto-input) + (verilog-auto-re-search-do "/\\*AUTOINOUT\\((\"[^\"]*\")\\)\\*/" + '(lambda () (verilog-auto-inout t))) + (verilog-auto-re-search-do "/\\*AUTOINOUT\\*/" 'verilog-auto-inout) + ;; Then tie off those in/outs + (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) + ;; Wires/regs must be after inputs/outputs + (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) + (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) + (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) + ;; outputevery needs AUTOOUTPUTs done first + (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\*/" 'verilog-auto-output-every) + ;; After we've created all new variables + (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) + ;; Must be after all inputs outputs are generated + (verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg) + ;; Fix line numbers (comments only) + (when verilog-auto-inst-template-numbers + (verilog-auto-templated-rel)))) + ;; + (run-hooks 'verilog-auto-hook) + ;; + (set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick)) + ;; + ;; If end result is same as when started, clear modified flag + (cond ((and oldbuf (equal oldbuf (buffer-string))) + (set-buffer-modified-p nil) + (unless noninteractive (message "Updating AUTOs...done (no changes)"))) + (t (unless noninteractive (message "Updating AUTOs...done")))) + ;; End of after-change protection + ))) + ;; Unwind forms + (progn + ;; Restore font-lock + (when fontlocked (font-lock-mode t)))))) ;; @@ -11191,91 +11878,119 @@ and the case items." "Map containing mouse bindings for `verilog-mode'.") -(defun verilog-colorize-include-files (beg end old-len) - "This function colorizes included files when the mouse passes over them. +(defun verilog-highlight-region (beg end old-len) + "Colorize included files and modules in the (changed?) region. Clicking on the middle-mouse button loads them in a buffer (as in dired)." - (save-excursion - (save-match-data - (let (end-point) - (goto-char end) - (setq end-point (verilog-get-end-of-line)) - (goto-char beg) - (beginning-of-line) ; scan entire line ! - ;; delete overlays existing on this line - (let ((overlays (overlays-in (point) end-point))) - (while overlays - (if (and - (overlay-get (car overlays) 'detachable) - (overlay-get (car overlays) 'verilog-include-file)) - (delete-overlay (car overlays))) - (setq overlays (cdr overlays)))) ; let - ;; make new ones, could reuse deleted one ? - (while (search-forward-regexp verilog-include-file-regexp end-point t) - (let (ov) - (goto-char (match-beginning 1)) - (setq ov (make-overlay (match-beginning 1) (match-end 1))) - (overlay-put ov 'start-closed 't) - (overlay-put ov 'end-closed 't) - (overlay-put ov 'evaporate 't) - (overlay-put ov 'verilog-include-file 't) - (overlay-put ov 'mouse-face 'highlight) - (overlay-put ov 'local-map verilog-mode-mouse-map))))))) - - -(defun verilog-colorize-include-files-buffer () - "Colorize an include file." + (when (or verilog-highlight-includes + verilog-highlight-modules) + (save-excursion + (save-match-data ;; A query-replace may call this function - do not disturb + (verilog-save-buffer-state + (verilog-save-scan-cache + (let (end-point) + (goto-char end) + (setq end-point (point-at-eol)) + (goto-char beg) + (beginning-of-line) ; scan entire line + ;; delete overlays existing on this line + (let ((overlays (overlays-in (point) end-point))) + (while overlays + (if (and + (overlay-get (car overlays) 'detachable) + (or (overlay-get (car overlays) 'verilog-include-file) + (overlay-get (car overlays) 'verilog-inst-module))) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays)))) + ;; + ;; make new include overlays + (when verilog-highlight-includes + (while (search-forward-regexp verilog-include-file-regexp end-point t) + (goto-char (match-beginning 1)) + (let ((ov (make-overlay (match-beginning 1) (match-end 1)))) + (overlay-put ov 'start-closed 't) + (overlay-put ov 'end-closed 't) + (overlay-put ov 'evaporate 't) + (overlay-put ov 'verilog-include-file 't) + (overlay-put ov 'mouse-face 'highlight) + (overlay-put ov 'local-map verilog-mode-mouse-map)))) + ;; + ;; make new module overlays + (goto-char beg) + ;; This scanner is syntax-fragile, so don't get bent + (when verilog-highlight-modules + (condition-case nil + (while (verilog-re-search-forward "\\(/\\*AUTOINST\\*/\\|\\.\\*\\)" end-point t) + (save-excursion + (goto-char (match-beginning 0)) + (unless (verilog-inside-comment-p) + (verilog-read-inst-module-matcher) ;; sets match 0 + (let* ((ov (make-overlay (match-beginning 0) (match-end 0)))) + (overlay-put ov 'start-closed 't) + (overlay-put ov 'end-closed 't) + (overlay-put ov 'evaporate 't) + (overlay-put ov 'verilog-inst-module 't) + (overlay-put ov 'mouse-face 'highlight) + (overlay-put ov 'local-map verilog-mode-mouse-map))))) + (error nil))) + ;; + ;; Future highlights: + ;; variables - make an Occur buffer of where referenced + ;; pins - make an Occur buffer of the sig in the declaration module + ))))))) + +(defun verilog-highlight-buffer () + "Colorize included files and modules across the whole buffer." + ;; Invoked via verilog-mode calling font-lock then `font-lock-mode-hook' (interactive) - ;; delete overlays - (let ((overlays (overlays-in (point-min) (point-max)))) - (while overlays - (if (and - (overlay-get (car overlays) 'detachable) - (overlay-get (car overlays) 'verilog-include-file)) - (delete-overlay (car overlays))) - (setq overlays (cdr overlays)))) ; let - ;; remake overlays - (verilog-colorize-include-files (point-min) (point-max) nil)) + ;; delete and remake overlays + (verilog-highlight-region (point-min) (point-max) nil)) + +;; Deprecated, but was interactive, so we'll keep it around +(defalias 'verilog-colorize-include-files-buffer 'verilog-highlight-buffer) ;; ffap-at-mouse isn't useful for Verilog mode. It uses library paths. ;; so define this function to do more or less the same as ffap-at-mouse ;; but first resolve filename... (defun verilog-load-file-at-mouse (event) "Load file under button 2 click's EVENT. -Files are checked based on `verilog-library-directories'." +Files are checked based on `verilog-library-flags'." (interactive "@e") (save-excursion ;; implement a Verilog specific ffap-at-mouse (mouse-set-point event) - (beginning-of-line) - (if (looking-at verilog-include-file-regexp) - (if (and (car (verilog-library-filenames - (match-string 1) (buffer-file-name))) - (file-readable-p (car (verilog-library-filenames - (match-string 1) (buffer-file-name))))) - (find-file (car (verilog-library-filenames - (match-string 1) (buffer-file-name)))) - (progn - (message - "File '%s' isn't readable, use shift-mouse2 to paste in this field" - (match-string 1))))))) + (verilog-load-file-at-point t))) ;; ffap isn't useable for Verilog mode. It uses library paths. ;; so define this function to do more or less the same as ffap ;; but first resolve filename... -(defun verilog-load-file-at-point () +(defun verilog-load-file-at-point (&optional warn) "Load file under point. -Files are checked based on `verilog-library-directories'." +If WARN, throw warning if not found. +Files are checked based on `verilog-library-flags'." (interactive) (save-excursion ;; implement a Verilog specific ffap - (beginning-of-line) - (if (looking-at verilog-include-file-regexp) - (if (and - (car (verilog-library-filenames - (match-string 1) (buffer-file-name))) - (file-readable-p (car (verilog-library-filenames - (match-string 1) (buffer-file-name))))) + (let ((overlays (overlays-in (point) (point))) + hit) + (while (and overlays (not hit)) + (when (overlay-get (car overlays) 'verilog-inst-module) + (verilog-goto-defun-file (buffer-substring + (overlay-start (car overlays)) + (overlay-end (car overlays)))) + (setq hit t)) + (setq overlays (cdr overlays))) + ;; Include? + (beginning-of-line) + (when (and (not hit) + (looking-at verilog-include-file-regexp)) + (if (and (car (verilog-library-filenames + (match-string 1) (buffer-file-name))) + (file-readable-p (car (verilog-library-filenames + (match-string 1) (buffer-file-name))))) (find-file (car (verilog-library-filenames - (match-string 1) (buffer-file-name)))))))) - + (match-string 1) (buffer-file-name)))) + (when warn + (message + "File '%s' isn't readable, use shift-mouse2 to paste in this field" + (match-string 1)))))))) ;; ;; Bug reporting @@ -11305,22 +12020,43 @@ Files are checked based on `verilog-library-directories'." "mac@verilog.com, wsnyder@wsnyder.org" (concat "verilog-mode v" verilog-mode-version) '( + verilog-active-low-regexp verilog-align-ifelse + verilog-assignment-delay + verilog-auto-arg-sort verilog-auto-endcomments verilog-auto-hook + verilog-auto-ignore-concat verilog-auto-indent-on-newline - verilog-auto-inst-vector + verilog-auto-inout-ignore-regexp + verilog-auto-input-ignore-regexp + verilog-auto-inst-column + verilog-auto-inst-dot-name + verilog-auto-inst-param-value verilog-auto-inst-template-numbers + verilog-auto-inst-vector verilog-auto-lineup verilog-auto-newline + verilog-auto-output-ignore-regexp + verilog-auto-read-includes + verilog-auto-reset-widths verilog-auto-save-policy verilog-auto-sense-defines-constant verilog-auto-sense-include-inputs + verilog-auto-star-expand + verilog-auto-star-save + verilog-auto-unused-ignore-regexp verilog-before-auto-hook + verilog-before-delete-auto-hook + verilog-before-getopt-flags-hook verilog-case-indent verilog-cexp-indent verilog-compiler verilog-coverage + verilog-delete-auto-hook + verilog-getopt-flags-hook + verilog-highlight-grouping-keywords + verilog-highlight-p1800-keywords verilog-highlight-translate-off verilog-indent-begin-after-if verilog-indent-declaration-macros @@ -11330,16 +12066,18 @@ Files are checked based on `verilog-library-directories'." verilog-indent-level-directive verilog-indent-level-module verilog-indent-lists - verilog-library-flags verilog-library-directories verilog-library-extensions verilog-library-files + verilog-library-flags verilog-linter verilog-minimum-comment-distance verilog-mode-hook + verilog-preprocessor verilog-simulator verilog-tab-always-indent verilog-tab-to-comment + verilog-typedef-regexp ) nil nil (concat "Hi Mac, @@ -11375,5 +12113,4 @@ but instead, [[Fill in here]] happens!. ;; checkdoc-force-docstrings-flag:nil ;; End: -;; arch-tag: 87923725-57b3-41b5-9494-be21118c6a6f ;;; verilog-mode.el ends here diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 24768d93e6a..f9d68af9317 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -4117,7 +4117,10 @@ The directory of the current source file is scanned." ;; performs all buffer local initializations ;;;###autoload -(defun vhdl-mode () +(define-derived-mode vhdl-mode prog-mode + '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/")) + (vhdl-electric-mode "e") + (vhdl-stutter-mode "s")) "Major mode for editing VHDL code. Usage: @@ -4650,26 +4653,13 @@ Key bindings: ------------- \\{vhdl-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'vhdl-mode) - (setq mode-name '("VHDL" - (vhdl-electric-mode "/" (vhdl-stutter-mode "/")) - (vhdl-electric-mode "e") - (vhdl-stutter-mode "s"))) - - ;; set maps and tables - (use-local-map vhdl-mode-map) - (set-syntax-table vhdl-mode-syntax-table) - (setq local-abbrev-table vhdl-mode-abbrev-table) + :abbrev-table vhdl-mode-abbrev-table ;; set local variables (set (make-local-variable 'paragraph-start) "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)") (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'require-final-newline) - (if vhdl-emacs-22 mode-require-final-newline t)) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) (set (make-local-variable 'comment-start) "--") @@ -4686,8 +4676,7 @@ Key bindings: ;; setup the comment indent variable in a Emacs version portable way ;; ignore any byte compiler warnings you might get here (when (boundp 'comment-indent-function) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'vhdl-comment-indent)) + (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) ;; initialize font locking (set (make-local-variable 'font-lock-defaults) @@ -4731,12 +4720,7 @@ Key bindings: (vhdl-ps-print-init) (vhdl-write-file-hooks-init) (message "VHDL Mode %s.%s" vhdl-version - (if noninteractive "" " See menu for documentation and release notes.")) - - ;; run hooks - (if vhdl-emacs-22 - (run-mode-hooks 'vhdl-mode-hook) - (run-hooks 'vhdl-mode-hook))) + (if noninteractive "" " See menu for documentation and release notes."))) (defun vhdl-activate-customizations () "Activate all customizations on local variables." @@ -4754,10 +4738,10 @@ Key bindings: (defun vhdl-write-file-hooks-init () "Add/remove hooks when buffer is saved." (if vhdl-modify-date-on-saving - (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror) - (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)) - (make-local-variable 'after-save-hook) - (add-hook 'after-save-hook 'vhdl-add-modified-file)) + (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror nil t) + (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t)) + (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) + (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) (defun vhdl-process-command-line-option (option) "Process command line options for VHDL Mode." @@ -5271,13 +5255,12 @@ argument. The styles are chosen from the `vhdl-style-alist' variable." (lambda (varentry) (let ((var (car varentry)) (val (cdr varentry))) - (and local - (make-local-variable var)) ;; special case for vhdl-offsets-alist (if (not (eq var 'vhdl-offsets-alist)) - (set var val) + (set (if local (make-local-variable var) var) val) ;; reset vhdl-offsets-alist to the default value first - (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)) + (set (if local (make-local-variable var) var) + (copy-alist vhdl-offsets-alist-default)) ;; now set the langelems that are different (mapcar (function @@ -7269,7 +7252,7 @@ indentation is done before aligning." (save-excursion (goto-char begin) (let (element - (eol (save-excursion (progn (end-of-line) (point))))) + (eol (point-at-eol))) (setq element (nth 0 copy)) (when (and (or (and (listp (car element)) (memq major-mode (car element))) @@ -7295,7 +7278,7 @@ the token in MATCH." ;; Determine the greatest whitespace distance to the alignment ;; character (goto-char begin) - (setq eol (progn (end-of-line) (point)) + (setq eol (point-at-eol) bol (setq begin (progn (beginning-of-line) (point)))) (while (< bol end) (save-excursion @@ -7306,13 +7289,13 @@ the token in MATCH." (setq max distance)))) (forward-line) (setq bol (point) - eol (save-excursion (end-of-line) (point))) + eol (point-at-eol)) (setq lines (1+ lines))) ;; Now insert enough maxs to push each assignment operator to ;; the same column. We need to use 'lines' as a counter, since ;; the location of the mark may change (goto-char (setq bol begin)) - (setq eol (save-excursion (end-of-line) (point))) + (setq eol (point-at-eol)) (while (> lines 0) (when (and (re-search-forward match eol t) (not (vhdl-in-literal))) @@ -7324,7 +7307,7 @@ the token in MATCH." (beginning-of-line) (forward-line) (setq bol (point) - eol (save-excursion (end-of-line) (point))) + eol (point-at-eol)) (setq lines (1- lines)))))) (defun vhdl-align-region-groups (beg end &optional spacing @@ -7988,7 +7971,7 @@ buffer." (forward-char) (vhdl-forward-syntactic-ws)) (goto-char end) - (when (> pos (save-excursion (end-of-line) (point))) + (when (> pos (point-at-eol)) (error "ERROR: Not within a generic/port clause")) ;; delete closing parenthesis on separate line (not supported style) (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) @@ -12115,9 +12098,7 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." "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 +12115,7 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." "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))))) @@ -12503,10 +12483,10 @@ File statistics: \"%s\"\n\ (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)" 'vhdl-hs-forward-sexp-func nil) hs-special-modes-alist))) - (make-local-variable 'hs-minor-mode-hook) + (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) (if vhdl-hide-all-init - (add-hook 'hs-minor-mode-hook 'hs-hide-all) - (remove-hook 'hs-minor-mode-hook 'hs-hide-all)) + (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) + (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) (hs-minor-mode arg) (force-mode-line-update))) ; hack to update menu bar @@ -12973,8 +12953,8 @@ This does background highlighting of translate-off regions.") (if (featurep 'xemacs) (when (boundp 'ps-print-color-p) (vhdl-ps-print-settings)) - (make-local-variable 'ps-print-hook) - (add-hook 'ps-print-hook 'vhdl-ps-print-settings))) + (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) + (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -15916,7 +15896,7 @@ current project/directory." &optional insert-conf) "Generate block configuration for architecture." (let ((margin (current-indentation)) - (beg (save-excursion (beginning-of-line) (point))) + (beg (point-at-bol)) ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) ;; insert block configuration (for architecture) (vhdl-insert-keyword "FOR ") (insert arch-name "\n") @@ -16977,5 +16957,4 @@ to visually support naming conventions.") (provide 'vhdl-mode) -;; arch-tag: 780d7073-9b5d-4c6c-b0d8-26b28783aba3 ;;; vhdl-mode.el ends here diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 469786e04dd..e06dbf46a9a 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -154,7 +154,7 @@ mouse-3: go to end") :type 'sexp) ;;;###autoload (put 'which-func-format 'risky-local-variable t) -(defvar which-func-imenu-joiner-function #'last +(defvar which-func-imenu-joiner-function (lambda (x) (car (last x))) "Function to join together multiple levels of imenu nomenclature. Called with a single argument, a list of strings giving the names of the menus we had to traverse to get to the item. Returns a @@ -198,7 +198,7 @@ It creates the Imenu index for the buffer, if necessary." (or (eq which-func-modes t) (member major-mode which-func-modes)))) - (condition-case nil + (condition-case err (if (and which-func-mode (not (member major-mode which-func-non-auto-modes)) (or (null which-func-maxout) @@ -207,6 +207,7 @@ It creates the Imenu index for the buffer, if necessary." (setq imenu--index-alist (save-excursion (funcall imenu-create-index-function)))) (error + (message "which-func-ff-hook error: %S" err) (setq which-func-mode nil)))) (defun which-func-update () @@ -225,7 +226,7 @@ It creates the Imenu index for the buffer, if necessary." (force-mode-line-update))) (error (setq which-func-mode nil) - (error "Error in which-func-update: %s" info)))))) + (error "Error in which-func-update: %S" info)))))) ;;;###autoload (defalias 'which-func-mode 'which-function-mode) @@ -242,6 +243,9 @@ continuously displayed in the mode line, in certain major modes. With prefix ARG, turn Which Function mode on if arg is positive, and off otherwise." :global t :group 'which-func + (when (timerp which-func-update-timer) + (cancel-timer which-func-update-timer)) + (setq which-func-update-timer nil) (if which-function-mode ;;Turn it on (progn @@ -253,9 +257,6 @@ and off otherwise." (or (eq which-func-modes t) (member major-mode which-func-modes)))))) ;; Turn it off - (when (timerp which-func-update-timer) - (cancel-timer which-func-update-timer)) - (setq which-func-update-timer nil) (dolist (buf (buffer-list)) (with-current-buffer buf (setq which-func-mode nil))))) @@ -282,8 +283,7 @@ If no function name is found, return nil." (null which-function-imenu-failed)) (imenu--make-index-alist t) (unless imenu--index-alist - (make-local-variable 'which-function-imenu-failed) - (setq which-function-imenu-failed t))) + (set (make-local-variable 'which-function-imenu-failed) t))) ;; If we have an index alist, use it. (when (and (null name) (boundp 'imenu--index-alist) imenu--index-alist) @@ -294,29 +294,31 @@ If no function name is found, return nil." ;; ("submenu" ("name" . marker) ... ). The list can be ;; arbitrarily nested. (while (or alist imstack) - (if alist - (progn - (setq pair (car-safe alist) - alist (cdr-safe alist)) - - (cond ((atom pair)) ; skip anything not a cons - - ((imenu--subalist-p pair) - (setq imstack (cons alist imstack) - namestack (cons (car pair) namestack) - alist (cdr pair))) - - ((number-or-marker-p (setq mark (cdr pair))) - (if (>= (setq offset (- (point) mark)) 0) - (if (< offset minoffset) ; find the closest item - (setq minoffset offset - name (funcall - which-func-imenu-joiner-function - (reverse (cons (car pair) - namestack))))))))) - (setq alist (car imstack) - namestack (cdr namestack) - imstack (cdr imstack)))))) + (if (null alist) + (setq alist (car imstack) + namestack (cdr namestack) + imstack (cdr imstack)) + + (setq pair (car-safe alist) + alist (cdr-safe alist)) + + (cond + ((atom pair)) ; Skip anything not a cons. + + ((imenu--subalist-p pair) + (setq imstack (cons alist imstack) + namestack (cons (car pair) namestack) + alist (cdr pair))) + + ((number-or-marker-p (setq mark (cdr pair))) + (when (and (>= (setq offset (- (point) mark)) 0) + (< offset minoffset)) ; Find the closest item. + (setq minoffset offset + name (if (null which-func-imenu-joiner-function) + (car pair) + (funcall + which-func-imenu-joiner-function + (reverse (cons (car pair) namestack)))))))))))) ;; Try using add-log support. (when (and (null name) (boundp 'add-log-current-defun-function) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 0324bc3c5b2..f83a67f4adf 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -186,8 +186,7 @@ With argument, asks for a command line." (setq-default xscheme-process-command-line command-line) (switch-to-buffer (xscheme-start-process command-line process-name buffer-name)) - (make-local-variable 'xscheme-process-command-line) - (setq xscheme-process-command-line command-line)) + (set (make-local-variable 'xscheme-process-command-line) command-line)) (defun xscheme-read-command-line (arg) (let ((default @@ -278,13 +277,11 @@ With argument, asks for a command line." xscheme-buffer-name t))) (let ((process-name (verify-xscheme-buffer buffer-name t))) - (make-local-variable 'xscheme-buffer-name) - (setq xscheme-buffer-name buffer-name) - (make-local-variable 'xscheme-process-name) - (setq xscheme-process-name process-name) - (make-local-variable 'xscheme-runlight) - (setq xscheme-runlight (with-current-buffer buffer-name - xscheme-runlight)))) + (set (make-local-variable 'xscheme-buffer-name) buffer-name) + (set (make-local-variable 'xscheme-process-name) process-name) + (set (make-local-variable 'xscheme-runlight) + (with-current-buffer buffer-name + xscheme-runlight)))) (defun local-clear-scheme-interaction-buffer () "Make the current buffer use the default scheme interaction buffer." @@ -386,21 +383,19 @@ Entry to this mode calls the value of scheme-interaction-mode-hook with no args, if that value is non-nil. Likewise with the value of scheme-mode-hook. scheme-interaction-mode-hook is called after scheme-mode-hook." + ;; FIXME: Use define-derived-mode. (interactive "P") (if (not preserve) (let ((previous-mode major-mode)) (kill-all-local-variables) - (make-local-variable 'xscheme-previous-mode) - (make-local-variable 'xscheme-buffer-name) (make-local-variable 'xscheme-process-name) (make-local-variable 'xscheme-previous-process-state) (make-local-variable 'xscheme-runlight-string) (make-local-variable 'xscheme-runlight) - (make-local-variable 'xscheme-last-input-end) - (setq xscheme-previous-mode previous-mode) + (set (make-local-variable 'xscheme-previous-mode) previous-mode) (let ((buffer (current-buffer))) - (setq xscheme-buffer-name (buffer-name buffer)) - (setq xscheme-last-input-end (make-marker)) + (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer)) + (set (make-local-variable 'xscheme-last-input-end) (make-marker)) (let ((process (get-buffer-process buffer))) (if process (progn @@ -420,7 +415,7 @@ with no args, if that value is non-nil. (defun exit-scheme-interaction-mode () "Take buffer out of scheme interaction mode" (interactive) - (if (not (eq major-mode 'scheme-interaction-mode)) + (if (not (derived-mode-p 'scheme-interaction-mode)) (error "Buffer not in scheme interaction mode")) (let ((previous-state xscheme-previous-process-state)) (funcall xscheme-previous-mode) @@ -437,7 +432,7 @@ with no args, if that value is non-nil. (defun scheme-interaction-mode-initialize () (use-local-map scheme-interaction-mode-map) - (setq major-mode 'scheme-interaction-mode) + (setq major-mode 'scheme-interaction-mode) ;FIXME: Use define-derived-mode. (setq mode-name "Scheme Interaction")) (defun scheme-interaction-mode-commands (keymap) @@ -469,8 +464,8 @@ with no args, if that value is non-nil. (defun xscheme-enter-interaction-mode () (with-current-buffer (xscheme-process-buffer) - (if (not (eq major-mode 'scheme-interaction-mode)) - (if (eq major-mode 'scheme-debugger-mode) + (if (not (derived-mode-p 'scheme-interaction-mode)) + (if (derived-mode-p 'scheme-debugger-mode) (scheme-interaction-mode-initialize) (scheme-interaction-mode t))))) @@ -494,7 +489,7 @@ Commands: (defun scheme-debugger-mode-initialize () (use-local-map scheme-debugger-mode-map) - (setq major-mode 'scheme-debugger-mode) + (setq major-mode 'scheme-debugger-mode) ;FIXME: Use define-derived-mode. (setq mode-name "Scheme Debugger")) (defun scheme-debugger-mode-commands (keymap) @@ -518,9 +513,9 @@ Commands: (defun xscheme-enter-debugger-mode (prompt-string) (with-current-buffer (xscheme-process-buffer) - (if (not (eq major-mode 'scheme-debugger-mode)) + (if (not (derived-mode-p 'scheme-debugger-mode)) (progn - (if (not (eq major-mode 'scheme-interaction-mode)) + (if (not (derived-mode-p 'scheme-interaction-mode)) (scheme-interaction-mode t)) (scheme-debugger-mode-initialize))))) @@ -528,7 +523,7 @@ Commands: (let ((buffer (xscheme-process-buffer))) (and buffer (with-current-buffer buffer - (eq major-mode 'scheme-debugger-mode))))) + (derived-mode-p 'scheme-debugger-mode))))) ;;;; Evaluation Commands @@ -550,7 +545,7 @@ The strings are concatenated and terminated by a newline." (defun xscheme-send-string-1 (strings) (let ((string (apply 'concat strings))) (xscheme-send-string-2 string) - (if (eq major-mode 'scheme-interaction-mode) + (if (derived-mode-p 'scheme-interaction-mode) (xscheme-insert-expression string)))) (defun xscheme-send-string-2 (string) @@ -701,12 +696,7 @@ parse an expression from the beginning of the line and send that instead." "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 +1214,4 @@ the remaining input.") (provide 'xscheme) -;; arch-tag: cfc14adc-2917-409e-ad16-432e8d0017de ;;; xscheme.el ends here diff --git a/lisp/ps-print.el b/lisp/ps-print.el index c9036a313cb..885fe68be26 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1466,12 +1466,9 @@ Please send all bug fixes and enhancements to (require 'lpr) -(or (featurep 'lisp-float-type) - (error "`ps-print' requires floating point support")) - - (if (featurep 'xemacs) - () + (or (featurep 'lisp-float-type) + (error "`ps-print' requires floating point support")) (unless (and (boundp 'emacs-major-version) (>= emacs-major-version 23)) (error "`ps-print' only supports Emacs 23 and higher"))) @@ -6726,5 +6723,4 @@ Finish printing job for multi-byte chars. (provide 'ps-print) -;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579 ;;; ps-print.el ends here diff --git a/lisp/repeat.el b/lisp/repeat.el index 86484ec68d6..abab47e7dc8 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -335,7 +335,7 @@ recently executed command not bound to an input event\"." (setq real-last-command 'repeat) (setq repeat-undo-count 1) (unwind-protect - (while (let ((evt (read-event))) ;FIXME: read-key maybe? + (while (let ((evt (read-key))) ;; For clicks, we need to strip the meta-data to ;; check the underlying event name. (eq (or (car-safe evt) evt) diff --git a/lisp/replace.el b/lisp/replace.el index baea2820433..28f3a845c2a 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -532,6 +532,9 @@ which will run faster and will not set the mark or print anything." Maximum length of the history list is determined by the value of `history-length', which see.") +(defvar occur-collect-regexp-history '("\\1") + "History of regexp for occur's collect operation") + (defun read-regexp (prompt &optional default-value) "Read regexp as a string using the regexp history and some useful defaults. Prompt for a regular expression with PROMPT (without a colon and @@ -1007,10 +1010,25 @@ which means to discard all text properties." :version "22.1") (defun occur-read-primary-args () - (list (read-regexp "List lines matching regexp" - (car regexp-history)) - (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) + (let* ((perform-collect (consp current-prefix-arg)) + (regexp (read-regexp (if perform-collect + "Collect strings matching regexp" + "List lines matching regexp") + (car regexp-history)))) + (list regexp + (if perform-collect + ;; Perform collect operation + (if (zerop (regexp-opt-depth regexp)) + ;; No subexpression so collect the entire match. + "\\&" + ;; Get the regexp for collection pattern. + (let ((default (car occur-collect-regexp-history))) + (read-string + (format "Regexp to collect (default %s): " default) + nil 'occur-collect-regexp-history default))) + ;; Otherwise normal occur takes numerical prefix argument. + (when current-prefix-arg + (prefix-numeric-value current-prefix-arg)))))) (defun occur-rename-buffer (&optional unique-p interactive-p) "Rename the current *Occur* buffer to *Occur: original-buffer-name*. @@ -1043,7 +1061,18 @@ It serves as a menu to find any of the occurrences in this buffer. \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. If REGEXP contains upper case characters (excluding those preceded by `\\') -and `search-upper-case' is non-nil, the matching is case-sensitive." +and `search-upper-case' is non-nil, the matching is case-sensitive. + +When NLINES is a string or when the function is called +interactively with prefix argument without a number (`C-u' alone +as prefix) the matching strings are collected into the `*Occur*' +buffer by using NLINES as a replacement regexp. NLINES may +contain \\& and \\N which convention follows `replace-match'. +For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and +\"\\1\" for NLINES collects all the function names in a lisp +program. When there is no parenthesized subexpressions in REGEXP +the entire match is collected. In any case the searched buffers +are not modified." (interactive (occur-read-primary-args)) (occur-1 regexp nlines (list (current-buffer)))) @@ -1125,20 +1154,43 @@ See also `multi-occur'." (setq occur-buf (get-buffer-create buf-name)) (with-current-buffer occur-buf - (occur-mode) + (if (stringp nlines) + (fundamental-mode) ;; This is for collect opeartion. + (occur-mode)) (let ((inhibit-read-only t) ;; Don't generate undo entries for creation of the initial contents. (buffer-undo-list t)) (erase-buffer) - (let ((count (occur-engine - regexp active-bufs occur-buf - (or nlines list-matching-lines-default-context-lines) - (if (and case-fold-search search-upper-case) - (isearch-no-upper-case-p regexp t) - case-fold-search) - list-matching-lines-buffer-name-face - nil list-matching-lines-face - (not (eq occur-excluded-properties t))))) + (let ((count + (if (stringp nlines) + ;; Treat nlines as a regexp to collect. + (let ((bufs active-bufs) + (count 0)) + (while bufs + (with-current-buffer (car bufs) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + ;; Insert the replacement regexp. + (let ((str (match-substitute-replacement nlines))) + (if str + (with-current-buffer occur-buf + (insert str) + (setq count (1+ count)) + (or (zerop (current-column)) + (insert "\n")))))))) + (setq bufs (cdr bufs))) + count) + ;; Perform normal occur. + (occur-engine + regexp active-bufs occur-buf + (or nlines list-matching-lines-default-context-lines) + (if (and case-fold-search search-upper-case) + (isearch-no-upper-case-p regexp t) + case-fold-search) + list-matching-lines-buffer-name-face + nil list-matching-lines-face + (not (eq occur-excluded-properties t)))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) (message "Searched %d buffer%s%s; %s match%s%s" diff --git a/lisp/reposition.el b/lisp/reposition.el index 9bc00795fe1..f6699f8c088 100644 --- a/lisp/reposition.el +++ b/lisp/reposition.el @@ -1,7 +1,7 @@ ;;; reposition.el --- center a Lisp function or comment on the screen -;; Copyright (C) 1991, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael D. Ernst <mernst@theory.lcs.mit.edu> ;; Created: Jan 1991 @@ -58,7 +58,7 @@ visible (if point is in code and it could not be made so, or if only comments, including the first comment line, are visible), or to make the first comment line visible (if point is in a comment)." (interactive "P") - (let* (;; (here (save-excursion (beginning-of-line) (point))) + (let* (;; (here (line-beginning-position)) (here (point)) ;; change this name once I've gotten rid of references to ht. ;; this is actually the number of the last screen line @@ -193,5 +193,4 @@ first comment line visible (if point is in a comment)." (provide 'reposition) -;; arch-tag: 79487039-3bd7-4ab5-a3e8-ecf3b4919010 ;;; reposition.el ends here diff --git a/lisp/select.el b/lisp/select.el index 3e9cd2d5d53..0f43ce05822 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -1,12 +1,11 @@ ;;; select.el --- lisp portion of standard selection support +;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. + ;; Maintainer: FSF ;; Keywords: internal -;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. -;; Based partially on earlier release by Lucid. - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -24,11 +23,20 @@ ;;; Commentary: +;; Based partially on earlier release by Lucid. + ;;; Code: (defcustom selection-coding-system nil - "Coding system for communicating with other X clients. + "Coding system for communicating with other programs. +For MS-Windows and MS-DOS: +When sending or receiving text via selection and clipboard, the text +is encoded or decoded by this coding system. The default value is +the current system default encoding on 9x/Me, `utf-16le-dos' +\(Unicode) on NT/W2K/XP, and `iso-latin-1-dos' on MS-DOS. + +For X Windows: When sending text via selection and clipboard, if the target data-type matches with the type of this coding system, it is used for encoding the text. Otherwise (including the case that this @@ -58,17 +66,18 @@ The default value is nil." (set symbol value))) (defvar next-selection-coding-system nil - "Coding system for the next communication with other X clients. + "Coding system for the next communication with other programs. Usually, `selection-coding-system' is used for communicating with -other X clients. But, if this variable is set, it is used for -the next communication only. After the communication, this -variable is set to nil.") +other programs (X Windows clients or MS Windows programs). But, if this +variable is set, it is used for the next communication only. +After the communication, this variable is set to nil.") (declare-function x-get-selection-internal "xselect.c" (selection-symbol target-type &optional time-stamp)) -;; This is for temporary compatibility with pre-release Emacs 19. -(defalias 'x-selection 'x-get-selection) +;; Only declared obsolete in 23.3. +(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") + (defun x-get-selection (&optional type data-type) "Return the value of an X Windows selection. The argument TYPE (default `PRIMARY') says which selection, @@ -380,5 +389,4 @@ This function returns the string \"emacs\"." (provide 'select) -;; arch-tag: bb634f97-8a3b-4b0a-b940-f6e09982328c ;;; select.el ends here diff --git a/lisp/server.el b/lisp/server.el index bc49087f464..e3af82231ae 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -110,8 +110,19 @@ If set, the server accepts remote connections; otherwise it is local." (string :tag "Name or IP address") (const :tag "Local" nil)) :version "22.1") +;;;###autoload (put 'server-host 'risky-local-variable t) +(defcustom server-port nil + "The port number that the server process should listen on." + :group 'server + :type '(choice + (string :tag "Port number") + (const :tag "Random" nil)) + :version "24.1") +;;;###autoload +(put 'server-port 'risky-local-variable t) + (defcustom server-auth-dir (locate-user-emacs-file "server/") "Directory for server authentication files. @@ -122,6 +133,7 @@ directory residing in a NTFS partition instead." :group 'server :type 'directory :version "22.1") +;;;###autoload (put 'server-auth-dir 'risky-local-variable t) (defcustom server-raise-frame t @@ -486,7 +498,7 @@ See variable `server-auth-dir' for details." (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 @@ -496,7 +508,10 @@ Emacs distribution as your standard \"editor\". 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") @@ -504,12 +519,14 @@ To force-start a server, do \\[server-force-delete] and then ;; 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 @@ -548,7 +565,7 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") (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 @@ -564,7 +581,7 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") ;; The other args depend on the kind of socket used. (if server-use-tcp (list :family 'ipv4 ;; We're not ready for IPv6 yet - :service t + :service (or server-port t) :host (or server-host 'local) :plist '(:authenticated nil)) (list :family 'local @@ -589,6 +606,11 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") " " (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 t t)) + ;;;###autoload (defun server-force-delete (&optional name) "Unconditionally delete connection file for server NAME. @@ -1473,5 +1495,4 @@ only these files will be asked to be saved." (provide 'server) -;; arch-tag: 1f7ecb42-f00a-49f8-906d-61995d84c8d6 ;;; server.el ends here diff --git a/lisp/shell.el b/lisp/shell.el index 6cb9a511101..815add76502 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1,7 +1,8 @@ ;;; shell.el --- specialized comint.el for running the shell -;; Copyright (C) 1988, 1993, 1994, 1995, 1996, 1997, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Olin Shivers <shivers@cs.cmu.edu> ;; Simon Marshall <simon@gnu.org> @@ -367,6 +368,17 @@ Thus, this does not include the shell's current directory.") ;;; Basic Procedures +(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'." + :group 'shell + :type '(choice (const nil) regexp)) + (put 'shell-mode 'mode-class 'special) (define-derived-mode shell-mode comint-mode "Shell" @@ -471,6 +483,10 @@ buffer." (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) @@ -549,13 +565,19 @@ Otherwise, one argument `-i' is passed to the shell. (generate-new-buffer-name "*shell*")) (if (file-remote-p default-directory) ;; It must be possible to declare a local default-directory. + ;; FIXME: This can't be right: it changes the default-directory + ;; of the current-buffer rather than of the *shell* buffer. (setq default-directory (expand-file-name (read-file-name "Default directory: " default-directory default-directory t nil 'file-directory-p)))))))) (require 'ansi-color) - (setq buffer (get-buffer-create (or buffer "*shell*"))) + (setq buffer (if (or buffer (not (derived-mode-p 'shell-mode)) + (comint-check-proc (current-buffer))) + (get-buffer-create (or buffer "*shell*")) + ;; If the current buffer is a dead shell buffer, use it. + (current-buffer))) ;; Pop to buffer, so that the buffer's window will be correctly set ;; when we call comint (so that comint sets the COLUMNS env var properly). (pop-to-buffer buffer) @@ -618,6 +640,20 @@ Otherwise, one argument `-i' is passed to the shell. ;; replace it with a process filter that watches for and strips out ;; these messages. +(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. @@ -700,7 +736,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." (defun shell-process-popd (arg) (let ((num (or (shell-extract-num arg) 0))) (cond ((and num (= num 0) shell-dirstack) - (shell-cd (car shell-dirstack)) + (shell-cd (shell-prefixed-directory-name (car shell-dirstack))) (setq shell-dirstack (cdr shell-dirstack)) (shell-dirstack-message)) ((and num (> num 0) (<= num (length shell-dirstack))) @@ -928,7 +964,7 @@ Copy Shell environment variable to Emacs: "))) "Move forward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." (interactive "p") - (let ((limit (save-excursion (end-of-line nil) (point)))) + (let ((limit (line-end-position))) (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+") limit 'move arg) (skip-syntax-backward " ")))) @@ -1111,5 +1147,4 @@ Returns t if successful." (provide 'shell) -;; arch-tag: bcb5f12a-c1f4-4aea-a809-2504bd5bd797 ;;; shell.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index 5c0615e08c4..da8ac55c01d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1,8 +1,8 @@ ;;; simple.el --- basic editing commands for Emacs -;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -441,7 +441,9 @@ Other major modes are defined by comparison with this one." (define-derived-mode prog-mode fundamental-mode "Prog" "Major mode for editing programming language source code." (set (make-local-variable 'require-final-newline) mode-require-final-newline) - (set (make-local-variable 'parse-sexp-ignore-comments) t)) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + ;; Any programming language is always written left to right. + (setq bidi-paragraph-direction 'left-to-right)) ;; Making and deleting lines. @@ -512,7 +514,7 @@ With arg N, insert N newlines." (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) @@ -759,10 +761,14 @@ If BACKWARD-ONLY is non-nil, only delete them before point." (constrain-to-field nil orig-pos))))) (defun just-one-space (&optional n) - "Delete all spaces and tabs around point, leaving one space (or N spaces)." + "Delete all spaces and tabs around point, leaving one space (or N spaces). +If N is negative, deletes carriage return and linefeed characters as well." (interactive "*p") - (let ((orig-pos (point))) - (skip-chars-backward " \t") + (unless n (setq n 1)) + (let ((orig-pos (point)) + (skip-characters (if (< n 0) " \t\n\r" " \t")) + (n (abs n))) + (skip-chars-backward skip-characters) (constrain-to-field nil orig-pos) (dotimes (i (or n 1)) (if (= (following-char) ?\s) @@ -771,7 +777,7 @@ If BACKWARD-ONLY is non-nil, only delete them before point." (delete-region (point) (progn - (skip-chars-forward " \t") + (skip-chars-forward skip-characters) (constrain-to-field nil orig-pos t))))) (defun beginning-of-buffer (&optional arg) @@ -973,6 +979,21 @@ rather than line counts." (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") @@ -2975,11 +2996,6 @@ If `interprogram-cut-function' is non-nil, apply it to STRING. Optional second argument REPLACE non-nil means that STRING will replace the front of the kill ring, rather than being added to the list. -Optional third arguments YANK-HANDLER controls how the STRING is later -inserted into a buffer; see `insert-for-yank' for details. -When a yank handler is specified, STRING must be non-empty (the yank -handler, if non-nil, is stored as a `yank-handler' text property on STRING). - When `save-interprogram-paste-before-kill' and `interprogram-paste-function' are non-nil, saves the interprogram paste string(s) into `kill-ring' before STRING. @@ -3019,22 +3035,19 @@ argument should still be a \"useful\" string for such uses." (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function (funcall interprogram-cut-function string))) +(set-advertised-calling-convention + 'kill-new '(string &optional replace) "23.3") (defun kill-append (string before-p &optional yank-handler) "Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. -Optional third argument YANK-HANDLER, if non-nil, specifies the -yank-handler text property to be set on the combined kill ring -string. If the specified yank-handler arg differs from the -yank-handler property of the latest kill string, this function -adds the combined string to the kill ring as a new element, -instead of replacing the last kill with it. If `interprogram-cut-function' is set, pass the resulting kill to it." (let* ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) (or (= (length cur) 0) (equal yank-handler (get-text-property 0 'yank-handler cur))) yank-handler))) +(set-advertised-calling-convention 'kill-append '(string before-p) "23.3") (defcustom yank-pop-change-selection nil "If non-nil, rotating the kill ring changes the window system selection." @@ -3115,11 +3128,7 @@ Supply two arguments, character positions indicating the stretch of text Any command that calls this function is a \"kill command\". If the previous command was also a kill command, the text killed this time appends to the text killed last time -to make one entry in the kill ring. - -In Lisp code, optional third arg YANK-HANDLER, if non-nil, -specifies the yank-handler text property to be set on the killed -text. See `insert-for-yank'." +to make one entry in the kill ring." ;; Pass point first, then mark, because the order matters ;; when calling kill-append. (interactive (list (point) (mark))) @@ -3151,6 +3160,7 @@ text. See `insert-for-yank'." (barf-if-buffer-read-only) ;; If the buffer isn't read-only, the text is. (signal 'text-read-only (list (current-buffer))))))) +(set-advertised-calling-convention 'kill-region '(beg end) "23.3") ;; copy-region-as-kill no longer sets this-command, because it's confusing ;; to get two copies of the text when the user accidentally types M-w and @@ -3685,8 +3695,6 @@ a mistake; see the documentation of `set-mark'." (marker-position (mark-marker)) (signal 'mark-inactive nil))) -(declare-function x-selection-owner-p "xselect.c" (&optional selection)) - (defsubst deactivate-mark (&optional force) "Deactivate the mark by setting `mark-active' to nil. Unless FORCE is non-nil, this function does nothing if Transient @@ -4053,29 +4061,8 @@ Invoke \\[apropos-documentation] and type \"transient\" or \"mark.*active\" at the prompt, to see the documentation of commands which are sensitive to the Transient Mark mode." :global t - :init-value (not noninteractive) - :initialize 'custom-initialize-delay - :group 'editing-basics) - -;; The variable transient-mark-mode is ugly: it can take on special -;; values. Document these here. -(defvar transient-mark-mode t - "*Non-nil if Transient Mark mode is enabled. -See the command `transient-mark-mode' for a description of this minor mode. - -Non-nil also enables highlighting of the region whenever the mark is active. -The variable `highlight-nonselected-windows' controls whether to highlight -all windows or just the selected window. - -If the value is `lambda', that enables Transient Mark mode temporarily. -After any subsequent action that would normally deactivate the mark -\(such as buffer modification), Transient Mark mode is turned off. - -If the value is (only . OLDVAL), that enables Transient Mark mode -temporarily. After any subsequent point motion command that is not -shift-translated, or any other action that would normally deactivate -the mark (such as buffer modification), the value of -`transient-mark-mode' is set to OLDVAL.") + ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. + :variable transient-mark-mode) (defvar widen-automatically t "Non-nil means it is ok for commands to call `widen' when they want to. @@ -4497,7 +4484,7 @@ into account variable-width characters and line continuation." (let (new (old (point)) - (line-beg (save-excursion (beginning-of-line) (point))) + (line-beg (line-beginning-position)) (line-end ;; Compute the end of the line ;; ignoring effectively invisible newlines. @@ -4605,7 +4592,7 @@ and `current-column' to be able to ignore invisible text." ;; that will get us to the same place on the screen ;; but with a more reasonable buffer position. (goto-char normal-location) - (let ((line-beg (save-excursion (beginning-of-line) (point)))) + (let ((line-beg (line-beginning-position))) (while (and (not (bolp)) (invisible-p (1- (point)))) (goto-char (previous-char-property-change (point) line-beg)))))))) @@ -5083,16 +5070,12 @@ If optional arg REALLY-WORD is non-nil, it finds just a word." ;; 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))) @@ -6628,7 +6611,7 @@ See also `normal-erase-is-backspace'." (if enabled (progn - (define-key local-function-key-map [delete] [?\C-d]) + (define-key local-function-key-map [delete] [deletechar]) (define-key local-function-key-map [kp-delete] [?\C-d]) (define-key local-function-key-map [backspace] [?\C-?]) (dolist (b bindings) @@ -6764,5 +6747,4 @@ warning using STRING as the message.") (provide 'simple) -;; arch-tag: 24af67c0-2a49-44f6-b3b1-312d8b570dfd ;;; simple.el ends here diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 28798b1a3b2..0c3e0e8c413 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -1,7 +1,7 @@ ;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- coding: utf-8 -*- -;; Copyright (C) 1993, 1994, 1995, 1996, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1996, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer <occitan@esperanto.org> ;; Maintainer: FSF @@ -108,7 +108,7 @@ The list describes the most recent skeleton insertion, and its elements 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 @@ automatically, and you are prompted to fill in the variable parts."))) (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 @@ automatically, and you are prompted to fill in the variable parts."))) (signal 'quit t) prompt)) -(defun skeleton-internal-list (skeleton &optional str recursive) - (let* ((start (save-excursion (beginning-of-line) (point))) +(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 @@ automatically, and you are prompted to fill in the variable parts."))) (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 @@ automatically, and you are prompted to fill in the variable parts."))) (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 @@ automatically, and you are prompted to fill in the variable parts."))) ((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 @@ automatically, and you are prompted to fill in the variable parts."))) (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)) @@ -562,5 +576,4 @@ symmetrical ones, and the same character twice for the others." (provide 'skeleton) -;; arch-tag: ccad7bd5-eb5d-40de-9ded-900197215c3e ;;; skeleton.el ends here diff --git a/lisp/sort.el b/lisp/sort.el index a858ad1f8f7..d4bbf6df056 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -1,7 +1,7 @@ ;;; sort.el --- commands to sort text in an Emacs buffer -;; Copyright (C) 1986, 1987, 1994, 1995, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1987, 1994, 1995, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Howie Kaye ;; Maintainer: FSF @@ -361,8 +361,8 @@ the sort order." (if (eolp) (error "Line has too few fields: %s" (buffer-substring - (save-excursion (beginning-of-line) (point)) - (save-excursion (end-of-line) (point)))))) + (line-beginning-position) + (line-end-position))))) (end-of-line) ;; Skip back across - N - 1 fields. (let ((i (1- (- n)))) @@ -374,8 +374,8 @@ the sort order." (if (bolp) (error "Line has too few fields: %s" (buffer-substring - (save-excursion (beginning-of-line) (point)) - (save-excursion (end-of-line) (point))))) + (line-beginning-position) + (line-end-position)))) ;; Position at the front of the field ;; even if moving backwards. (skip-chars-backward "^ \t\n"))) @@ -559,5 +559,4 @@ From a program takes two point or marker arguments, BEG and END." (provide 'sort) -;; arch-tag: fbac12be-2a7b-4c8a-9665-264d61f70bd9 ;;; sort.el ends here diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 5e732b398f3..7413f73ee50 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1,7 +1,8 @@ ;;; speedbar --- quick access to files and tags in a frame ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: file, tags, tools @@ -1128,9 +1129,9 @@ in the selected file. (setq font-lock-keywords nil) ;; no font-locking please (setq truncate-lines t) (make-local-variable 'frame-title-format) - (setq frame-title-format (concat "Speedbar " speedbar-version)) - (setq case-fold-search nil) - (toggle-read-only 1) + (setq frame-title-format (concat "Speedbar " speedbar-version) + case-fold-search nil + buffer-read-only t) (speedbar-set-mode-line-format) ;; Add in our dframe hooks. (if speedbar-track-mouse-flag @@ -1471,7 +1472,7 @@ File style information is displayed with `speedbar-item-info'." (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0))) ;; Get the text (speedbar-message "Text: %s" (buffer-substring-no-properties - (point) (progn (end-of-line) (point)))))) + (point) (line-end-position))))) (defun speedbar-item-info () "Display info in the minibuffer about the button the mouse is over. @@ -1497,8 +1498,7 @@ instead of reading it from the speedbar buffer." Return nil if not applicable." (save-excursion (beginning-of-line) - (if (re-search-forward " [-+=]?> \\([^\n]+\\)" - (save-excursion(end-of-line)(point)) t) + (if (re-search-forward " [-+=]?> \\([^\n]+\\)" (line-end-position) t) (let* ((tag (match-string 1)) (attr (speedbar-line-token)) (item nil) @@ -1516,8 +1516,7 @@ Return nil if not applicable." (looking-at "\\([0-9]+\\):") (setq item (file-name-nondirectory (speedbar-line-directory))) (speedbar-message "Tag: %s in %s" tag item))) - (if (re-search-forward "{[+-]} \\([^\n]+\\)$" - (save-excursion(end-of-line)(point)) t) + (if (re-search-forward "{[+-]} \\([^\n]+\\)$" (line-end-position) t) (speedbar-message "Group of tags \"%s\"" (match-string 1)) (if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t) (let* ((detailtext (match-string 1)) @@ -1693,8 +1692,7 @@ variable `speedbar-obj-alist'." (speedbar-enable-update))) (defun speedbar-toggle-images () - "Toggle use of images in the speedbar frame. -Images are not available in Emacs 20 or earlier." + "Toggle use of images in the speedbar frame." (interactive) (setq speedbar-use-images (not speedbar-use-images)) (speedbar-refresh)) @@ -2061,8 +2059,7 @@ position to insert a new item, and that the new item will end with a CR." "Change the expansion button character to CHAR for the current line." (save-excursion (beginning-of-line) - (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line) - (point)) t) + (if (re-search-forward ":\\s-*.\\([-+?]\\)" (line-end-position) t) (speedbar-with-writable (goto-char (match-end 1)) (insert-char char 1 t) @@ -2851,9 +2848,7 @@ indicator, then do not add a space." (speedbar-with-writable (save-excursion (if (and replace-this - (re-search-forward replace-this (save-excursion (end-of-line) - (point)) - t)) + (re-search-forward replace-this (line-end-position) t)) (delete-region (match-beginning 0) (match-end 0)))) (end-of-line) (if (not (string= " " indicator-string)) @@ -2951,9 +2946,7 @@ the file being checked." (fn (buffer-substring-no-properties ;; Skip-chars: thanks ptype@dra.hmg.gb (point) (progn - (skip-chars-forward "^ " - (save-excursion (end-of-line) - (point))) + (skip-chars-forward "^ " (line-end-position)) (point)))) (fulln (concat f fn))) (if (<= 2 speedbar-verbosity-level) @@ -3025,9 +3018,7 @@ the file being checked." (fn (buffer-substring-no-properties ;; Skip-chars: thanks ptype@dra.hmg.gb (point) (progn - (skip-chars-forward "^ " - (save-excursion (end-of-line) - (point))) + (skip-chars-forward "^ " (line-end-position)) (point)))) (fulln (concat f fn))) (if (<= 2 speedbar-verbosity-level) @@ -3248,7 +3239,7 @@ directory with these items." ;; If this fails, then it is a non-standard click, and as such, ;; perfectly allowed. (if (re-search-forward "[]>?}] [^ ]" - (save-excursion (end-of-line) (point)) + (line-end-position) t) (progn (forward-char -1) @@ -3266,7 +3257,7 @@ With universal argument ARG, flush cached data." (condition-case nil (progn (re-search-forward ":\\s-*.\\+. " - (save-excursion (end-of-line) (point))) + (line-end-position)) (forward-char -2) (speedbar-do-function-pointer)) (error (speedbar-position-cursor-on-line))))) @@ -3283,7 +3274,7 @@ With universal argument ARG, flush cached data." (condition-case nil (progn (re-search-forward ":\\s-*.-. " - (save-excursion (end-of-line) (point))) + (line-end-position)) (forward-char -2) (speedbar-do-function-pointer)) (error (speedbar-position-cursor-on-line)))) @@ -3295,7 +3286,7 @@ With universal argument ARG, flush cached data." (condition-case nil (progn (re-search-forward ":\\s-*.[-+]. " - (save-excursion (end-of-line) (point))) + (line-end-position)) (forward-char -2) (speedbar-do-function-pointer)) (error (speedbar-position-cursor-on-line)))) @@ -3763,17 +3754,12 @@ The line should contain output from etags. Parse the output using the regular expression EXPR." (let* ((sym (if (stringp expr) (if (save-excursion - (re-search-forward expr (save-excursion - (end-of-line) - (point)) t)) + (re-search-forward expr (line-end-position) t)) (buffer-substring-no-properties (match-beginning 1) (match-end 1))) (funcall expr))) (pos (let ((j (re-search-forward "[\C-?\C-a]\\([0-9]+\\),\\([0-9]+\\)" - (save-excursion - (end-of-line) - (point)) - t))) + (line-end-position) t))) (if (and j sym) (1+ (string-to-number (buffer-substring-no-properties (match-beginning 2) @@ -3786,7 +3772,7 @@ regular expression EXPR." (defun speedbar-parse-c-or-c++tag () "Parse a C or C++ tag, which tends to be a little complex." (save-excursion - (let ((bound (save-excursion (end-of-line) (point)))) + (let ((bound (line-end-position))) (cond ((re-search-forward "\C-?\\([^\C-a]+\\)\C-a" bound t) (buffer-substring-no-properties (match-beginning 1) (match-end 1))) @@ -3802,7 +3788,7 @@ regular expression EXPR." (defun speedbar-parse-tex-string () "Parse a Tex string. Only find data which is relevant." (save-excursion - (let ((bound (save-excursion (end-of-line) (point)))) + (let ((bound (line-end-position))) (cond ((re-search-forward "\\(\\(sub\\)*section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t) (buffer-substring-no-properties (match-beginning 0) (match-end 0))) @@ -3947,9 +3933,7 @@ Optional argument DEPTH specifies the current depth of the back search." (let* ((bn (speedbar-line-text)) (buffer (if bn (get-buffer bn)))) (if buffer - (if (save-excursion - (end-of-line) - (eq start (point))) + (if (eq start (line-end-position)) (or (with-current-buffer buffer default-directory) "") (buffer-file-name buffer)))))))) @@ -3981,14 +3965,10 @@ TEXT is the buffer's name, TOKEN and INDENT are unused." (beginning-of-line) ;; If this fails, then it is a non-standard click, and as such, ;; perfectly allowed - (if (re-search-forward "[]>?}] [^ ]" - (save-excursion (end-of-line) (point)) - t) + (if (re-search-forward "[]>?}] [^ ]" (line-end-position) t) (let ((text (progn (forward-char -1) - (buffer-substring (point) (save-excursion - (end-of-line) - (point)))))) + (buffer-substring (point) (line-end-position))))) (if (get-buffer text) (progn (set-buffer text) @@ -4004,14 +3984,11 @@ TEXT is the buffer's name, TOKEN and INDENT are unused." "Highlight the current line, unhighlighting a previously jumped to line." (speedbar-unhighlight-one-tag-line) (setq speedbar-highlight-one-tag-line - (speedbar-make-overlay (save-excursion (beginning-of-line) (point)) - (save-excursion (end-of-line) - (forward-char 1) - (point)))) + (speedbar-make-overlay (line-beginning-position) + (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." @@ -4142,5 +4119,4 @@ TEXT is the buffer's name, TOKEN and INDENT are unused." ;; run load-time hooks (run-hooks 'speedbar-load-hook) -;; arch-tag: 4477e6d1-f78c-48b9-a503-387d3c9767d5 ;;; speedbar ends here diff --git a/lisp/startup.el b/lisp/startup.el index aa791f2a04a..e85abe68f4c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,7 +1,7 @@ ;;; startup.el --- process Emacs shell arguments -;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -200,47 +200,47 @@ and VALUE is the value which is given to that frame parameter ;;("-bw" . x-handle-numeric-switch) ;;("-d" . x-handle-display) ;;("-display" . x-handle-display) - ("-name" 1 ns-handle-name-switch) - ("-title" 1 ns-handle-switch title) - ("-T" 1 ns-handle-switch title) - ("-r" 0 ns-handle-switch reverse t) - ("-rv" 0 ns-handle-switch reverse t) - ("-reverse" 0 ns-handle-switch reverse t) - ("-fn" 1 ns-handle-switch font) - ("-font" 1 ns-handle-switch font) - ("-ib" 1 ns-handle-numeric-switch internal-border-width) + ("-name" 1 x-handle-name-switch) + ("-title" 1 x-handle-switch title) + ("-T" 1 x-handle-switch title) + ("-r" 0 x-handle-switch reverse t) + ("-rv" 0 x-handle-switch reverse t) + ("-reverse" 0 x-handle-switch reverse t) + ("-fn" 1 x-handle-switch font) + ("-font" 1 x-handle-switch font) + ("-ib" 1 x-handle-numeric-switch internal-border-width) ;;("-g" . x-handle-geometry) ;;("-geometry" . x-handle-geometry) - ("-fg" 1 ns-handle-switch foreground-color) - ("-foreground" 1 ns-handle-switch foreground-color) - ("-bg" 1 ns-handle-switch background-color) - ("-background" 1 ns-handle-switch background-color) -; ("-ms" 1 ns-handle-switch mouse-color) - ("-itype" 0 ns-handle-switch icon-type t) - ("-i" 0 ns-handle-switch icon-type t) - ("-iconic" 0 ns-handle-iconic icon-type t) + ("-fg" 1 x-handle-switch foreground-color) + ("-foreground" 1 x-handle-switch foreground-color) + ("-bg" 1 x-handle-switch background-color) + ("-background" 1 x-handle-switch background-color) +; ("-ms" 1 x-handle-switch mouse-color) + ("-itype" 0 x-handle-switch icon-type t) + ("-i" 0 x-handle-switch icon-type t) + ("-iconic" 0 x-handle-iconic icon-type t) ;;("-xrm" . x-handle-xrm-switch) - ("-cr" 1 ns-handle-switch cursor-color) - ("-vb" 0 ns-handle-switch vertical-scroll-bars t) - ("-hb" 0 ns-handle-switch horizontal-scroll-bars t) - ("-bd" 1 ns-handle-switch) - ;; ("--border-width" 1 ns-handle-numeric-switch border-width) + ("-cr" 1 x-handle-switch cursor-color) + ("-vb" 0 x-handle-switch vertical-scroll-bars t) + ("-hb" 0 x-handle-switch horizontal-scroll-bars t) + ("-bd" 1 x-handle-switch) + ;; ("--border-width" 1 x-handle-numeric-switch border-width) ;; ("--display" 1 ns-handle-display) - ("--name" 1 ns-handle-name-switch) - ("--title" 1 ns-handle-switch title) - ("--reverse-video" 0 ns-handle-switch reverse t) - ("--font" 1 ns-handle-switch font) - ("--internal-border" 1 ns-handle-numeric-switch internal-border-width) + ("--name" 1 x-handle-name-switch) + ("--title" 1 x-handle-switch title) + ("--reverse-video" 0 x-handle-switch reverse t) + ("--font" 1 x-handle-switch font) + ("--internal-border" 1 x-handle-numeric-switch internal-border-width) ;; ("--geometry" 1 ns-handle-geometry) - ("--foreground-color" 1 ns-handle-switch foreground-color) - ("--background-color" 1 ns-handle-switch background-color) - ("--mouse-color" 1 ns-handle-switch mouse-color) - ("--icon-type" 0 ns-handle-switch icon-type t) - ("--iconic" 0 ns-handle-iconic) + ("--foreground-color" 1 x-handle-switch foreground-color) + ("--background-color" 1 x-handle-switch background-color) + ("--mouse-color" 1 x-handle-switch mouse-color) + ("--icon-type" 0 x-handle-switch icon-type t) + ("--iconic" 0 x-handle-iconic) ;; ("--xrm" 1 ns-handle-xrm-switch) - ("--cursor-color" 1 ns-handle-switch cursor-color) - ("--vertical-scroll-bars" 0 ns-handle-switch vertical-scroll-bars t) - ("--border-color" 1 ns-handle-switch border-width)) + ("--cursor-color" 1 x-handle-switch cursor-color) + ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t) + ("--border-color" 1 x-handle-switch border-width)) "Alist of NS options. Each element has the form (NAME NUMARGS HANDLER FRAME-PARAM VALUE) @@ -411,34 +411,31 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (default-directory this-dir) (canonicalized (if (fboundp 'untranslated-canonical-name) (untranslated-canonical-name this-dir)))) - ;; The Windows version doesn't report meaningful inode - ;; numbers, so use the canonicalized absolute file name of the - ;; directory instead. + ;; The Windows version doesn't report meaningful inode numbers, so + ;; use the canonicalized absolute file name of the directory instead. (setq attrs (or canonicalized (nthcdr 10 (file-attributes this-dir)))) (unless (member attrs normal-top-level-add-subdirs-inode-list) (push attrs normal-top-level-add-subdirs-inode-list) (dolist (file contents) - ;; The lower-case variants of RCS and CVS are for DOS/Windows. - (unless (member file '("." ".." "RCS" "CVS" "rcs" "cvs")) - (when (and (string-match "\\`[[:alnum:]]" file) - ;; Avoid doing a `stat' when it isn't necessary - ;; because that can cause trouble when an NFS server - ;; is down. - (not (string-match "\\.elc?\\'" file)) - (file-directory-p file)) - (let ((expanded (expand-file-name file))) - (unless (file-exists-p (expand-file-name ".nosearch" - expanded)) - (setq pending (nconc pending (list expanded))))))))))) + (and (string-match "\\`[[:alnum:]]" file) + ;; The lower-case variants of RCS and CVS are for DOS/Windows. + (not (member file '("RCS" "CVS" "rcs" "cvs"))) + ;; Avoid doing a `stat' when it isn't necessary because + ;; that can cause trouble when an NFS server is down. + (not (string-match "\\.elc?\\'" file)) + (file-directory-p file) + (let ((expanded (expand-file-name file))) + (or (file-exists-p (expand-file-name ".nosearch" expanded)) + (setq pending (nconc pending (list expanded)))))))))) (normal-top-level-add-to-load-path (cdr (nreverse dirs))))) -;; This function is called from a subdirs.el file. -;; It assumes that default-directory is the directory -;; in which the subdirs.el file exists, -;; and it adds to load-path the subdirs of that directory -;; as specified in DIRS. Normally the elements of DIRS are relative. (defun normal-top-level-add-to-load-path (dirs) + "This function is called from a subdirs.el file. +It assumes that `default-directory' is the directory in which the +subdirs.el file exists, and it adds to `load-path' the subdirs of +that directory as specified in DIRS. Normally the elements of +DIRS are relative." (let ((tail load-path) (thisdir (directory-file-name default-directory))) (while (and tail @@ -466,9 +463,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; `user-full-name' is now known; reset its standard-value here. (put 'user-full-name 'standard-value (list (default-value 'user-full-name))) - ;; For root, preserve owner and group when editing files. - (if (equal (user-uid) 0) - (setq backup-by-copying-when-mismatch t)) ;; Look in each dir in load-path for a subdirs.el file. ;; If we find one, load it, which will add the appropriate subdirs ;; of that dir into load-path, @@ -618,8 +612,8 @@ function to this list. The function should take no arguments, and initialize the window system environment to prepare for opening the first frame (e.g. open a connection to an X server).") -;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) + "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc." (let (rest) (message "%S" args) (while (and args @@ -882,14 +876,15 @@ opening the first frame (e.g. open a connection to an X server).") ;; 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) @@ -898,7 +893,13 @@ opening the first frame (e.g. open a connection to an X server).") (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) @@ -1172,8 +1173,30 @@ the `--debug-init' option to view a complete error backtrace." (eq face-ignored-fonts old-face-ignored-fonts)) (clear-face-cache))) - ;; Load ELPA packages. - (and user-init-file package-enable-at-startup (package-initialize)) + ;; If any package directory exists, initialize the package system. + (and user-init-file + package-enable-at-startup + (catch 'package-dir-found + (let (dirs) + (if (boundp 'package-directory-list) + (setq dirs package-directory-list) + (dolist (f load-path) + (and (stringp f) + (equal (file-name-nondirectory f) "site-lisp") + (push (expand-file-name "elpa" f) dirs)))) + (push (if (boundp 'package-user-dir) + package-user-dir + (locate-user-emacs-file "elpa")) + dirs) + (dolist (dir dirs) + (when (file-directory-p dir) + (dolist (subdir (directory-files dir)) + (when (and (file-directory-p (expand-file-name subdir dir)) + ;; package-subdirectory-regexp from package.el + (string-match "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" + subdir)) + (throw 'package-dir-found t))))))) + (package-initialize)) (setq after-init-time (current-time)) (run-hooks 'after-init-hook) @@ -1563,21 +1586,26 @@ a face or button specification." (kill-buffer "*GNU Emacs*"))) " ") (when (or user-init-file custom-file) - (insert-button - " " - :on-glyph image-checkbox-checked - :off-glyph image-checkbox-unchecked - 'checked nil 'display image-checkbox-unchecked 'follow-link t - 'action (lambda (button) - (if (overlay-get button 'checked) - (progn (overlay-put button 'checked nil) - (overlay-put button 'display - (overlay-get button :off-glyph)) - (setq startup-screen-inhibit-startup-screen nil)) - (overlay-put button 'checked t) - (overlay-put button 'display - (overlay-get button :on-glyph)) - (setq startup-screen-inhibit-startup-screen t)))) + (let ((checked (create-image "checked.xpm" + nil nil :ascent 'center)) + (unchecked (create-image "unchecked.xpm" + nil nil :ascent 'center))) + (insert-button + " " + :on-glyph checked + :off-glyph unchecked + 'checked nil 'display unchecked 'follow-link t + 'action (lambda (button) + (if (overlay-get button 'checked) + (progn (overlay-put button 'checked nil) + (overlay-put button 'display + (overlay-get button :off-glyph)) + (setq startup-screen-inhibit-startup-screen + nil)) + (overlay-put button 'checked t) + (overlay-put button 'display + (overlay-get button :on-glyph)) + (setq startup-screen-inhibit-startup-screen t))))) (fancy-splash-insert :face '(variable-pitch (:height 0.9)) " Never show it again."))))) @@ -2354,5 +2382,4 @@ A fancy display is used on graphic displays, normal otherwise." (setq file (replace-match "/" t t file))) file)) -;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db ;;; startup.el ends here diff --git a/lisp/subr.el b/lisp/subr.el index 1503fbab14b..c79a69b221e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -960,7 +960,8 @@ and `event-end' functions." ((null spacing) (setq spacing 0))) (cons (/ (car pair) (frame-char-width frame)) - (/ (cdr pair) (+ (frame-char-height frame) spacing)))))))) + (- (/ (cdr pair) (+ (frame-char-height frame) spacing)) + (if (null header-line-format) 0 1)))))))) (defun posn-actual-col-row (position) "Return the actual column and row in POSITION, measured in characters. @@ -2821,7 +2822,7 @@ but which should be robust in the unexpected case that an error is signaled." (let ((err (make-symbol "err"))) `(condition-case-no-debug ,err (progn ,@body) - (error (message "Error: %s" ,err) nil)))) + (error (message "Error: %S" ,err) nil)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. @@ -3599,18 +3600,18 @@ convenience wrapper around `make-progress-reporter' and friends. ;;;; Comparing version strings. (defconst version-separator "." - "*Specify the string used to separate the version elements. + "Specify the string used to separate the version elements. Usually the separator is \".\", but it can be any other string.") (defconst version-regexp-alist - '(("^[-_+ ]?alpha$" . -3) - ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases - ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release - ("^[-_+ ]?beta$" . -2) + '(("^[-_+ ]?alpha$" . -3) + ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases + ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release + ("^[-_+ ]?beta$" . -2) ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1)) - "*Specify association between non-numeric version and its priority. + "Specify association between non-numeric version and its priority. This association is used to handle version string like \"1.0pre2\", \"0.9alpha1\", etc. It's used by `version-to-list' (which see) to convert the @@ -3704,7 +3705,7 @@ See documentation for `version-separator' and `version-regexp-alist'." (setq al (cdr al))) (cond (al (push (cdar al) lst)) - ;; Convert 22.3a to 22.3.1. + ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc. ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s) (push (- (aref (downcase (match-string 1 s)) 0) ?a -1) lst)) @@ -3760,7 +3761,7 @@ turn is higher than (1 -2), which is higher than (1 -3)." "Return t if L1, a list specification of a version, is lower or equal to L2. Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0), -etc. That is, the trailing zeroes are irrelevant. Also, integer +etc. That is, the trailing zeroes are insignificant. Also, integer list (1) is greater than (1 -1) which is greater than (1 -2) which is greater than (1 -3)." (while (and l1 l2 (= (car l1) (car l2))) @@ -3802,7 +3803,7 @@ which is higher than \"1alpha\"." "Return t if version V1 is lower (older) than or equal to V2. Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", -etc. That is, the trailing \".0\"s are insignificant.. Also, version +etc. That is, the trailing \".0\"s are insignificant. Also, version string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", which is higher than \"1alpha\"." (version-list-<= (version-to-list v1) (version-to-list v2))) @@ -3811,7 +3812,7 @@ which is higher than \"1alpha\"." "Return t if version V1 is equal to V2. Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", -etc. That is, the trailing \".0\"s are insignificant.. Also, version +etc. That is, the trailing \".0\"s are insignificant. Also, version string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", which is higher than \"1alpha\"." (version-list-= (version-to-list v1) (version-to-list v2))) diff --git a/lisp/term.el b/lisp/term.el index 80f5dcdc01a..9c511592165 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1,7 +1,8 @@ ;;; term.el --- general command interpreter in a window stuff -;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Per Bothner <per@bothner.com> ;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com> @@ -1798,15 +1799,11 @@ Returns t if successful." "Expand directory stack reference before point. See `term-replace-by-expanded-history'. Returns t if successful." (save-excursion - (let ((toend (- (save-excursion (end-of-line nil) (point)) (point))) + (let ((toend (- (line-end-position) (point))) (start (progn (term-bol nil) (point)))) (while (progn - (skip-chars-forward "^!^" - (save-excursion - (end-of-line nil) (- (point) toend))) - (< (point) - (save-excursion - (end-of-line nil) (- (point) toend)))) + (skip-chars-forward "^!^" (- (line-end-position) toend)) + (< (point) (- (line-end-position) toend))) ;; This seems a bit complex. We look for references such as !!, !-num, ;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^. ;; If that wasn't enough, the plings can be suffixed with argument @@ -2112,7 +2109,7 @@ Calls `term-get-old-input' to get old input." (defun term-skip-prompt () "Skip past the text matching regexp `term-prompt-regexp'. If this takes us past the end of the current line, don't skip at all." - (let ((eol (save-excursion (end-of-line) (point)))) + (let ((eol (line-end-position))) (when (and (looking-at term-prompt-regexp) (<= (match-end 0) eol)) (goto-char (match-end 0))))) @@ -2471,11 +2468,10 @@ See `term-prompt-regexp'." "Return string around `point' that starts the current line or nil." (save-excursion (let* ((point (point)) - (bol (progn (beginning-of-line) (point))) - (eol (progn (end-of-line) (point))) - (start (progn (goto-char point) - (and (search-backward "\"" bol t) - (1+ (point))))) + (bol (line-beginning-position)) + (eol (line-end-position)) + (start (and (search-backward "\"" bol t) + (1+ (point)))) (end (progn (goto-char point) (and (search-forward "\"" eol t) (1- (point)))))) @@ -2615,10 +2611,7 @@ See `term-prompt-regexp'." (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 @@ -3796,10 +3789,8 @@ if KIND is 1, erase from home to point; else erase from home to point-max." (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 @@ -4232,7 +4223,7 @@ Return t if this is a Unix-based system, where serial ports are 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) @@ -4534,5 +4525,4 @@ The return value may be nil for a special serial port." (provide 'term) -;; arch-tag: eee16bc8-2cd7-4147-9534-a5694752f716 ;;; term.el ends here diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index 25ba41a23c2..f43056976a2 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -1,7 +1,7 @@ ;;; common-win.el --- common part of handling window systems ;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: terminals @@ -25,54 +25,139 @@ ;;; Code: +(defcustom x-select-enable-clipboard t + "Non-nil means cutting and pasting uses the clipboard. +This is in addition to, but in preference to, the primary selection. + +Note that MS-Windows does not support selection types other than the +clipboard. (The primary selection that is set by Emacs is not +accessible to other programs on MS-Windows.) + +This variable is not used by the Nextstep port." + :type 'boolean + :group 'killing + ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not. + :version "24.1") + +(defvar x-last-selected-text) ; w32-fns.el +(declare-function w32-set-clipboard-data "w32select.c" + (string &optional ignored)) +(defvar ns-last-selected-text) ; ns-win.el +(declare-function ns-set-pasteboard "ns-win" (string)) + +(defun x-select-text (text) + "Select TEXT, a string, according to the window system. + +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. + +On MS-Windows, make TEXT the current selection. If +`x-select-enable-clipboard' is non-nil, copy the text to the +clipboard as well. + +On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard' +is not used)." + (cond ((eq system-type 'windows-nt) + (if x-select-enable-clipboard + (w32-set-clipboard-data text)) + (setq x-last-selected-text text)) + ((featurep 'ns) + ;; Don't send the pasteboard too much text. + ;; It becomes slow, and if really big it causes errors. + (ns-set-pasteboard text) + (setq ns-last-selected-text text)) + (t + ;; With multi-tty, this function may be called from a tty frame. + (when (eq (framep (selected-frame)) 'x) + (when x-select-enable-primary + (x-set-selection 'PRIMARY text) + (setq x-last-selected-text-primary text)) + (when x-select-enable-clipboard + (x-set-selection 'CLIPBOARD text) + (setq x-last-selected-text-clipboard text)))))) + +;;;; Function keys + +(defvar x-alternatives-map + (let ((map (make-sparse-keymap))) + ;; Map certain keypad keys into ASCII characters that people usually expect. + (define-key map [M-backspace] [?\M-\d]) + (define-key map [M-delete] [?\M-\d]) + (define-key map [M-tab] [?\M-\t]) + (define-key map [M-linefeed] [?\M-\n]) + (define-key map [M-clear] [?\M-\C-l]) + (define-key map [M-return] [?\M-\C-m]) + (define-key map [M-escape] [?\M-\e]) + (unless (featurep 'ns) + (define-key map [iso-lefttab] [backtab]) + (define-key map [S-iso-lefttab] [backtab])) + (and (or (eq system-type 'windows-nt) + (featurep 'ns)) + (define-key map [S-tab] [backtab])) + map) + "Keymap of possible alternative meanings for some keys.") + +(defun x-setup-function-keys (frame) + "Set up `function-key-map' on the graphical frame FRAME." + ;; Don't do this twice on the same display, or it would break + ;; normal-erase-is-backspace-mode. + (unless (terminal-parameter frame 'x-setup-function-keys) + ;; Map certain keypad keys into ASCII characters that people usually expect. + (with-selected-frame frame + (let ((map (copy-keymap x-alternatives-map))) + (set-keymap-parent map (keymap-parent local-function-key-map)) + (set-keymap-parent local-function-key-map map)) + (when (featurep 'ns) + (setq interprogram-cut-function 'x-select-text + interprogram-paste-function 'x-selection-value + system-key-alist + (list + ;; These are special "keys" used to pass events from C to lisp. + (cons (logior (lsh 0 16) 1) 'ns-power-off) + (cons (logior (lsh 0 16) 2) 'ns-open-file) + (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) + (cons (logior (lsh 0 16) 4) 'ns-drag-file) + (cons (logior (lsh 0 16) 5) 'ns-drag-color) + (cons (logior (lsh 0 16) 6) 'ns-drag-text) + (cons (logior (lsh 0 16) 7) 'ns-change-font) + (cons (logior (lsh 0 16) 8) 'ns-open-file-line) +;;; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) +;;; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) + (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) + (cons (logior (lsh 0 16) 12) 'ns-new-frame) + (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) + (cons (logior (lsh 0 16) 14) 'ns-show-prefs) + )))) + (set-terminal-parameter frame 'x-setup-function-keys t))) (defvar x-invocation-args) (defvar x-command-line-resources nil) ;; Handler for switches of the form "-switch value" or "-switch". -(defun x-handle-switch (switch) +(defun x-handle-switch (switch &optional numeric) (let ((aelt (assoc switch command-line-x-option-alist))) (if aelt - (let ((param (nth 3 aelt)) - (value (nth 4 aelt))) - (if value - (setq default-frame-alist - (cons (cons param value) - default-frame-alist)) - (setq default-frame-alist - (cons (cons param - (car x-invocation-args)) - default-frame-alist) - x-invocation-args (cdr x-invocation-args))))))) + (setq default-frame-alist + (cons (cons (nth 3 aelt) + (if numeric + (string-to-number (pop x-invocation-args)) + (or (nth 4 aelt) (pop x-invocation-args)))) + default-frame-alist))))) ;; Handler for switches of the form "-switch n" (defun x-handle-numeric-switch (switch) - (let ((aelt (assoc switch command-line-x-option-alist))) - (if aelt - (let ((param (nth 3 aelt))) - (setq default-frame-alist - (cons (cons param - (string-to-number (car x-invocation-args))) - default-frame-alist) - x-invocation-args - (cdr x-invocation-args)))))) + (x-handle-switch switch t)) ;; Handle options that apply to initial frame only (defun x-handle-initial-switch (switch) (let ((aelt (assoc switch command-line-x-option-alist))) (if aelt - (let ((param (nth 3 aelt)) - (value (nth 4 aelt))) - (if value - (setq initial-frame-alist - (cons (cons param value) - initial-frame-alist)) - (setq initial-frame-alist - (cons (cons param - (car x-invocation-args)) - initial-frame-alist) - x-invocation-args (cdr x-invocation-args))))))) + (setq initial-frame-alist + (cons (cons (nth 3 aelt) + (or (nth 4 aelt) (pop x-invocation-args))) + initial-frame-alist))))) ;; Make -iconic apply only to the initial frame! (defun x-handle-iconic (switch) @@ -85,15 +170,14 @@ (error "%s: missing argument to `%s' option" (invocation-name) switch)) (setq x-command-line-resources (if (null x-command-line-resources) - (car x-invocation-args) - (concat x-command-line-resources "\n" (car x-invocation-args)))) - (setq x-invocation-args (cdr x-invocation-args))) + (pop x-invocation-args) + (concat x-command-line-resources "\n" (pop x-invocation-args))))) (declare-function x-parse-geometry "frame.c" (string)) ;; Handle the geometry option (defun x-handle-geometry (switch) - (let* ((geo (x-parse-geometry (car x-invocation-args))) + (let* ((geo (x-parse-geometry (pop x-invocation-args))) (left (assq 'left geo)) (top (assq 'top geo)) (height (assq 'height geo)) @@ -114,8 +198,7 @@ (append initial-frame-alist '((user-position . t)) (if left (list left)) - (if top (list top))))) - (setq x-invocation-args (cdr x-invocation-args)))) + (if top (list top))))))) (defvar x-resource-name) @@ -125,9 +208,8 @@ (defun x-handle-name-switch (switch) (or (consp x-invocation-args) (error "%s: missing argument to `%s' option" (invocation-name) switch)) - (setq x-resource-name (car x-invocation-args) - x-invocation-args (cdr x-invocation-args)) - (setq initial-frame-alist (cons (cons 'name x-resource-name) + (setq x-resource-name (pop x-invocation-args) + initial-frame-alist (cons (cons 'name x-resource-name) initial-frame-alist))) (defvar x-display-name nil @@ -137,8 +219,7 @@ On X, the display name of individual X frames is recorded in the (defun x-handle-display (switch) "Handle -display DISPLAY option." - (setq x-display-name (car x-invocation-args) - x-invocation-args (cdr x-invocation-args)) + (setq x-display-name (pop x-invocation-args)) ;; Make subshell programs see the same DISPLAY value Emacs really uses. ;; Note that this isn't completely correct, since Emacs can use ;; multiple displays. However, there is no way to tell an already @@ -146,21 +227,25 @@ On X, the display name of individual X frames is recorded in the (setenv "DISPLAY" x-display-name)) (defun x-handle-args (args) - "Process the X-related command line options in ARGS. -This is done before the user's startup file is loaded. They are copied to -`x-invocation-args', from which the X-related things are extracted, first -the switch (e.g., \"-fg\") in the following code, and possible values -\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). -This function returns ARGS minus the arguments that have been processed." + "Process the X (or Nextstep) related command line options in ARGS. +This is done before the user's startup file is loaded. +Copies the options in ARGS to `x-invocation-args'. It then extracts +the X (or Nextstep) options according to the handlers defined in +`command-line-x-option-alist' (or `command-line-ns-option-alist'). +For example, `x-handle-switch' handles a switch like \"-fg\" and its +value \"black\". This function returns ARGS minus the arguments that +have been processed." ;; We use ARGS to accumulate the args that we don't handle here, to return. - (setq x-invocation-args args + (setq x-invocation-args args ; FIXME let-bind? args nil) (while (and x-invocation-args (not (equal (car x-invocation-args) "--"))) - (let* ((this-switch (car x-invocation-args)) + (let* ((this-switch (pop x-invocation-args)) (orig-this-switch this-switch) + (option-alist (if (featurep 'ns) + command-line-ns-option-alist + command-line-x-option-alist)) completion argval aelt handler) - (setq x-invocation-args (cdr x-invocation-args)) ;; Check for long options with attached arguments ;; and separate out the attached option argument into argval. (if (string-match "^--[^=]*=" this-switch) @@ -169,17 +254,17 @@ This function returns ARGS minus the arguments that have been processed." ;; Complete names of long options. (if (string-match "^--" this-switch) (progn - (setq completion (try-completion this-switch command-line-x-option-alist)) + (setq completion (try-completion this-switch option-alist)) (if (eq completion t) ;; Exact match for long option. nil (if (stringp completion) - (let ((elt (assoc completion command-line-x-option-alist))) + (let ((elt (assoc completion option-alist))) ;; Check for abbreviated long option. (or elt (error "Option `%s' is ambiguous" this-switch)) (setq this-switch completion)))))) - (setq aelt (assoc this-switch command-line-x-option-alist)) + (setq aelt (assoc this-switch option-alist)) (if aelt (setq handler (nth 2 aelt))) (if handler (if argval @@ -203,173 +288,190 @@ This function returns ARGS minus the arguments that have been processed." ;; white, (v) numbered colors sorted by hue, and (vi) numbered shades ;; of grey. +(declare-function ns-list-colors "nsfns.m" (&optional frame)) + (defvar x-colors - (purecopy - '("gray100" "grey100" "gray99" "grey99" "gray98" "grey98" "gray97" - "grey97" "gray96" "grey96" "gray95" "grey95" "gray94" "grey94" - "gray93" "grey93" "gray92" "grey92" "gray91" "grey91" "gray90" - "grey90" "gray89" "grey89" "gray88" "grey88" "gray87" "grey87" - "gray86" "grey86" "gray85" "grey85" "gray84" "grey84" "gray83" - "grey83" "gray82" "grey82" "gray81" "grey81" "gray80" "grey80" - "gray79" "grey79" "gray78" "grey78" "gray77" "grey77" "gray76" - "grey76" "gray75" "grey75" "gray74" "grey74" "gray73" "grey73" - "gray72" "grey72" "gray71" "grey71" "gray70" "grey70" "gray69" - "grey69" "gray68" "grey68" "gray67" "grey67" "gray66" "grey66" - "gray65" "grey65" "gray64" "grey64" "gray63" "grey63" "gray62" - "grey62" "gray61" "grey61" "gray60" "grey60" "gray59" "grey59" - "gray58" "grey58" "gray57" "grey57" "gray56" "grey56" "gray55" - "grey55" "gray54" "grey54" "gray53" "grey53" "gray52" "grey52" - "gray51" "grey51" "gray50" "grey50" "gray49" "grey49" "gray48" - "grey48" "gray47" "grey47" "gray46" "grey46" "gray45" "grey45" - "gray44" "grey44" "gray43" "grey43" "gray42" "grey42" "gray41" - "grey41" "gray40" "grey40" "gray39" "grey39" "gray38" "grey38" - "gray37" "grey37" "gray36" "grey36" "gray35" "grey35" "gray34" - "grey34" "gray33" "grey33" "gray32" "grey32" "gray31" "grey31" - "gray30" "grey30" "gray29" "grey29" "gray28" "grey28" "gray27" - "grey27" "gray26" "grey26" "gray25" "grey25" "gray24" "grey24" - "gray23" "grey23" "gray22" "grey22" "gray21" "grey21" "gray20" - "grey20" "gray19" "grey19" "gray18" "grey18" "gray17" "grey17" - "gray16" "grey16" "gray15" "grey15" "gray14" "grey14" "gray13" - "grey13" "gray12" "grey12" "gray11" "grey11" "gray10" "grey10" - "gray9" "grey9" "gray8" "grey8" "gray7" "grey7" "gray6" "grey6" - "gray5" "grey5" "gray4" "grey4" "gray3" "grey3" "gray2" "grey2" - "gray1" "grey1" "gray0" "grey0" - "LightPink1" "LightPink2" "LightPink3" "LightPink4" - "pink1" "pink2" "pink3" "pink4" - "PaleVioletRed1" "PaleVioletRed2" "PaleVioletRed3" "PaleVioletRed4" - "LavenderBlush1" "LavenderBlush2" "LavenderBlush3" "LavenderBlush4" - "VioletRed1" "VioletRed2" "VioletRed3" "VioletRed4" - "HotPink1" "HotPink2" "HotPink3" "HotPink4" - "DeepPink1" "DeepPink2" "DeepPink3" "DeepPink4" - "maroon1" "maroon2" "maroon3" "maroon4" - "orchid1" "orchid2" "orchid3" "orchid4" - "plum1" "plum2" "plum3" "plum4" - "thistle1" "thistle2" "thistle3" "thistle4" - "MediumOrchid1" "MediumOrchid2" "MediumOrchid3" "MediumOrchid4" - "DarkOrchid1" "DarkOrchid2" "DarkOrchid3" "DarkOrchid4" - "purple1" "purple2" "purple3" "purple4" - "MediumPurple1" "MediumPurple2" "MediumPurple3" "MediumPurple4" - "SlateBlue1" "SlateBlue2" "SlateBlue3" "SlateBlue4" - "RoyalBlue1" "RoyalBlue2" "RoyalBlue3" "RoyalBlue4" - "LightSteelBlue1" "LightSteelBlue2" "LightSteelBlue3" "LightSteelBlue4" - "SlateGray1" "SlateGray2" "SlateGray3" "SlateGray4" - "DodgerBlue1" "DodgerBlue2" "DodgerBlue3" "DodgerBlue4" - "SteelBlue1" "SteelBlue2" "SteelBlue3" "SteelBlue4" - "SkyBlue1" "SkyBlue2" "SkyBlue3" "SkyBlue4" - "LightSkyBlue1" "LightSkyBlue2" "LightSkyBlue3" "LightSkyBlue4" - "LightBlue1" "LightBlue2" "LightBlue3" "LightBlue4" - "CadetBlue1" "CadetBlue2" "CadetBlue3" "CadetBlue4" - "azure1" "azure2" "azure3" "azure4" - "LightCyan1" "LightCyan2" "LightCyan3" "LightCyan4" - "PaleTurquoise1" "PaleTurquoise2" "PaleTurquoise3" "PaleTurquoise4" - "DarkSlateGray1" "DarkSlateGray2" "DarkSlateGray3" "DarkSlateGray4" - "aquamarine1" "aquamarine2" "aquamarine3" "aquamarine4" - "SeaGreen1" "SeaGreen2" "SeaGreen3" "SeaGreen4" - "honeydew1" "honeydew2" "honeydew3" "honeydew4" - "DarkSeaGreen1" "DarkSeaGreen2" "DarkSeaGreen3" "DarkSeaGreen4" - "PaleGreen1" "PaleGreen2" "PaleGreen3" "PaleGreen4" - "DarkOliveGreen1" "DarkOliveGreen2" "DarkOliveGreen3" "DarkOliveGreen4" - "OliveDrab1" "OliveDrab2" "OliveDrab3" "OliveDrab4" - "ivory1" "ivory2" "ivory3" "ivory4" - "LightYellow1" "LightYellow2" "LightYellow3" "LightYellow4" - "khaki1" "khaki2" "khaki3" "khaki4" - "LemonChiffon1" "LemonChiffon2" "LemonChiffon3" "LemonChiffon4" - "LightGoldenrod1" "LightGoldenrod2" "LightGoldenrod3" "LightGoldenrod4" - "cornsilk1" "cornsilk2" "cornsilk3" "cornsilk4" - "goldenrod1" "goldenrod2" "goldenrod3" "goldenrod4" - "DarkGoldenrod1" "DarkGoldenrod2" "DarkGoldenrod3" "DarkGoldenrod4" - "wheat1" "wheat2" "wheat3" "wheat4" - "NavajoWhite1" "NavajoWhite2" "NavajoWhite3" "NavajoWhite4" - "burlywood1" "burlywood2" "burlywood3" "burlywood4" - "AntiqueWhite1" "AntiqueWhite2" "AntiqueWhite3" "AntiqueWhite4" - "bisque1" "bisque2" "bisque3" "bisque4" - "tan1" "tan2" "tan3" "tan4" - "PeachPuff1" "PeachPuff2" "PeachPuff3" "PeachPuff4" - "seashell1" "seashell2" "seashell3" "seashell4" - "chocolate1" "chocolate2" "chocolate3" "chocolate4" - "sienna1" "sienna2" "sienna3" "sienna4" - "LightSalmon1" "LightSalmon2" "LightSalmon3" "LightSalmon4" - "salmon1" "salmon2" "salmon3" "salmon4" - "coral1" "coral2" "coral3" "coral4" - "tomato1" "tomato2" "tomato3" "tomato4" - "MistyRose1" "MistyRose2" "MistyRose3" "MistyRose4" - "snow1" "snow2" "snow3" "snow4" - "RosyBrown1" "RosyBrown2" "RosyBrown3" "RosyBrown4" - "IndianRed1" "IndianRed2" "IndianRed3" "IndianRed4" - "firebrick1" "firebrick2" "firebrick3" "firebrick4" - "brown1" "brown2" "brown3" "brown4" - "magenta1" "magenta2" "magenta3" "magenta4" - "blue1" "blue2" "blue3" "blue4" - "DeepSkyBlue1" "DeepSkyBlue2" "DeepSkyBlue3" "DeepSkyBlue4" - "turquoise1" "turquoise2" "turquoise3" "turquoise4" - "cyan1" "cyan2" "cyan3" "cyan4" - "SpringGreen1" "SpringGreen2" "SpringGreen3" "SpringGreen4" - "green1" "green2" "green3" "green4" - "chartreuse1" "chartreuse2" "chartreuse3" "chartreuse4" - "yellow1" "yellow2" "yellow3" "yellow4" - "gold1" "gold2" "gold3" "gold4" - "orange1" "orange2" "orange3" "orange4" - "DarkOrange1" "DarkOrange2" "DarkOrange3" "DarkOrange4" - "OrangeRed1" "OrangeRed2" "OrangeRed3" "OrangeRed4" - "red1" "red2" "red3" "red4" - "lavender blush" "LavenderBlush" "ghost white" "GhostWhite" - "lavender" "alice blue" "AliceBlue" "azure" "light cyan" - "LightCyan" "mint cream" "MintCream" "honeydew" "ivory" - "light goldenrod yellow" "LightGoldenrodYellow" "light yellow" - "LightYellow" "beige" "floral white" "FloralWhite" "old lace" - "OldLace" "blanched almond" "BlanchedAlmond" "moccasin" - "papaya whip" "PapayaWhip" "bisque" "antique white" - "AntiqueWhite" "linen" "peach puff" "PeachPuff" "seashell" - "misty rose" "MistyRose" "snow" "light pink" "LightPink" "pink" - "hot pink" "HotPink" "deep pink" "DeepPink" "maroon" - "pale violet red" "PaleVioletRed" "violet red" "VioletRed" - "medium violet red" "MediumVioletRed" "violet" "plum" "thistle" - "orchid" "medium orchid" "MediumOrchid" "dark orchid" - "DarkOrchid" "purple" "blue violet" "BlueViolet" "medium purple" - "MediumPurple" "light slate blue" "LightSlateBlue" - "medium slate blue" "MediumSlateBlue" "slate blue" "SlateBlue" - "dark slate blue" "DarkSlateBlue" "midnight blue" "MidnightBlue" - "navy" "navy blue" "NavyBlue" "dark blue" "DarkBlue" - "light steel blue" "LightSteelBlue" "cornflower blue" - "CornflowerBlue" "dodger blue" "DodgerBlue" "royal blue" - "RoyalBlue" "light slate gray" "light slate grey" - "LightSlateGray" "LightSlateGrey" "slate gray" "slate grey" - "SlateGray" "SlateGrey" "dark slate gray" "dark slate grey" - "DarkSlateGray" "DarkSlateGrey" "steel blue" "SteelBlue" - "cadet blue" "CadetBlue" "light sky blue" "LightSkyBlue" - "sky blue" "SkyBlue" "light blue" "LightBlue" "powder blue" - "PowderBlue" "pale turquoise" "PaleTurquoise" "turquoise" - "medium turquoise" "MediumTurquoise" "dark turquoise" - "DarkTurquoise" "dark cyan" "DarkCyan" "aquamarine" - "medium aquamarine" "MediumAquamarine" "light sea green" - "LightSeaGreen" "medium sea green" "MediumSeaGreen" "sea green" - "SeaGreen" "dark sea green" "DarkSeaGreen" "pale green" - "PaleGreen" "lime green" "LimeGreen" "dark green" "DarkGreen" - "forest green" "ForestGreen" "light green" "LightGreen" - "green yellow" "GreenYellow" "yellow green" "YellowGreen" - "olive drab" "OliveDrab" "dark olive green" "DarkOliveGreen" - "lemon chiffon" "LemonChiffon" "khaki" "dark khaki" "DarkKhaki" - "cornsilk" "pale goldenrod" "PaleGoldenrod" "light goldenrod" - "LightGoldenrod" "goldenrod" "dark goldenrod" "DarkGoldenrod" - "wheat" "navajo white" "NavajoWhite" "tan" "burlywood" - "sandy brown" "SandyBrown" "peru" "chocolate" "saddle brown" - "SaddleBrown" "sienna" "rosy brown" "RosyBrown" "dark salmon" - "DarkSalmon" "coral" "tomato" "light salmon" "LightSalmon" - "salmon" "light coral" "LightCoral" "indian red" "IndianRed" - "firebrick" "brown" "dark red" "DarkRed" "magenta" - "dark magenta" "DarkMagenta" "dark violet" "DarkViolet" - "medium blue" "MediumBlue" "blue" "deep sky blue" "DeepSkyBlue" - "cyan" "medium spring green" "MediumSpringGreen" "spring green" - "SpringGreen" "green" "lawn green" "LawnGreen" "chartreuse" - "yellow" "gold" "orange" "dark orange" "DarkOrange" "orange red" - "OrangeRed" "red" "white" "white smoke" "WhiteSmoke" "gainsboro" - "light gray" "light grey" "LightGray" "LightGrey" "gray" "grey" - "dark gray" "dark grey" "DarkGray" "DarkGrey" "dim gray" - "dim grey" "DimGray" "DimGrey" "black")) + (if (featurep 'ns) (ns-list-colors) + (purecopy + '("gray100" "grey100" "gray99" "grey99" "gray98" "grey98" "gray97" + "grey97" "gray96" "grey96" "gray95" "grey95" "gray94" "grey94" + "gray93" "grey93" "gray92" "grey92" "gray91" "grey91" "gray90" + "grey90" "gray89" "grey89" "gray88" "grey88" "gray87" "grey87" + "gray86" "grey86" "gray85" "grey85" "gray84" "grey84" "gray83" + "grey83" "gray82" "grey82" "gray81" "grey81" "gray80" "grey80" + "gray79" "grey79" "gray78" "grey78" "gray77" "grey77" "gray76" + "grey76" "gray75" "grey75" "gray74" "grey74" "gray73" "grey73" + "gray72" "grey72" "gray71" "grey71" "gray70" "grey70" "gray69" + "grey69" "gray68" "grey68" "gray67" "grey67" "gray66" "grey66" + "gray65" "grey65" "gray64" "grey64" "gray63" "grey63" "gray62" + "grey62" "gray61" "grey61" "gray60" "grey60" "gray59" "grey59" + "gray58" "grey58" "gray57" "grey57" "gray56" "grey56" "gray55" + "grey55" "gray54" "grey54" "gray53" "grey53" "gray52" "grey52" + "gray51" "grey51" "gray50" "grey50" "gray49" "grey49" "gray48" + "grey48" "gray47" "grey47" "gray46" "grey46" "gray45" "grey45" + "gray44" "grey44" "gray43" "grey43" "gray42" "grey42" "gray41" + "grey41" "gray40" "grey40" "gray39" "grey39" "gray38" "grey38" + "gray37" "grey37" "gray36" "grey36" "gray35" "grey35" "gray34" + "grey34" "gray33" "grey33" "gray32" "grey32" "gray31" "grey31" + "gray30" "grey30" "gray29" "grey29" "gray28" "grey28" "gray27" + "grey27" "gray26" "grey26" "gray25" "grey25" "gray24" "grey24" + "gray23" "grey23" "gray22" "grey22" "gray21" "grey21" "gray20" + "grey20" "gray19" "grey19" "gray18" "grey18" "gray17" "grey17" + "gray16" "grey16" "gray15" "grey15" "gray14" "grey14" "gray13" + "grey13" "gray12" "grey12" "gray11" "grey11" "gray10" "grey10" + "gray9" "grey9" "gray8" "grey8" "gray7" "grey7" "gray6" "grey6" + "gray5" "grey5" "gray4" "grey4" "gray3" "grey3" "gray2" "grey2" + "gray1" "grey1" "gray0" "grey0" + "LightPink1" "LightPink2" "LightPink3" "LightPink4" + "pink1" "pink2" "pink3" "pink4" + "PaleVioletRed1" "PaleVioletRed2" "PaleVioletRed3" "PaleVioletRed4" + "LavenderBlush1" "LavenderBlush2" "LavenderBlush3" "LavenderBlush4" + "VioletRed1" "VioletRed2" "VioletRed3" "VioletRed4" + "HotPink1" "HotPink2" "HotPink3" "HotPink4" + "DeepPink1" "DeepPink2" "DeepPink3" "DeepPink4" + "maroon1" "maroon2" "maroon3" "maroon4" + "orchid1" "orchid2" "orchid3" "orchid4" + "plum1" "plum2" "plum3" "plum4" + "thistle1" "thistle2" "thistle3" "thistle4" + "MediumOrchid1" "MediumOrchid2" "MediumOrchid3" "MediumOrchid4" + "DarkOrchid1" "DarkOrchid2" "DarkOrchid3" "DarkOrchid4" + "purple1" "purple2" "purple3" "purple4" + "MediumPurple1" "MediumPurple2" "MediumPurple3" "MediumPurple4" + "SlateBlue1" "SlateBlue2" "SlateBlue3" "SlateBlue4" + "RoyalBlue1" "RoyalBlue2" "RoyalBlue3" "RoyalBlue4" + "LightSteelBlue1" "LightSteelBlue2" "LightSteelBlue3" "LightSteelBlue4" + "SlateGray1" "SlateGray2" "SlateGray3" "SlateGray4" + "DodgerBlue1" "DodgerBlue2" "DodgerBlue3" "DodgerBlue4" + "SteelBlue1" "SteelBlue2" "SteelBlue3" "SteelBlue4" + "SkyBlue1" "SkyBlue2" "SkyBlue3" "SkyBlue4" + "LightSkyBlue1" "LightSkyBlue2" "LightSkyBlue3" "LightSkyBlue4" + "LightBlue1" "LightBlue2" "LightBlue3" "LightBlue4" + "CadetBlue1" "CadetBlue2" "CadetBlue3" "CadetBlue4" + "azure1" "azure2" "azure3" "azure4" + "LightCyan1" "LightCyan2" "LightCyan3" "LightCyan4" + "PaleTurquoise1" "PaleTurquoise2" "PaleTurquoise3" "PaleTurquoise4" + "DarkSlateGray1" "DarkSlateGray2" "DarkSlateGray3" "DarkSlateGray4" + "aquamarine1" "aquamarine2" "aquamarine3" "aquamarine4" + "SeaGreen1" "SeaGreen2" "SeaGreen3" "SeaGreen4" + "honeydew1" "honeydew2" "honeydew3" "honeydew4" + "DarkSeaGreen1" "DarkSeaGreen2" "DarkSeaGreen3" "DarkSeaGreen4" + "PaleGreen1" "PaleGreen2" "PaleGreen3" "PaleGreen4" + "DarkOliveGreen1" "DarkOliveGreen2" "DarkOliveGreen3" "DarkOliveGreen4" + "OliveDrab1" "OliveDrab2" "OliveDrab3" "OliveDrab4" + "ivory1" "ivory2" "ivory3" "ivory4" + "LightYellow1" "LightYellow2" "LightYellow3" "LightYellow4" + "khaki1" "khaki2" "khaki3" "khaki4" + "LemonChiffon1" "LemonChiffon2" "LemonChiffon3" "LemonChiffon4" + "LightGoldenrod1" "LightGoldenrod2" "LightGoldenrod3" "LightGoldenrod4" + "cornsilk1" "cornsilk2" "cornsilk3" "cornsilk4" + "goldenrod1" "goldenrod2" "goldenrod3" "goldenrod4" + "DarkGoldenrod1" "DarkGoldenrod2" "DarkGoldenrod3" "DarkGoldenrod4" + "wheat1" "wheat2" "wheat3" "wheat4" + "NavajoWhite1" "NavajoWhite2" "NavajoWhite3" "NavajoWhite4" + "burlywood1" "burlywood2" "burlywood3" "burlywood4" + "AntiqueWhite1" "AntiqueWhite2" "AntiqueWhite3" "AntiqueWhite4" + "bisque1" "bisque2" "bisque3" "bisque4" + "tan1" "tan2" "tan3" "tan4" + "PeachPuff1" "PeachPuff2" "PeachPuff3" "PeachPuff4" + "seashell1" "seashell2" "seashell3" "seashell4" + "chocolate1" "chocolate2" "chocolate3" "chocolate4" + "sienna1" "sienna2" "sienna3" "sienna4" + "LightSalmon1" "LightSalmon2" "LightSalmon3" "LightSalmon4" + "salmon1" "salmon2" "salmon3" "salmon4" + "coral1" "coral2" "coral3" "coral4" + "tomato1" "tomato2" "tomato3" "tomato4" + "MistyRose1" "MistyRose2" "MistyRose3" "MistyRose4" + "snow1" "snow2" "snow3" "snow4" + "RosyBrown1" "RosyBrown2" "RosyBrown3" "RosyBrown4" + "IndianRed1" "IndianRed2" "IndianRed3" "IndianRed4" + "firebrick1" "firebrick2" "firebrick3" "firebrick4" + "brown1" "brown2" "brown3" "brown4" + "magenta1" "magenta2" "magenta3" "magenta4" + "blue1" "blue2" "blue3" "blue4" + "DeepSkyBlue1" "DeepSkyBlue2" "DeepSkyBlue3" "DeepSkyBlue4" + "turquoise1" "turquoise2" "turquoise3" "turquoise4" + "cyan1" "cyan2" "cyan3" "cyan4" + "SpringGreen1" "SpringGreen2" "SpringGreen3" "SpringGreen4" + "green1" "green2" "green3" "green4" + "chartreuse1" "chartreuse2" "chartreuse3" "chartreuse4" + "yellow1" "yellow2" "yellow3" "yellow4" + "gold1" "gold2" "gold3" "gold4" + "orange1" "orange2" "orange3" "orange4" + "DarkOrange1" "DarkOrange2" "DarkOrange3" "DarkOrange4" + "OrangeRed1" "OrangeRed2" "OrangeRed3" "OrangeRed4" + "red1" "red2" "red3" "red4" + "lavender blush" "LavenderBlush" "ghost white" "GhostWhite" + "lavender" "alice blue" "AliceBlue" "azure" "light cyan" + "LightCyan" "mint cream" "MintCream" "honeydew" "ivory" + "light goldenrod yellow" "LightGoldenrodYellow" "light yellow" + "LightYellow" "beige" "floral white" "FloralWhite" "old lace" + "OldLace" "blanched almond" "BlanchedAlmond" "moccasin" + "papaya whip" "PapayaWhip" "bisque" "antique white" + "AntiqueWhite" "linen" "peach puff" "PeachPuff" "seashell" + "misty rose" "MistyRose" "snow" "light pink" "LightPink" "pink" + "hot pink" "HotPink" "deep pink" "DeepPink" "maroon" + "pale violet red" "PaleVioletRed" "violet red" "VioletRed" + "medium violet red" "MediumVioletRed" "violet" "plum" "thistle" + "orchid" "medium orchid" "MediumOrchid" "dark orchid" + "DarkOrchid" "purple" "blue violet" "BlueViolet" "medium purple" + "MediumPurple" "light slate blue" "LightSlateBlue" + "medium slate blue" "MediumSlateBlue" "slate blue" "SlateBlue" + "dark slate blue" "DarkSlateBlue" "midnight blue" "MidnightBlue" + "navy" "navy blue" "NavyBlue" "dark blue" "DarkBlue" + "light steel blue" "LightSteelBlue" "cornflower blue" + "CornflowerBlue" "dodger blue" "DodgerBlue" "royal blue" + "RoyalBlue" "light slate gray" "light slate grey" + "LightSlateGray" "LightSlateGrey" "slate gray" "slate grey" + "SlateGray" "SlateGrey" "dark slate gray" "dark slate grey" + "DarkSlateGray" "DarkSlateGrey" "steel blue" "SteelBlue" + "cadet blue" "CadetBlue" "light sky blue" "LightSkyBlue" + "sky blue" "SkyBlue" "light blue" "LightBlue" "powder blue" + "PowderBlue" "pale turquoise" "PaleTurquoise" "turquoise" + "medium turquoise" "MediumTurquoise" "dark turquoise" + "DarkTurquoise" "dark cyan" "DarkCyan" "aquamarine" + "medium aquamarine" "MediumAquamarine" "light sea green" + "LightSeaGreen" "medium sea green" "MediumSeaGreen" "sea green" + "SeaGreen" "dark sea green" "DarkSeaGreen" "pale green" + "PaleGreen" "lime green" "LimeGreen" "dark green" "DarkGreen" + "forest green" "ForestGreen" "light green" "LightGreen" + "green yellow" "GreenYellow" "yellow green" "YellowGreen" + "olive drab" "OliveDrab" "dark olive green" "DarkOliveGreen" + "lemon chiffon" "LemonChiffon" "khaki" "dark khaki" "DarkKhaki" + "cornsilk" "pale goldenrod" "PaleGoldenrod" "light goldenrod" + "LightGoldenrod" "goldenrod" "dark goldenrod" "DarkGoldenrod" + "wheat" "navajo white" "NavajoWhite" "tan" "burlywood" + "sandy brown" "SandyBrown" "peru" "chocolate" "saddle brown" + "SaddleBrown" "sienna" "rosy brown" "RosyBrown" "dark salmon" + "DarkSalmon" "coral" "tomato" "light salmon" "LightSalmon" + "salmon" "light coral" "LightCoral" "indian red" "IndianRed" + "firebrick" "brown" "dark red" "DarkRed" "magenta" + "dark magenta" "DarkMagenta" "dark violet" "DarkViolet" + "medium blue" "MediumBlue" "blue" "deep sky blue" "DeepSkyBlue" + "cyan" "medium spring green" "MediumSpringGreen" "spring green" + "SpringGreen" "green" "lawn green" "LawnGreen" "chartreuse" + "yellow" "gold" "orange" "dark orange" "DarkOrange" "orange red" + "OrangeRed" "red" "white" "white smoke" "WhiteSmoke" "gainsboro" + "light gray" "light grey" "LightGray" "LightGrey" "gray" "grey" + "dark gray" "dark grey" "DarkGray" "DarkGrey" "dim gray" + "dim grey" "DimGray" "DimGrey" "black"))) "List of basic colors available on color displays. For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20. For Nextstep, this is a list of non-PANTONE colors returned by the operating system.") -;; arch-tag: 2a128601-99cc-401e-9dff-0ee6a36102ef +(defvar w32-color-map) + +(defun xw-defined-colors (&optional frame) + "Internal function called by `defined-colors', which see." + (if (featurep 'ns) + x-colors + (or frame (setq frame (selected-frame))) + (let (defined-colors) + (dolist (this-color (if (eq system-type 'windows-nt) + (or (mapcar 'car w32-color-map) x-colors) + x-colors)) + (and (color-supported-p this-color frame t) + (setq defined-colors (cons this-color defined-colors)))) + defined-colors))) + ;;; common-win.el ends here diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 4cc26326659..77a2d3f2bc0 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -41,131 +41,42 @@ ;;; Code: - -(if (not (featurep 'ns)) +(or (featurep 'ns) (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" - (invocation-name))) + (invocation-name))) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl)) ; lexical-let -;; Documentation-purposes only: actually loaded in loadup.el +;; Documentation-purposes only: actually loaded in loadup.el. (require 'frame) (require 'mouse) (require 'faces) -(require 'easymenu) (require 'menu-bar) (require 'fontset) -;; Not needed? -;;(require 'ispell) - (defgroup ns nil "GNUstep/Mac OS X specific features." :group 'environment) -;; nsterm.m -(defvar ns-version-string) -(defvar ns-alternate-modifier) -(defvar ns-right-alternate-modifier) - ;;;; Command line argument handling. -(defvar ns-invocation-args nil) -(defvar ns-command-line-resources nil) - -;; Handler for switches of the form "-switch value" or "-switch". -(defun ns-handle-switch (switch &optional numeric) - (let ((aelt (assoc switch command-line-ns-option-alist))) - (if aelt - (setq default-frame-alist - (cons (cons (nth 3 aelt) - (if numeric - (string-to-number (pop ns-invocation-args)) - (or (nth 4 aelt) (pop ns-invocation-args)))) - default-frame-alist))))) - -;; Handler for switches of the form "-switch n" -(defun ns-handle-numeric-switch (switch) - (ns-handle-switch switch t)) - -;; Make -iconic apply only to the initial frame! -(defun ns-handle-iconic (switch) - (setq initial-frame-alist - (cons '(visibility . icon) initial-frame-alist))) - -;; Handle the -name option, set the name of the initial frame. -(defun ns-handle-name-switch (switch) - (or (consp ns-invocation-args) - (error "%s: missing argument to `%s' option" (invocation-name) switch)) - (setq initial-frame-alist (cons (cons 'name (pop ns-invocation-args)) - initial-frame-alist))) - -;; Set (but not used?) in frame.el. -(defvar x-display-name nil - "The name of the window display on which Emacs was started. -On X, the display name of individual X frames is recorded in the -`display' frame parameter.") +(defvar x-invocation-args) +(defvar ns-command-line-resources nil) ; FIXME unused? ;; nsterm.m. (defvar ns-input-file) -(defun ns-handle-nxopen (switch) - (setq unread-command-events (append unread-command-events '(ns-open-file)) - ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) +(defun ns-handle-nxopen (switch &optional temp) + (setq unread-command-events (append unread-command-events + (if temp '(ns-open-temp-file) + '(ns-open-file))) + ns-input-file (append ns-input-file (list (pop x-invocation-args))))) (defun ns-handle-nxopentemp (switch) - (setq unread-command-events (append unread-command-events - '(ns-open-temp-file)) - ns-input-file (append ns-input-file (list (pop ns-invocation-args))))) + (ns-handle-nxopen switch t)) (defun ns-ignore-1-arg (switch) - (setq ns-invocation-args (cdr ns-invocation-args))) -(defun ns-ignore-2-arg (switch) - (setq ns-invocation-args (cddr ns-invocation-args))) - -(defun ns-handle-args (args) - "Process Nextstep-related command line options. -This is run before the user's startup file is loaded. -The options in ARGS are copied to `ns-invocation-args'. -The Nextstep-related settings are then applied using the handlers -defined in `command-line-ns-option-alist'. -The return value is ARGS minus the number of arguments processed." - ;; We use ARGS to accumulate the args that we don't handle here, to return. - (setq ns-invocation-args args - args nil) - (while ns-invocation-args - (let* ((this-switch (pop ns-invocation-args)) - (orig-this-switch this-switch) - completion argval aelt handler) - ;; Check for long options with attached arguments - ;; and separate out the attached option argument into argval. - (if (string-match "^--[^=]*=" this-switch) - (setq argval (substring this-switch (match-end 0)) - this-switch (substring this-switch 0 (1- (match-end 0))))) - ;; Complete names of long options. - (if (string-match "^--" this-switch) - (progn - (setq completion (try-completion this-switch - command-line-ns-option-alist)) - (if (eq completion t) - ;; Exact match for long option. - nil - (if (stringp completion) - (let ((elt (assoc completion command-line-ns-option-alist))) - ;; Check for abbreviated long option. - (or elt - (error "Option `%s' is ambiguous" this-switch)) - (setq this-switch completion)))))) - (setq aelt (assoc this-switch command-line-ns-option-alist)) - (if aelt (setq handler (nth 2 aelt))) - (if handler - (if argval - (let ((ns-invocation-args - (cons argval ns-invocation-args))) - (funcall handler this-switch)) - (funcall handler this-switch)) - (setq args (cons orig-this-switch args))))) - (nreverse args)) + (setq x-invocation-args (cdr x-invocation-args))) (defun ns-parse-geometry (geom) "Parse a Nextstep-style geometry string GEOM. @@ -187,20 +98,7 @@ The properties returned may include `top', `left', `height', and `width'." ;;;; Keyboard mapping. -(defvar ns-alternatives-map - (let ((map (make-sparse-keymap))) - ;; Map certain keypad keys into ASCII characters - ;; that people usually expect. - (define-key map [S-tab] [backtab]) - (define-key map [M-backspace] [?\M-\d]) - (define-key map [M-delete] [?\M-\d]) - (define-key map [M-tab] [?\M-\t]) - (define-key map [M-linefeed] [?\M-\n]) - (define-key map [M-clear] [?\M-\C-l]) - (define-key map [M-return] [?\M-\C-m]) - (define-key map [M-escape] [?\M-\e]) - map) - "Keymap of alternative meanings for some keys under Nextstep.") +(define-obsolete-variable-alias 'ns-alternatives-map 'x-alternatives-map "24.1") ;; Here are some Nextstep-like bindings for command key sequences. (define-key global-map [?\s-,] 'customize) @@ -256,13 +154,13 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [kp-prior] 'scroll-down) (define-key global-map [kp-next] 'scroll-up) -;;; Allow shift-clicks to work similarly to under Nextstep +;; Allow shift-clicks to work similarly to under Nextstep. (define-key global-map [S-mouse-1] 'mouse-save-then-kill) (global-unset-key [S-down-mouse-1]) - ;; Special Nextstep-generated events are converted to function keys. Here -;; are the bindings for them. +;; are the bindings for them. Note, these keys are actually declared in +;; x-setup-function-keys in common-win. (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) (define-key global-map [ns-open-file] 'ns-find-file) (define-key global-map [ns-open-temp-file] [ns-open-file]) @@ -283,196 +181,15 @@ The properties returned may include `top', `left', `height', and `width'." (defvaralias 'mac-allow-anti-aliasing 'ns-antialias-text) (defvaralias 'mac-command-modifier 'ns-command-modifier) +(defvaralias 'mac-right-command-modifier 'ns-right-command-modifier) (defvaralias 'mac-control-modifier 'ns-control-modifier) +(defvaralias 'mac-right-control-modifier 'ns-right-control-modifier) (defvaralias 'mac-option-modifier 'ns-option-modifier) (defvaralias 'mac-right-option-modifier 'ns-right-option-modifier) (defvaralias 'mac-function-modifier 'ns-function-modifier) (declare-function ns-do-applescript "nsfns.m" (script)) (defalias 'do-applescript 'ns-do-applescript) -(defun x-setup-function-keys (frame) - "Set up `function-key-map' on the graphical frame FRAME." - (unless (terminal-parameter frame 'x-setup-function-keys) - (with-selected-frame frame - (setq interprogram-cut-function 'x-select-text - interprogram-paste-function 'x-selection-value) - (let ((map (copy-keymap ns-alternatives-map))) - (set-keymap-parent map (keymap-parent local-function-key-map)) - (set-keymap-parent local-function-key-map map)) - (setq system-key-alist - (list - (cons (logior (lsh 0 16) 1) 'ns-power-off) - (cons (logior (lsh 0 16) 2) 'ns-open-file) - (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) - (cons (logior (lsh 0 16) 4) 'ns-drag-file) - (cons (logior (lsh 0 16) 5) 'ns-drag-color) - (cons (logior (lsh 0 16) 6) 'ns-drag-text) - (cons (logior (lsh 0 16) 7) 'ns-change-font) - (cons (logior (lsh 0 16) 8) 'ns-open-file-line) -; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) -; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) - (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) - (cons (logior (lsh 0 16) 12) 'ns-new-frame) - (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) - (cons (logior (lsh 0 16) 14) 'ns-show-prefs) - (cons (logior (lsh 1 16) 32) 'f1) - (cons (logior (lsh 1 16) 33) 'f2) - (cons (logior (lsh 1 16) 34) 'f3) - (cons (logior (lsh 1 16) 35) 'f4) - (cons (logior (lsh 1 16) 36) 'f5) - (cons (logior (lsh 1 16) 37) 'f6) - (cons (logior (lsh 1 16) 38) 'f7) - (cons (logior (lsh 1 16) 39) 'f8) - (cons (logior (lsh 1 16) 40) 'f9) - (cons (logior (lsh 1 16) 41) 'f10) - (cons (logior (lsh 1 16) 42) 'f11) - (cons (logior (lsh 1 16) 43) 'f12) - (cons (logior (lsh 1 16) 44) 'kp-insert) - (cons (logior (lsh 1 16) 45) 'kp-delete) - (cons (logior (lsh 1 16) 46) 'kp-home) - (cons (logior (lsh 1 16) 47) 'kp-end) - (cons (logior (lsh 1 16) 48) 'kp-prior) - (cons (logior (lsh 1 16) 49) 'kp-next) - (cons (logior (lsh 1 16) 50) 'print-screen) - (cons (logior (lsh 1 16) 51) 'scroll-lock) - (cons (logior (lsh 1 16) 52) 'pause) - (cons (logior (lsh 1 16) 53) 'system) - (cons (logior (lsh 1 16) 54) 'break) - (cons (logior (lsh 1 16) 56) 'please-tell-carl-what-this-key-is-called-56) - (cons (logior (lsh 1 16) 61) 'please-tell-carl-what-this-key-is-called-61) - (cons (logior (lsh 1 16) 62) 'please-tell-carl-what-this-key-is-called-62) - (cons (logior (lsh 1 16) 63) 'please-tell-carl-what-this-key-is-called-63) - (cons (logior (lsh 1 16) 64) 'please-tell-carl-what-this-key-is-called-64) - (cons (logior (lsh 1 16) 69) 'please-tell-carl-what-this-key-is-called-69) - (cons (logior (lsh 1 16) 70) 'please-tell-carl-what-this-key-is-called-70) - (cons (logior (lsh 1 16) 71) 'please-tell-carl-what-this-key-is-called-71) - (cons (logior (lsh 1 16) 72) 'please-tell-carl-what-this-key-is-called-72) - (cons (logior (lsh 1 16) 73) 'please-tell-carl-what-this-key-is-called-73) - (cons (logior (lsh 2 16) 3) 'kp-enter) - (cons (logior (lsh 2 16) 9) 'kp-tab) - (cons (logior (lsh 2 16) 28) 'kp-quit) - (cons (logior (lsh 2 16) 35) 'kp-hash) - (cons (logior (lsh 2 16) 42) 'kp-multiply) - (cons (logior (lsh 2 16) 43) 'kp-add) - (cons (logior (lsh 2 16) 44) 'kp-separator) - (cons (logior (lsh 2 16) 45) 'kp-subtract) - (cons (logior (lsh 2 16) 46) 'kp-decimal) - (cons (logior (lsh 2 16) 47) 'kp-divide) - (cons (logior (lsh 2 16) 48) 'kp-0) - (cons (logior (lsh 2 16) 49) 'kp-1) - (cons (logior (lsh 2 16) 50) 'kp-2) - (cons (logior (lsh 2 16) 51) 'kp-3) - (cons (logior (lsh 2 16) 52) 'kp-4) - (cons (logior (lsh 2 16) 53) 'kp-5) - (cons (logior (lsh 2 16) 54) 'kp-6) - (cons (logior (lsh 2 16) 55) 'kp-7) - (cons (logior (lsh 2 16) 56) 'kp-8) - (cons (logior (lsh 2 16) 57) 'kp-9) - (cons (logior (lsh 2 16) 60) 'kp-less) - (cons (logior (lsh 2 16) 61) 'kp-equal) - (cons (logior (lsh 2 16) 62) 'kp-more) - (cons (logior (lsh 2 16) 64) 'kp-at) - (cons (logior (lsh 2 16) 92) 'kp-backslash) - (cons (logior (lsh 2 16) 96) 'kp-backtick) - (cons (logior (lsh 2 16) 124) 'kp-bar) - (cons (logior (lsh 2 16) 126) 'kp-tilde) - (cons (logior (lsh 2 16) 157) 'kp-mu) - (cons (logior (lsh 2 16) 165) 'kp-yen) - (cons (logior (lsh 2 16) 167) 'kp-paragraph) - (cons (logior (lsh 2 16) 172) 'left) - (cons (logior (lsh 2 16) 173) 'up) - (cons (logior (lsh 2 16) 174) 'right) - (cons (logior (lsh 2 16) 175) 'down) - (cons (logior (lsh 2 16) 176) 'kp-ring) - (cons (logior (lsh 2 16) 201) 'kp-square) - (cons (logior (lsh 2 16) 204) 'kp-cube) - (cons (logior (lsh 3 16) 8) 'backspace) - (cons (logior (lsh 3 16) 9) 'tab) - (cons (logior (lsh 3 16) 10) 'linefeed) - (cons (logior (lsh 3 16) 11) 'clear) - (cons (logior (lsh 3 16) 13) 'return) - (cons (logior (lsh 3 16) 18) 'pause) - (cons (logior (lsh 3 16) 25) 'S-tab) - (cons (logior (lsh 3 16) 27) 'escape) - (cons (logior (lsh 3 16) 127) 'delete) - ))) - (set-terminal-parameter frame 'x-setup-function-keys t))) - - -;; Add a couple of menus and rearrange some others; easiest just to redo toplvl -;; Note keymap defns must be given last-to-first -(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")) - -(setq menu-bar-final-items - (cond ((eq system-type 'darwin) - '(buffer windows services help-menu)) - ;; Otherwise, GNUstep. - (t - '(buffer windows services hide-app quit)))) - -;; Add standard top-level items to GNUstep menu. -(unless (eq system-type 'darwin) - (define-key global-map [menu-bar quit] '("Quit" . save-buffers-kill-emacs)) - (define-key global-map [menu-bar hide-app] '("Hide" . ns-do-hide-emacs))) - -(define-key global-map [menu-bar services] - (cons "Services" (make-sparse-keymap "Services"))) -(define-key global-map [menu-bar buffer] - (cons "Buffers" global-buffers-menu-map)) -;; (cons "Buffers" (make-sparse-keymap "Buffers"))) -(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) -(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu)) -(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) -(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) - -;; If running under GNUstep, rename "Help" to "Info" -(cond ((eq system-type 'darwin) - (define-key global-map [menu-bar help-menu] - (cons "Help" menu-bar-help-menu))) - (t - (let ((contents (reverse (cdr menu-bar-help-menu)))) - (setq menu-bar-help-menu - (append (list 'keymap) (cdr contents) (list "Info")))) - (define-key global-map [menu-bar help-menu] - (cons "Info" menu-bar-help-menu)))) - -(if (not (eq system-type 'darwin)) - ;; in OS X it's in the app menu already - (define-key menu-bar-help-menu [info-panel] - '("About Emacs..." . ns-do-emacs-info-panel))) - -;;;; Edit menu: Modify slightly - -;; Substitute a Copy function that works better under X (for GNUstep). -(easy-menu-remove-item global-map '("menu-bar" "edit") 'copy) -(define-key-after menu-bar-edit-menu [copy] - '(menu-item "Copy" ns-copy-including-secondary - :enable mark-active - :help "Copy text in region between mark and current position") - 'cut) - -;; Change to same precondition as select-and-paste, as we don't have -;; `x-selection-exists-p'. -(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste) -(define-key-after menu-bar-edit-menu [paste] - '(menu-item "Paste" yank - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help "Paste (yank) text most recently cut/copied") - 'copy) - -;; Change text to be more consistent with surrounding menu items `paste', etc. -(easy-menu-remove-item global-map '("menu-bar" "edit") 'paste-from-menu) -(define-key-after menu-bar-edit-menu [select-paste] - '(menu-item "Select and Paste" yank-menu - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help "Choose a string from the kill ring and paste it") - 'paste) - -;; Separate undo from cut/paste section, add spell for platform consistency. -(define-key-after menu-bar-edit-menu [separator-undo] '("--") 'undo) -(define-key-after menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map) 'fill) - - ;;;; Services (declare-function ns-perform-service "nsfns.m" (service send)) @@ -536,10 +253,6 @@ The properties returned may include `top', `left', `height', and `width'." (t (error (concat "Service " ns-input-spi-name " not recognized"))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - ;; Composed key sequence handling for Nextstep system input methods. ;; (On Nextstep systems, input methods are provided for CJK ;; characters, etc. which require multiple keystrokes, and during @@ -636,29 +349,24 @@ See `ns-insert-working-text'." ;;;; OS X file system Unicode UTF-8 NFD (decomposed form) support ;; Lisp code based on utf-8m.el, by Seiji Zenitani, Eiji Honjoh, and ;; Carsten Bormann. -(if (eq system-type 'darwin) - (progn - - (defun ns-utf8-nfd-post-read-conversion (length) - "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences." - (save-excursion - (save-restriction - (narrow-to-region (point) (+ (point) length)) - (let ((str (buffer-string))) - (delete-region (point-min) (point-max)) - (insert (ns-convert-utf8-nfd-to-nfc str)) - (- (point-max) (point-min)) - )))) - - (define-coding-system 'utf-8-nfd - "UTF-8 NFD (decomposed) encoding." - :coding-type 'utf-8 - :mnemonic ?U - :charset-list '(unicode) - :post-read-conversion 'ns-utf8-nfd-post-read-conversion) - (set-file-name-coding-system 'utf-8-nfd))) - - +(when (eq system-type 'darwin) + (defun ns-utf8-nfd-post-read-conversion (length) + "Calls `ns-convert-utf8-nfd-to-nfc' to compose char sequences." + (save-excursion + (save-restriction + (narrow-to-region (point) (+ (point) length)) + (let ((str (buffer-string))) + (delete-region (point-min) (point-max)) + (insert (ns-convert-utf8-nfd-to-nfc str)) + (- (point-max) (point-min)))))) + + (define-coding-system 'utf-8-nfd + "UTF-8 NFD (decomposed) encoding." + :coding-type 'utf-8 + :mnemonic ?U + :charset-list '(unicode) + :post-read-conversion 'ns-utf8-nfd-post-read-conversion) + (set-file-name-coding-system 'utf-8-nfd)) ;;;; Inter-app communications support. @@ -674,12 +382,10 @@ See `ns-insert-working-text'." "Insert contents of file `ns-input-file' like insert-file but with less prompting. If file is a directory perform a `find-file' on it." (interactive) - (let ((f)) - (setq f (car ns-input-file)) - (setq ns-input-file (cdr ns-input-file)) + (let ((f (pop ns-input-file))) (if (file-directory-p f) (find-file f) - (push-mark (+ (point) (car (cdr (insert-file-contents f)))))))) + (push-mark (+ (point) (cadr (insert-file-contents f))))))) (defvar ns-select-overlay nil "Overlay used to highlight areas in files requested by Nextstep apps.") @@ -732,8 +438,6 @@ Lines are highlighted according to `ns-input-line'." (add-hook 'first-change-hook 'ns-unselect-line) - - ;;;; Preferences handling. (declare-function ns-get-resource "nsfns.m" (owner name)) @@ -784,12 +488,10 @@ unless the current buffer is a scratch buffer." (defun ns-find-file () "Do a `find-file' with the `ns-input-file' as argument." (interactive) - (let ((f) (file) (bufwin1) (bufwin2)) - (setq f (file-truename (car ns-input-file))) - (setq ns-input-file (cdr ns-input-file)) - (setq file (find-file-noselect f)) - (setq bufwin1 (get-buffer-window file 'visible)) - (setq bufwin2 (get-buffer-window "*scratch*" 'visibile)) + (let* ((f (file-truename (pop ns-input-file))) + (file (find-file-noselect f)) + (bufwin1 (get-buffer-window file 'visible)) + (bufwin2 (get-buffer-window "*scratch*" 'visibile))) (cond (bufwin1 (select-frame (window-frame bufwin1)) @@ -808,13 +510,17 @@ unless the current buffer is a scratch buffer." (ns-hide-emacs 'activate) (find-file f))))) - - ;;;; Frame-related functions. ;; Don't show the frame name; that's redundant with Nextstep. (setq-default mode-line-frame-identification '(" ")) +;; nsterm.m +(defvar ns-alternate-modifier) +(defvar ns-right-alternate-modifier) +(defvar ns-right-command-modifier) +(defvar ns-right-control-modifier) + ;; You say tomAYto, I say tomAHto.. (defvaralias 'ns-option-modifier 'ns-alternate-modifier) (defvaralias 'ns-right-option-modifier 'ns-right-alternate-modifier) @@ -881,10 +587,8 @@ unless the current buffer is a scratch buffer." (if (not tool-bar-mode) (tool-bar-mode t))) - ;;;; Dialog-related functions. - ;; Ask user for confirm before printing. Due to Kevin Rodgers. (defun ns-print-buffer () "Interactive front-end to `print-buffer': asks for user confirmation first." @@ -902,7 +606,6 @@ unless the current buffer is a scratch buffer." (error "Cancelled"))) (print-buffer))) - ;;;; Font support. ;; Needed for font listing functions under both backend and normal @@ -947,17 +650,16 @@ come with OS X. See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles. -(if (fboundp 'new-fontset) - (progn - ;; Setup the default fontset. - (create-default-fontset) - ;; Create the standard fontset. - (condition-case err - (create-fontset-from-fontset-spec ns-standard-fontset-spec t) - (error (display-warning - 'initialization - (format "Creation of the standard fontset failed: %s" err) - :error))))) +(when (fboundp 'new-fontset) + ;; Setup the default fontset. + (create-default-fontset) + ;; Create the standard fontset. + (condition-case err + (create-fontset-from-fontset-spec ns-standard-fontset-spec t) + (error (display-warning + 'initialization + (format "Creation of the standard fontset failed: %s" err) + :error)))) (defvar ns-reg-to-script) ; nsfont.m @@ -1021,33 +723,14 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; from x-selection-value. (defvar ns-last-selected-text nil) -(defun x-select-text (text) - "Select TEXT, a string, according to the window system. - -On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the -clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. - -On Nextstep, put TEXT in the pasteboard." - ;; Don't send the pasteboard too much text. - ;; It becomes slow, and if really big it causes errors. - (ns-set-pasteboard text) - (setq ns-last-selected-text text)) - ;; Return the value of the current Nextstep selection. For ;; compatibility with older Nextstep applications, this checks cut ;; buffer 0 before retrieving the value of the primary selection. (defun x-selection-value () (let (text) - ;; Consult the selection. Treat empty strings as if they were unset. (or text (setq text (ns-get-pasteboard))) (if (string= text "") (setq text nil)) - (cond ((not text) nil) ((eq text ns-last-selected-text) nil) @@ -1068,7 +751,6 @@ On Nextstep, put TEXT in the pasteboard." (insert (ns-get-cut-buffer-internal 'SECONDARY))) - ;;;; Scrollbar handling. (global-set-key [vertical-scroll-bar down-mouse-1] 'ns-handle-scroll-bar-event) @@ -1129,27 +811,6 @@ On Nextstep, put TEXT in the pasteboard." ;;;; Color support. -(declare-function ns-list-colors "nsfns.m" (&optional frame)) - -(defvar x-colors (ns-list-colors) - "List of basic colors available on color displays. -For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20. -For Nextstep, this is a list of non-PANTONE colors returned by -the operating system.") - -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors'." - (or frame (setq frame (selected-frame))) - (let ((all-colors x-colors) - (this-color nil) - (defined-colors nil)) - (while all-colors - (setq this-color (car all-colors) - all-colors (cdr all-colors)) - ;; (and (face-color-supported-p frame this-color t) - (setq defined-colors (cons this-color defined-colors))) ;;) - defined-colors)) - ;; Functions for color panel + drag (defun ns-face-at-pos (pos) (let* ((frame (car pos)) @@ -1237,7 +898,7 @@ the operating system.") "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." ;; PENDING: not needed? - (setq command-line-args (ns-handle-args command-line-args)) + (setq command-line-args (x-handle-args command-line-args)) (x-open-connection (system-name) nil t) @@ -1256,12 +917,11 @@ the operating system.") (setq ns-initialized t)) -(add-to-list 'handle-args-function-alist '(ns . ns-handle-args)) +(add-to-list 'handle-args-function-alist '(ns . x-handle-args)) (add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) (add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) (provide 'ns-win) -;; arch-tag: eb138a45-4e2e-4d68-b1c9-a39665731644 ;;; ns-win.el ends here diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index 93f4ea436c3..c13862a8da0 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -1,7 +1,7 @@ ;;; pc-win.el --- setup support for `PC windows' (whatever that is) -;; Copyright (C) 1994, 1996, 1997, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1996, 1997, 1999, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Morten Welinder <terra@diku.dk> ;; Maintainer: FSF @@ -203,9 +203,11 @@ the operating system.") "Non-nil means cutting and pasting uses the clipboard. This is in addition to, but in preference to, the primary selection. -On MS-Windows, this is non-nil by default, since Windows does not -support other types of selections. \(The primary selection that is -set by Emacs is not accessible to other programs on Windows.\)" +Note that MS-Windows does not support selection types other than the +clipboard. (The primary selection that is set by Emacs is not +accessible to other programs on MS-Windows.) + +This variable is not used by the Nextstep port." :type 'boolean :group 'killing) @@ -286,6 +288,16 @@ Disowning it means there is no such selection." (if (x-selection-owner-p selection) t)) +;; x-get-selection-internal is used in select.el +(defun x-get-selection-internal (selection type &optional time_stamp) + "Return text selected from some X window. +SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.) +TYPE is the type of data desired, typically `STRING'. +TIME_STAMP is the time to use in the XConvertSelection call for foreign +selections. If omitted, defaults to the time for the last event." + (x-get-selection-value)) + ;; From src/fontset.c: (fset 'query-fontset 'ignore) @@ -408,5 +420,4 @@ Errors out because it is not supposed to be called, ever." (provide 'pc-win) -;; arch-tag: 5cbdb455-b495-427b-95d0-e417d77d00b4 ;;; pc-win.el ends here diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index cc462455517..df45dc192a7 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -1,7 +1,7 @@ ;;; tty-colors.el --- color support for character terminals -;; 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: Eli Zaretskii ;; Maintainer: FSF @@ -768,11 +768,6 @@ (yes . 8)) "An alist of supported standard tty color modes and their aliases.") -(defvar tty-defined-color-alist nil - "An alist of defined terminal colors and their RGB values. - -See the docstring of `tty-color-alist' for the details.") - (defun tty-color-alist (&optional frame) "Return an alist of colors supported by FRAME's terminal. FRAME defaults to the selected frame. @@ -1039,5 +1034,4 @@ A color is considered gray if the 3 components of its RGB value are equal." (setq colors (cdr colors))) count)) -;; arch-tag: 84d5c3ef-ae22-4754-99ac-e6350c0967ae ;;; tty-colors.el ends here diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 54bb5a5027b..a1ab5a8225c 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -148,18 +148,8 @@ the last file dropped is selected." (global-set-key [language-change] 'ignore) (defvar x-resource-name) -(defvar x-colors) -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors', which see." - (or frame (setq frame (selected-frame))) - (let ((defined-colors nil)) - (dolist (this-color (or (mapcar 'car w32-color-map) x-colors)) - (and (color-supported-p this-color frame t) - (setq defined-colors (cons this-color defined-colors)))) - defined-colors)) - ;;;; Function keys ;;; make f10 activate the real menubar rather than the mini-buffer menu @@ -316,5 +306,4 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (provide 'w32-win) -;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166 ;;; w32-win.el ends here diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index 5da8b84d3f4..0d3aa934b9b 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el @@ -45,7 +45,7 @@ ("white" 15 65535 65535 65535)) "A list of VGA console colors, their indices and 16-bit RGB values.") -(declare-function x-setup-function-keys "w32-fns" (frame)) +(declare-function x-setup-function-keys "term/common-win" (frame)) (defun terminal-init-w32console () "Terminal initialization function for w32 console." @@ -62,4 +62,4 @@ (tty-set-up-initial-frame-faces) (run-hooks 'terminal-init-w32-hook)) -;; arch-tag: 3195fd5e-ab86-4a46-b1dc-4f7a8c8deff3 +;;; w32console.el ends here diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 1950bef19be..afb706ab972 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1,7 +1,7 @@ ;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*- ;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: FSF ;; Keywords: terminals, i18n @@ -252,50 +252,6 @@ exists." (defconst x-pointer-invisible 255) -(defvar x-colors) - -(defun xw-defined-colors (&optional frame) - "Internal function called by `defined-colors'." - (or frame (setq frame (selected-frame))) - (let ((all-colors x-colors) - (this-color nil) - (defined-colors nil)) - (while all-colors - (setq this-color (car all-colors) - all-colors (cdr all-colors)) - (and (color-supported-p this-color frame t) - (setq defined-colors (cons this-color defined-colors)))) - defined-colors)) - -;;;; Function keys - -(defvar x-alternatives-map - (let ((map (make-sparse-keymap))) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (define-key map [M-backspace] [?\M-\d]) - (define-key map [M-delete] [?\M-\d]) - (define-key map [M-tab] [?\M-\t]) - (define-key map [M-linefeed] [?\M-\n]) - (define-key map [M-clear] [?\M-\C-l]) - (define-key map [M-return] [?\M-\C-m]) - (define-key map [M-escape] [?\M-\e]) - (define-key map [iso-lefttab] [backtab]) - (define-key map [S-iso-lefttab] [backtab]) - map) - "Keymap of possible alternative meanings for some keys.") - -(defun x-setup-function-keys (frame) - "Set up `function-key-map' on the graphical frame FRAME." - ;; Don't do this twice on the same display, or it would break - ;; normal-erase-is-backspace-mode. - (unless (terminal-parameter frame 'x-setup-function-keys) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (with-selected-frame frame - (let ((map (copy-keymap x-alternatives-map))) - (set-keymap-parent map (keymap-parent local-function-key-map)) - (set-keymap-parent local-function-key-map map))) - (set-terminal-parameter frame 'x-setup-function-keys t))) - ;;;; Keysyms (defun vendor-specific-keysyms (vendor) @@ -1206,40 +1162,12 @@ pasted text.") "The value of the PRIMARY X selection last time we selected or pasted text.") -(defcustom x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection." - :type 'boolean - :group 'killing - :version "24.1") - (defcustom x-select-enable-primary nil "Non-nil means cutting and pasting uses the primary selection." :type 'boolean :group 'killing :version "24.1") -(defun x-select-text (text) - "Select TEXT, a string, according to the window system. - -On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the -clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. - -On Nextstep, put TEXT in the pasteboard." - ;; With multi-tty, this function may be called from a tty frame. - (when (eq (framep (selected-frame)) 'x) - (when x-select-enable-primary - (x-set-selection 'PRIMARY text) - (setq x-last-selected-text-primary text)) - (when x-select-enable-clipboard - (x-set-selection 'CLIPBOARD text) - (setq x-last-selected-text-clipboard text)))) - (defvar x-select-request-type nil "*Data type request for X selection. The value is one of the following data types, a list of them, or nil: @@ -1351,6 +1279,13 @@ The value nil is the same as this list: (setq interprogram-cut-function 'x-select-text) (setq interprogram-paste-function 'x-selection-value) +;; Make paste from other applications use the decoding in x-select-request-type +;; and not just STRING. +(defun x-get-selection-value () + "Get the current value of the PRIMARY selection. +Request data types in the order specified by `x-select-request-type'." + (x-selection-value-internal 'PRIMARY)) + (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") @@ -1640,5 +1575,4 @@ This uses `icon-map-list' to map icon file names to stock icon names." (provide 'x-win) -;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 ;;; x-win.el ends here diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 0662acf2c50..75dd4f80153 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1,7 +1,8 @@ ;;; bibtex.el --- BibTeX mode for GNU Emacs ;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> ;; Bengt Martensson <bengt@mathematik.uni-Bremen.de> @@ -3835,16 +3836,16 @@ Return t if test was successful, nil otherwise." (with-current-buffer (get-buffer-create err-buf) (setq default-directory dir) (unless (eq major-mode 'compilation-mode) (compilation-mode)) - (toggle-read-only -1) - (delete-region (point-min) (point-max)) - (insert "BibTeX mode command `bibtex-validate'\n" - (if syntax-error - "Maybe undetected errors due to syntax errors. Correct and validate again.\n" - "\n")) - (dolist (err error-list) - (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) - (set-buffer-modified-p nil) - (toggle-read-only 1) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate'\n" + (if syntax-error + "Maybe undetected errors due to syntax errors. \ +Correct and validate again.\n" + "\n")) + (dolist (err error-list) + (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) + (set-buffer-modified-p nil)) (goto-char (point-min)) (forward-line 2)) ; first error message (display-buffer err-buf) @@ -3896,12 +3897,11 @@ Return t if test was successful, nil otherwise." (let ((err-buf "*BibTeX validation errors*")) (with-current-buffer (get-buffer-create err-buf) (unless (eq major-mode 'compilation-mode) (compilation-mode)) - (toggle-read-only -1) - (delete-region (point-min) (point-max)) - (insert "BibTeX mode command `bibtex-validate-globally'\n\n") - (dolist (err (sort error-list 'string-lessp)) (insert err)) - (set-buffer-modified-p nil) - (toggle-read-only 1) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate-globally'\n\n") + (dolist (err (sort error-list 'string-lessp)) (insert err)) + (set-buffer-modified-p nil)) (goto-char (point-min)) (forward-line 2)) ; first error message (display-buffer err-buf) @@ -4778,5 +4778,4 @@ Return the URL or nil if none can be generated." (provide 'bibtex) -;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04 ;;; bibtex.el ends here diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index be3fd5a1789..2dd7b1e2c95 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -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 @@ The fill column to use for a line is the first column at which the column 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 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines." "") string)) -;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d ;;; fill.el ends here diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 8a73a0f818e..5dbcb2d7d77 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -380,7 +380,8 @@ like <img alt=\"Some thing.\">." (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 @@ -494,9 +495,9 @@ in your .emacs file. :keymap flyspell-mode-map :group 'flyspell (if flyspell-mode - (condition-case () + (condition-case err (flyspell-mode-on) - (error (message "Enabling Flyspell mode gave an error") + (error (message "Error enabling Flyspell mode:\n%s" (cdr err)) (flyspell-mode -1))) (flyspell-mode-off))) @@ -1013,11 +1014,13 @@ Mostly we check word delimiters." ;;*---------------------------------------------------------------------*/ ;;* 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 @@ than preceding) word when the cursor is not over a word." (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 @@ The buffer to mark them in is `flyspell-large-region-buffer'." 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)))) @@ -1465,7 +1474,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (goto-char (point-min)) ;; Localwords parsing copied from ispell.el. (while (search-forward ispell-words-keyword nil t) - (let ((end (save-excursion (end-of-line) (point))) + (let ((end (point-at-eol)) string) ;; buffer-local words separated by a space, and can contain ;; any character other than a space. Not rigorous enough. @@ -2354,5 +2363,4 @@ This function is meant to be added to `flyspell-incorrect-hook'." (provide 'flyspell) -;; arch-tag: 05d915b9-e9cf-44fb-9137-fc28f5eaab2a ;;; flyspell.el ends here diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index c773aadd3d8..9a494897b74 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1,7 +1,8 @@ ;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 ;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 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: Ken Stevens <k.stevens@ieee.org> ;; Maintainer: Ken Stevens <k.stevens@ieee.org> @@ -983,19 +984,32 @@ Assumes that value contains no whitespace." (car (split-string (buffer-string))))) (defun ispell-aspell-find-dictionary (dict-name) - ;; This returns nil if the data file does not exist. - ;; Can someone please explain the return value format when the - ;; file does exist -- rms? - (let* ((lang ;; Strip out variant, etc. - (and (string-match "^[[:alpha:]_]+" dict-name) - (match-string 0 dict-name))) + "For aspell dictionary DICT-NAME, return a list of parameters if an + associated data file is found or nil otherwise. List format is + that of `ispell-dictionary-base-alist' elements." + ;; Make sure `ispell-aspell-data-dir' is defined + (or ispell-aspell-data-dir + (setq ispell-aspell-data-dir + (ispell-get-aspell-config-value "data-dir"))) + ;; Try finding associated datafile + (let* ((datafile1 + (concat ispell-aspell-data-dir "/" + ;; Strip out variant, country code, etc. + (and (string-match "^[[:alpha:]]+" dict-name) + (match-string 0 dict-name)) ".dat")) + (datafile2 + (concat ispell-aspell-data-dir "/" + ;; Strip out anything but xx_YY. + (and (string-match "^[[:alpha:]_]+" dict-name) + (match-string 0 dict-name)) ".dat")) (data-file - (concat (or ispell-aspell-data-dir - (setq ispell-aspell-data-dir - (ispell-get-aspell-config-value "data-dir"))) - "/" lang ".dat")) + (if (file-readable-p datafile1) + datafile1 + (if (file-readable-p datafile2) + datafile2))) otherchars) - (condition-case () + + (if data-file (with-temp-buffer (insert-file-contents data-file) ;; There is zero or one line with special characters declarations. @@ -1023,9 +1037,7 @@ Assumes that value contains no whitespace." ;; Here we specify the encoding to use while communicating with ;; aspell. This doesn't apply to command line arguments, so ;; just don't pass words to spellcheck as arguments... - 'utf-8)) - (file-error - nil)))) + 'utf-8))))) (defun ispell-aspell-add-aliases (alist) "Find aspell's dictionary aliases and add them to dictionary ALIST. @@ -2728,9 +2740,11 @@ Keeps argument list for future ispell invocations for no async support." (if extended-char-mode ; ~ extended character mode (ispell-send-string (concat extended-char-mode "\n")))) (if ispell-async-processp - (if (fboundp 'set-process-query-on-exit-flag) ;; not XEmacs + (if (featurep 'emacs) (set-process-query-on-exit-flag ispell-process nil) - (process-kill-without-query ispell-process)))))) + (if (fboundp 'set-process-query-on-exit-flag) + (set-process-query-on-exit-flag ispell-process nil) + (process-kill-without-query ispell-process))))))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error) @@ -2898,8 +2912,7 @@ Return nil if spell session is quit, (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 @@ -3801,7 +3814,7 @@ Includes Latex/Nroff modes and extended character mode." (goto-char (point-max)) ;; Uses last occurrence of ispell-parsing-keyword (if (search-backward ispell-parsing-keyword nil t) - (let ((end (save-excursion (end-of-line) (point))) + (let ((end (point-at-eol)) string) (search-forward ispell-parsing-keyword) (while (re-search-forward " *\\([^ \"]+\\)" end t) @@ -3837,7 +3850,7 @@ Both should not be used to define a buffer-local dictionary." (if (search-backward ispell-dictionary-keyword nil t) (progn (search-forward ispell-dictionary-keyword) - (setq end (save-excursion (end-of-line) (point))) + (setq end (point-at-eol)) (if (re-search-forward " *\\([^ \"]+\\)" end t) (setq ispell-local-dictionary (match-string-no-properties 1)))))) @@ -3845,7 +3858,7 @@ Both should not be used to define a buffer-local dictionary." (if (search-backward ispell-pdict-keyword nil t) (progn (search-forward ispell-pdict-keyword) - (setq end (save-excursion (end-of-line) (point))) + (setq end (point-at-eol)) (if (re-search-forward " *\\([^ \"]+\\)" end t) (setq ispell-local-pdict (match-string-no-properties 1))))))) @@ -3869,7 +3882,7 @@ Both should not be used to define a buffer-local dictionary." (while (search-forward ispell-words-keyword nil t) (or ispell-buffer-local-name (setq ispell-buffer-local-name (buffer-name))) - (let ((end (save-excursion (end-of-line) (point))) + (let ((end (point-at-eol)) (ispell-casechars (ispell-get-casechars)) string) ;; buffer-local words separated by a space, and can contain @@ -3885,6 +3898,9 @@ Both should not be used to define a buffer-local dictionary." ;;; returns optionally adjusted region-end-point. +;; If comment-padright is defined, newcomment must be loaded. +(declare-function comment-add "newcomment" (arg)) + (defun ispell-add-per-file-word-list (word) "Add WORD to the per-file word list." (or ispell-buffer-local-name @@ -3959,5 +3975,4 @@ Both should not be used to define a buffer-local dictionary." ; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict unsplitable ; LocalWords: lns XEmacs HTML casechars Multibyte -;; arch-tag: 4941b9f9-3b7c-4a76-a4ed-5fa8b6010ef5 ;;; ispell.el ends here diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index 05065cd4427..548223e4f2c 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -671,7 +671,7 @@ Used by `pages-directory' function." (setq position (make-marker)) (set-marker position (point)) (let ((start (point)) - (end (save-excursion (end-of-line) (point))) + (end (line-end-position)) inserted-at) ;; change to directory buffer (set-buffer standard-output) @@ -783,7 +783,7 @@ directory." (delete-other-windows)) (save-excursion (goto-char (point-min)) - (delete-region (point) (save-excursion (end-of-line) (point))) + (delete-region (point) (line-end-position)) (insert "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===") (set-buffer-modified-p nil) @@ -801,5 +801,4 @@ to the same line in the pages buffer." (provide 'page-ext) -;; arch-tag: 2f311550-c6e0-4458-9c12-7f039c058bdb ;;; page-ext.el ends here diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 89e1020db98..98add4cfd28 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -226,16 +226,30 @@ Do \\[command-apropos] picture-movement to see commands which control motion." (picture-motion (- arg))) (defun picture-mouse-set-point (event) - "Move point to the position clicked on, making whitespace if necessary." + "Move point to the position of EVENT, making whitespace if necessary." (interactive "e") - (let* ((pos (posn-col-row (event-start event))) - (x (car pos)) - (y (cdr pos)) - (current-row (count-lines (window-start) (line-beginning-position)))) - (unless (equal x (current-column)) - (picture-forward-column (- x (current-column)))) - (unless (equal y current-row) - (picture-move-down (- y current-row))))) + (let ((position (event-start event))) + (unless (posn-area position) ; Ignore EVENT unless in text area + (let* ((window (posn-window position)) + (frame (if (framep window) window (window-frame window))) + (pair (posn-x-y position)) + (start-pos (window-start window)) + (start-pair (posn-x-y (posn-at-point start-pos))) + (dx (- (car pair) (car start-pair))) + (dy (- (cdr pair) (cdr start-pair))) + (char-ht (frame-char-height frame)) + (spacing (when (display-graphic-p frame) + (or (with-current-buffer (window-buffer window) + line-spacing) + (frame-parameter frame 'line-spacing)))) + rows cols) + (cond ((floatp spacing) + (setq spacing (truncate (* spacing char-ht)))) + ((null spacing) + (setq spacing 0))) + (goto-char start-pos) + (picture-move-down (/ dy (+ char-ht spacing))) + (picture-forward-column (/ dx (frame-char-width frame))))))) ;; Picture insertion and deletion. @@ -438,7 +452,7 @@ If no such character is found, move to beginning of line." (move-to-column target)) (if (re-search-forward (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]") - (save-excursion (end-of-line) (point)) + (line-end-position) 'move) (setq target (1- (current-column))) (setq target nil))) @@ -775,5 +789,4 @@ Runs `picture-mode-exit-hook' at the end." (provide 'picture) -;; arch-tag: e452d08d-a470-4fbf-896e-ea276698d1ca ;;; picture.el ends here diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 79797b4791b..2c8a14a3808 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -358,27 +358,30 @@ (message "Scanning thebibliography environment in %s" file) (with-current-buffer buf - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward - "\\(\\`\\|[\n\r]\\)[ \t]*\\\\begin{thebibliography}" nil t) - (beginning-of-line 2) - (setq start (point)) - (if (re-search-forward - "\\(\\`\\|[\n\r]\\)[ \t]*\\\\end{thebibliography}" nil t) - (progn - (beginning-of-line 1) - (setq end (point)))) - (when (and start end) - (setq entries - (append entries - (mapcar 'reftex-parse-bibitem - (delete "" - (split-string - (buffer-substring-no-properties start end) - "[ \t\n\r]*\\\\bibitem\\(\\[[^]]*]\\)*")))))) - (goto-char end))))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward + "\\(\\`\\|[\n\r]\\)[ \t]*\\\\begin{thebibliography}" nil t) + (beginning-of-line 2) + (setq start (point)) + (if (re-search-forward + "\\(\\`\\|[\n\r]\\)[ \t]*\\\\end{thebibliography}" nil t) + (progn + (beginning-of-line 1) + (setq end (point)))) + (when (and start end) + (setq entries + (append entries + (mapcar 'reftex-parse-bibitem + (delete "" + (split-string + (buffer-substring-no-properties + start end) + "[ \t\n\r]*\\\\bibitem[ \t]*\ +\\(\\[[^]]*]\\)*\[ \t]*")))))) + (goto-char end)))))) (unless entries (error "No bibitems found")) @@ -1144,9 +1147,8 @@ The sequence in the new file is the same as it was in the old database." (save-restriction (widen) (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*@[a-zA-Z]+[ \t]*{\\([^ \t\r\n]+\\)," - nil t) + (while (re-search-forward "^[ \t]*@\\(?:\\w\\|\\s_\\)+[ \t\n\r]*\ +\[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t) (setq key (match-string 1) beg (match-beginning 0) end (progn diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index dee7a319260..2da5897827d 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -1699,7 +1699,7 @@ it first compares the macro identifying chars and then the phrases." (let* ((lines (split-string (buffer-substring beg end) "\n")) (lines1 (sort lines 'reftex-compare-phrase-lines))) (message "Sorting lines...done") - (let ((inhibit-quit t)) ;; make sure we do not loose lines + (let ((inhibit-quit t)) ;; make sure we do not lose lines (delete-region beg end) (insert (mapconcat 'identity lines1 "\n")))) (goto-char (point-max)) @@ -2104,5 +2104,4 @@ Does not do a save-excursion." ["Save and Return" reftex-index-phrases-save-and-return t])) -;; arch-tag: 4b2362af-c156-42c1-8932-ea2823e205c1 ;;; reftex-index.el ends here diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 23723489d13..91cc77480eb 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -180,8 +180,8 @@ This function is controlled by the settings of reftex-insert-label-flags." (string-match "^[ \t]*$" default)) (setq default prefix force-prompt t) ; need to prompt - (setq default - (concat prefix + (setq default + (concat prefix (funcall reftex-string-to-label-function default))) ;; Make it unique. @@ -227,7 +227,7 @@ This function is controlled by the settings of reftex-insert-label-flags." ((setq entry (assoc label (symbol-value reftex-docstruct-symbol))) (ding) - (if (y-or-n-p + (if (y-or-n-p (format "Label '%s' exists. Use anyway? " label)) (setq valid t))) @@ -237,9 +237,9 @@ This function is controlled by the settings of reftex-insert-label-flags." (setq label default)) ;; Insert the label into the label list - (let* ((here-I-am-info + (let* ((here-I-am-info (save-excursion - (if (and (or naked no-insert) + (if (and (or naked no-insert) (integerp (cdr macro-cell))) (goto-char (cdr macro-cell))) (reftex-where-am-I))) @@ -294,7 +294,7 @@ also applies `reftex-translate-to-ascii-function' to the string." ;; Translate the upper 128 chars in the Latin-1 charset to ASCII equivalents (let ((tab "@@@@@@@@@@@@@@@@@@'@@@@@@@@@@@@@ icLxY|S\"ca<--R-o|23'uq..1o>423?AAAAAAACEEEEIIIIDNOOOOOXOUUUUYP3aaaaaaaceeeeiiiidnooooo:ouuuuypy") (emacsp (not (featurep 'xemacs)))) - (mapconcat + (mapconcat (lambda (c) (cond ((and (> c 127) (< c 256)) ; 8 bit Latin-1 (char-to-string (aref tab (- c 128)))) @@ -430,7 +430,7 @@ When called with 2 C-u prefix args, disable magic word recognition." type (car type)) (setq type (reftex-query-label-type)))) - (let* ((refstyle + (let* ((reftex-refstyle (cond ((reftex-typekey-check type reftex-vref-is-default) "\\vref") ((reftex-typekey-check type reftex-fref-is-default) "\\fref") (t "\\ref"))) @@ -452,7 +452,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (setq type (nth 1 (car labels)) form (or (cdr (assoc type reftex-typekey-to-format-alist)) form)) - + (cond (no-insert ;; Just return the first label @@ -466,7 +466,7 @@ When called with 2 C-u prefix args, disable magic word recognition." sep (nth 2 (car labels)) sep1 (cdr (assoc sep reftex-multiref-punctuation)) labels (cdr labels)) - (when cut + (when cut (backward-delete-char cut) (setq cut nil)) @@ -477,9 +477,9 @@ When called with 2 C-u prefix args, disable magic word recognition." ;; do we have a special format? (setq reftex-format-ref-function (cond - ((string= refstyle "\\vref") 'reftex-format-vref) - ((string= refstyle "\\fref") 'reftex-format-fref) - ((string= refstyle "\\Fref") 'reftex-format-Fref) + ((string= reftex-refstyle "\\vref") 'reftex-format-vref) + ((string= reftex-refstyle "\\fref") 'reftex-format-fref) + ((string= reftex-refstyle "\\Fref") 'reftex-format-Fref) (t reftex-format-ref-function))) ;; ok, insert the reference (if sep1 (insert sep1)) @@ -501,7 +501,7 @@ When called with 2 C-u prefix args, disable magic word recognition." matched cell) (save-excursion (while (and (setq cell (pop words)) - (not (setq matched + (not (setq matched (re-search-backward (car cell) bound t)))))) (if matched (cons (cdr cell) (- (match-end 0) (match-end 1))) @@ -549,7 +549,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (setq mode-line-format (list "---- " 'mode-line-buffer-identification " " 'global-mode-string " (" mode-name ")" - " S<" 'refstyle ">" + " S<" 'reftex-refstyle ">" " -%-")) (cond ((= 0 (buffer-size)) @@ -564,9 +564,9 @@ When called with 2 C-u prefix args, disable magic word recognition." context counter commented - (or here-I-am offset) + (or here-I-am offset) prefix - nil ; no a toc buffer + nil ; no a toc buffer )))) (here-I-am (setq offset (reftex-get-offset buf here-I-am typekey))) @@ -690,13 +690,13 @@ When called with 2 C-u prefix args, disable magic word recognition." (defun reftex-query-label-type () ;; Ask for label type - (let ((key (reftex-select-with-char + (let ((key (reftex-select-with-char reftex-type-query-prompt reftex-type-query-help 3))) (unless (member (char-to-string key) reftex-typekey-list) (error "No such label type: %s" (char-to-string key))) (char-to-string key))) -(defun reftex-show-label-location (data forward no-revisit +(defun reftex-show-label-location (data forward no-revisit &optional stay error) ;; View the definition site of a label in another window. ;; DATA is an entry from the docstruct list. @@ -718,7 +718,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (throw 'exit nil)) ;; Goto the file in another window - (setq buffer + (setq buffer (if no-revisit (reftex-get-buffer-visiting file) (reftex-get-file-buffer-force @@ -784,7 +784,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (when (or (not (eq major-mode 'latex-mode)) (not font-lock-mode)) (latex-mode) - (run-hook-with-args + (run-hook-with-args 'reftex-pre-refontification-functions reftex-call-back-to-this-buffer 'reftex-hidden) (turn-on-font-lock)) @@ -830,8 +830,16 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." (reftex-access-scan-info) (let* ((wcfg (current-window-configuration)) (docstruct (symbol-value reftex-docstruct-symbol)) - (label (completing-read "Label: " docstruct - (lambda (x) (stringp (car x))) t)) + ;; If point is inside a \ref{} or \pageref{}, use that as + ;; default value. + (default (when (looking-back "\\\\\\(?:page\\)?ref{[-a-zA-Z0-9_*.:]*") + (reftex-this-word "-a-zA-Z0-9_*.:"))) + (label (completing-read (if default + (format "Label (default %s): " default) + "Label: ") + docstruct + (lambda (x) (stringp (car x))) t nil nil + default)) (selection (assoc label docstruct)) (where (progn (reftex-show-label-location selection t nil 'stay) @@ -839,10 +847,8 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." (unless other-window (set-window-configuration wcfg) (switch-to-buffer (marker-buffer where)) - (goto-char where)) + (goto-char where)) (reftex-unhighlight 0))) - -;; arch-tag: 52f14032-fb76-4d31-954f-750c72415675 ;;; reftex-ref.el ends here diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index bebeb1cd51a..bb6531d7980 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -369,22 +369,21 @@ During a selection process, these are the local bindings. (defvar reftex-last-line nil) (defvar reftex-select-marked nil) -(defun reftex-select-item (prompt help-string keymap +(defun reftex-select-item (reftex-select-prompt help-string keymap &optional offset call-back cb-flag) -;; Select an item, using PROMPT. The function returns a key indicating -;; an exit status, along with a data structure indicating which item was -;; selected. -;; HELP-STRING contains help. KEYMAP is a keymap with the available -;; selection commands. -;; OFFSET can be a label list item which will be selected at start. -;; When it is t, point will start out at the beginning of the buffer. -;; Any other value will cause restart where last selection left off. -;; When CALL-BACK is given, it is a function which is called with the index -;; of the element. -;; CB-FLAG is the initial value of that flag. - - (let* (ev data last-data (selection-buffer (current-buffer))) + ;; Select an item, using REFTEX-SELECT-PROMPT. + ;; The function returns a key indicating an exit status, along with a + ;; data structure indicating which item was selected. + ;; HELP-STRING contains help. KEYMAP is a keymap with the available + ;; selection commands. + ;; OFFSET can be a label list item which will be selected at start. + ;; When it is t, point will start out at the beginning of the buffer. + ;; Any other value will cause restart where last selection left off. + ;; When CALL-BACK is given, it is a function which is called with the index + ;; of the element. + ;; CB-FLAG is the initial value of that flag. + (let (ev reftex-select-data last-data (selection-buffer (current-buffer))) (setq reftex-select-marked nil) @@ -404,7 +403,7 @@ During a selection process, these are the local bindings. (use-local-map keymap) (add-hook 'pre-command-hook 'reftex-select-pre-command-hook nil t) (add-hook 'post-command-hook 'reftex-select-post-command-hook nil t) - (princ prompt) + (princ reftex-select-prompt) (set-marker reftex-recursive-edit-marker (point)) ;; XEmacs does not run post-command-hook here (and (featurep 'xemacs) (run-hooks 'post-command-hook)) @@ -426,19 +425,18 @@ During a selection process, these are the local bindings. (reftex-kill-buffer "*RefTeX Help*") (setq reftex-callback-fwd (not reftex-callback-fwd)) ;; ;-))) (message "") - (list ev data last-data))) + (list ev reftex-select-data last-data))) ;; The following variables are all bound dynamically in `reftex-select-item'. ;; The defvars are here only to silence the byte compiler. (defvar found-list) (defvar cb-flag) -(defvar data) -(defvar prompt) +(defvar reftex-select-data) +(defvar reftex-select-prompt) (defvar last-data) (defvar call-back) (defvar help-string) -(defvar refstyle) ;; The selection commands @@ -448,15 +446,15 @@ During a selection process, these are the local bindings. (defun reftex-select-post-command-hook () (let (b e) - (setq data (get-text-property (point) :data)) - (setq last-data (or data last-data)) + (setq reftex-select-data (get-text-property (point) :data)) + (setq last-data (or reftex-select-data last-data)) - (when (and data cb-flag + (when (and reftex-select-data cb-flag (not (equal reftex-last-follow-point (point)))) (setq reftex-last-follow-point (point)) - (funcall call-back data reftex-callback-fwd + (funcall call-back reftex-select-data reftex-callback-fwd (not reftex-revisit-to-follow))) - (if data + (if reftex-select-data (setq b (or (previous-single-property-change (1+ (point)) :data) (point-min)) @@ -470,7 +468,7 @@ During a selection process, these are the local bindings. (not (pos-visible-in-window-p e))) (recenter '(4))) (unless (current-message) - (princ prompt)))) + (princ reftex-select-prompt)))) (defun reftex-select-next (&optional arg) "Move to next selectable item." @@ -531,19 +529,22 @@ Useful for large TOC's." (interactive) (setq reftex-last-follow-point -1) (setq cb-flag (not cb-flag))) + +(defvar reftex-refstyle) ; from reftex-reference + (defun reftex-select-toggle-varioref () "Toggle the macro used for referencing the label between \\ref and \\vref." (interactive) - (if (string= refstyle "\\ref") - (setq refstyle "\\vref") - (setq refstyle "\\ref")) + (if (string= reftex-refstyle "\\ref") + (setq reftex-refstyle "\\vref") + (setq reftex-refstyle "\\ref")) (force-mode-line-update)) (defun reftex-select-toggle-fancyref () "Toggle the macro used for referencing the label between \\ref and \\vref." (interactive) - (setq refstyle - (cond ((string= refstyle "\\ref") "\\fref") - ((string= refstyle "\\fref") "\\Fref") + (setq reftex-refstyle + (cond ((string= reftex-refstyle "\\ref") "\\fref") + ((string= reftex-refstyle "\\fref") "\\Fref") (t "\\ref"))) (force-mode-line-update)) (defun reftex-select-show-insertion-point () @@ -560,7 +561,7 @@ Useful for large TOC's." (defun reftex-select-callback () "Show full context in another window." (interactive) - (if data (funcall call-back data reftex-callback-fwd nil) (ding))) + (if reftex-select-data (funcall call-back reftex-select-data reftex-callback-fwd nil) (ding))) (defun reftex-select-accept () "Accept the currently selected item." (interactive) @@ -569,8 +570,8 @@ Useful for large TOC's." "Accept the item at the mouse click." (interactive "e") (mouse-set-point ev) - (setq data (get-text-property (point) :data)) - (setq last-data (or data last-data)) + (setq reftex-select-data (get-text-property (point) :data)) + (setq last-data (or reftex-select-data last-data)) (throw 'myexit 'return)) (defun reftex-select-read-label () "Use minibuffer to read a label to reference, with completion." @@ -588,8 +589,8 @@ Useful for large TOC's." (cond ((or (null key) (equal key ""))) (entry - (setq data entry) - (setq last-data data) + (setq reftex-select-data entry) + (setq last-data reftex-select-data) (throw 'myexit 'return)) (t (throw 'myexit key))))) @@ -736,5 +737,4 @@ Useful for large TOC's." do (define-key reftex-select-bib-map (car x) (cdr x))) -;; arch-tag: 842078ff-0586-4e0b-957e-536e08218464 ;;; reftex-sel.el ends here diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 41ea83b077f..20903706a0e 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -545,8 +545,6 @@ Useful for large TOC's." ;; Promotion/Demotion stuff -(defvar delta) -(defvar mpos) (defvar pro-or-de) (defvar start-pos) (defvar start-line) @@ -575,7 +573,7 @@ point." (if (bolp) 1 0))))) (start-pos (point)) (pro-or-de (if (> delta 0) "de" "pro")) - beg end entries data sections nsec mpos msg) + beg end entries data sections nsec msg) (setq msg (catch 'exit (if (reftex-region-active-p) @@ -602,7 +600,9 @@ point." (reftex-toc-extract-section-number (nth (1- nsec) entries))))) ;; Run through the list and prepare the changes. - (setq entries (mapcar 'reftex-toc-promote-prepare entries)) + (setq entries (mapcar + (lambda (e) (reftex-toc-promote-prepare e delta)) + entries)) ;; Ask for permission (if (or (not reftex-toc-confirm-promotion) ; never confirm (and (integerp reftex-toc-confirm-promotion) ; confirm if many @@ -629,31 +629,26 @@ point." (defun reftex-toc-restore-region (point-line &optional mark-line) - (when mark-line - (goto-char (point-min)) - (forward-line (1- mark-line)) - (setq mpos (point))) - (when point-line - (goto-char (point-min)) - (forward-line (1- point-line))) - (if mark-line - (progn - (set-mark mpos) - (if (featurep 'xemacs) - (zmacs-activate-region) - (setq mark-active t - deactivate-mark nil))))) - -(defvar name1) -(defvar dummy) -(defvar dummy2) - -(defun reftex-toc-promote-prepare (x) + (let (mpos) + (when mark-line + (goto-char (point-min)) + (forward-line (1- mark-line)) + (setq mpos (point))) + (when point-line + (goto-char (point-min)) + (forward-line (1- point-line))) + (when mark-line + (set-mark mpos) + (if (featurep 'xemacs) + (zmacs-activate-region) + (setq mark-active t + deactivate-mark nil))))) + +(defun reftex-toc-promote-prepare (x delta) "Look at a toc entry and see if we could pro/demote it. -Expects the level change DELTA to be dynamically scoped into this function. This function prepares everything for the changes, but does not do it. The return value is a list with information needed when doing the -promotion/demotion later." +promotion/demotion later. DELTA is the level change." (let* ((data (car x)) (toc-point (cdr x)) (marker (nth 4 data)) @@ -678,7 +673,7 @@ promotion/demotion later." (error "Something is wrong! Contact maintainer!"))) ;; Section has changed, request scan and loading ;; We use a variable to delay until after the safe-exc. - ;; because otherwise we loose the region. + ;; because otherwise we lose the region. (setq load t))) ;; Scan document and load all files, this exits command (if load (reftex-toc-load-all-files-for-promotion))) ; exits @@ -689,7 +684,6 @@ promotion/demotion later." (progn (goto-char toc-point) (error "Cannot %smote special sections" pro-or-de)))) - ;; Delta is dynamically scoped into here... (newlevel (if (>= level 0) (+ delta level) (- level delta))) (dummy2 (if (or (and (>= level 0) (= newlevel -1)) (and (< level 0) (= newlevel 0))) @@ -703,7 +697,7 @@ promotion/demotion later." (defun reftex-toc-promote-action (x) "Change the level of a toc entry. -DELTA and PRO-OR-DE are assumed to be dynamically scoped into this function." +PRO-OR-DE is assumed to be dynamically scoped into this function." (let* ((data (car x)) (name (nth 1 x)) (newname (nth 2 x)) @@ -1100,5 +1094,4 @@ always show the current section in connection with the option ["Help" reftex-toc-show-help t])) -;; arch-tag: 92400ce2-0b86-4c89-a606-4ed71acea17e ;;; reftex-toc.el ends here diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index d4de4e49b93..ab2c27563b0 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -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 @@ With a prefix or a visible region, use the region as INITIAL." (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 @@ In which case `remember-mailbox' should be the name of the mailbox. 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 @@ the data away for latter retrieval, and possible indexing. \\{remember-mode-map}" (set-keymap-parent remember-mode-map nil)) -;; arch-tag: 59312a05-06c7-4da1-b6f7-5ea41c9d5577 ;;; remember.el ends here diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index afc4dd892c9..5bf1a7c7894 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -698,11 +698,9 @@ existing decoration, they are removed before adding the requested decoration." (interactive) - (let (marker - len) - (end-of-line) - (setq marker (point-marker)) + (let ((marker (point-marker)) + len) ;; Fixup whitespace at the beginning and end of the line (if (or (null indent) (eq style 'simple)) @@ -789,7 +787,7 @@ This function does not detect the hierarchy of decorations, it just finds all of them in a file. You can then invoke another function to remove redundancies and inconsistencies." - (let (positions + (let ((positions ()) (curline 1)) ;; Iterate over all the section titles/decorations in the file. (save-excursion @@ -870,7 +868,7 @@ A decoration can be said to exist if the style is not nil. A point can be specified to go to the given location before extracting the decoration." - (let (char style indent) + (let (char style) (save-excursion (if point (goto-char point)) (beginning-of-line) @@ -879,10 +877,10 @@ extracting the decoration." (forward-line -1) (rst-line-homogeneous-nodent-p))) - (under (save-excursion - (forward-line +1) - (rst-line-homogeneous-nodent-p))) - ) + (under (save-excursion + (forward-line +1) + (rst-line-homogeneous-nodent-p))) + ) ;; Check that the line above the overline is not part of a title ;; above it. @@ -910,15 +908,11 @@ extracting the decoration." ;; Both overline and underline. (t (setq char under - style 'over-and-under)) - ) - ) - ) - ;; Find indentation. - (setq indent (save-excursion (back-to-indentation) (current-column))) - ) - ;; Return values. - (list char style indent))) + style 'over-and-under))))) + ;; Return values. + (list char style + ;; Find indentation. + (save-excursion (back-to-indentation) (current-column)))))) (defun rst-get-decorations-around (&optional alldecos) @@ -1041,7 +1035,7 @@ b. a negative numerical argument, which generally inverts the (interactive) (let* (;; Save our original position on the current line. - (origpt (set-marker (make-marker) (point))) + (origpt (point-marker)) ;; Parse the positive and negative prefix arguments. (reverse-direction @@ -1395,32 +1389,28 @@ hierarchy is similar to that used by `rst-adjust-decoration'." ;; Create a list of markers for all the decorations which are found within ;; the region. (save-excursion - (let (m line) + (let (line) (while (and cur (< (setq line (caar cur)) region-end-line)) - (setq m (make-marker)) (goto-char (point-min)) (forward-line (1- line)) - (push (list (set-marker m (point)) (cdar cur)) marker-list) + (push (list (point-marker) (cdar cur)) marker-list) (setq cur (cdr cur)) )) ;; Apply modifications. - (let (nextdeco) - (dolist (p marker-list) - ;; Go to the decoration to promote. - (goto-char (car p)) - - ;; Rotate the next decoration. - (setq nextdeco (rst-get-next-decoration - (cadr p) hier suggestion demote)) - - ;; Update the decoration. - (apply 'rst-update-section nextdeco) - - ;; Clear marker to avoid slowing down the editing after we're done. - (set-marker (car p) nil) - )) + (dolist (p marker-list) + ;; Go to the decoration to promote. + (goto-char (car p)) + + ;; Update the decoration. + (apply 'rst-update-section + ;; Rotate the next decoration. + (rst-get-next-decoration + (cadr p) hier suggestion demote)) + + ;; Clear marker to avoid slowing down the editing after we're done. + (set-marker (car p) nil)) (setq deactivate-mark nil) - ))) + ))) @@ -1463,11 +1453,10 @@ in order to adapt it to our preferred style." (levels-and-markers (mapcar (lambda (deco) (cons (rst-position (cdr deco) hier) - (let ((m (make-marker))) + (progn (goto-char (point-min)) (forward-line (1- (car deco))) - (set-marker m (point)) - m))) + (point-marker)))) alldecos)) ) (dolist (lm levels-and-markers) @@ -1511,7 +1500,7 @@ section levels." "Find all the positions of prefixes in region between BEG and END. This is used to find bullets and enumerated list items. PFX-RE is a regular expression for matching the lines with items." - (let (pfx) + (let ((pfx ())) (save-excursion (goto-char beg) (while (< (point) end) @@ -1635,10 +1624,9 @@ child. This has advantages later in processing the graph." (forward-line (1- (car deco))) (list (gethash (cons (cadr deco) (caddr deco)) levels) (rst-get-stripped-line) - (let ((m (make-marker))) + (progn (beginning-of-line 1) - (set-marker m (point))) - )) + (point-marker)))) alldecos))) (let ((lcontnr (cons nil lines))) @@ -2057,11 +2045,11 @@ brings the cursor in that section." "In `rst-toc' mode, go to the occurrence whose line you click on. EVENT is the input event." (interactive "e") - (let (pos) + (let ((pos (with-current-buffer (window-buffer (posn-window (event-end event))) (save-excursion (goto-char (posn-point (event-end event))) - (setq pos (rst-toc-mode-find-section)))) + (rst-toc-mode-find-section))))) (pop-to-buffer (marker-buffer pos)) (goto-char pos) (recenter 5))) @@ -2306,8 +2294,8 @@ of (COLUMN-NUMBER . LINE) pairs." (defun rst-shift-region-guts (find-next-fun offset-fun) "(See `rst-shift-region-right' for a description)." - (let* ((mbeg (set-marker (make-marker) (region-beginning))) - (mend (set-marker (make-marker) (region-end))) + (let* ((mbeg (copy-marker (region-beginning))) + (mend (copy-marker (region-end))) (tabs (rst-compute-bullet-tabs mbeg)) (leftmostcol (rst-find-leftmost-column (region-beginning) (region-end))) ) @@ -2386,8 +2374,8 @@ Also, if invoked with a negative prefix arg, the entire indentation is removed, up to the leftmost character in the region, and automatic filling is disabled." (interactive "P") - (let ((mbeg (set-marker (make-marker) (region-beginning))) - (mend (set-marker (make-marker) (region-end))) + (let ((mbeg (copy-marker (region-beginning))) + (mend (copy-marker (region-end))) (leftmostcol (rst-find-leftmost-column (region-beginning) (region-end))) (rst-shift-fill-region @@ -2421,8 +2409,7 @@ Set FIRST-ONLY to true if you want to callback on the first line of each paragraph only." `(save-excursion (let ((leftcol (rst-find-leftmost-column ,beg ,end)) - (endm (set-marker (make-marker) ,end)) - ) + (endm (copy-marker ,end))) (do* (;; Iterate lines (l (progn (goto-char ,beg) (back-to-indentation)) @@ -2460,8 +2447,7 @@ first of a paragraph." `(save-excursion (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) - (endm (set-marker (make-marker) ,end)) - ) + (endm (copy-marker ,end))) (do* (;; Iterate lines (l (progn (goto-char ,beg) (back-to-indentation)) @@ -2538,9 +2524,7 @@ region to enumerated lists, renumbering as necessary." (let* (;; Find items and convert the positions to markers. (items (mapcar (lambda (x) - (cons (let ((m (make-marker))) - (set-marker m (car x)) - m) + (cons (copy-marker (car x)) (cdr x))) (rst-find-pfx-in-region beg end rst-re-items))) (count 1) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index bc1af67d587..47d2f7a45e0 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -100,6 +100,7 @@ This takes effect when first loading the `sgml-mode' library.") (define-key map "\C-c\C-d" 'sgml-delete-tag) (define-key map "\C-c\^?" 'sgml-delete-tag) (define-key map "\C-c?" 'sgml-tag-help) + (define-key map "\C-c]" 'sgml-close-tag) (define-key map "\C-c/" 'sgml-close-tag) ;; Redundant keybindings, for consistency with TeX mode. diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 136c5dc466c..eb2d4849a32 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -5057,7 +5057,7 @@ Focus only on the corner pattern. Further cell validity check is required." (intersection-str (regexp-quote (char-to-string table-cell-intersection-char))) (v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char)) (h-border (format "[%s%c]" table-cell-horizontal-chars table-cell-intersection-char)) - (limit (save-excursion (beginning-of-line) (point)))) + (limit (line-beginning-position))) (catch 'end (while t (catch 'retry-horizontal @@ -5095,7 +5095,7 @@ Focus only on the corner pattern. Further cell validity check is required." (intersection-str (regexp-quote (char-to-string table-cell-intersection-char))) (v-border (format "[%c%c]" table-cell-vertical-char table-cell-intersection-char)) (h-border (format "[%s%c]" table-cell-horizontal-chars table-cell-intersection-char)) - (limit (save-excursion (end-of-line) (point)))) + (limit (line-end-position))) (catch 'end (while t (catch 'retry-horizontal @@ -5589,5 +5589,4 @@ It returns COLUMN unless STR contains some wide characters." (provide 'table) -;; arch-tag: 0d69b03e-aa5f-4e72-8806-5727217617e0 ;;; table.el ends here diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 70e4d1e3953..08f8257407e 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -864,6 +864,7 @@ START is the position of the \\ and DELIM is the delimiter char." ;; Redundant keybindings, for consistency with SGML mode. (define-key map "\C-c\C-t" 'latex-insert-block) + (define-key map "\C-c]" 'latex-close-block) (define-key map "\C-c/" 'latex-close-block) (define-key map "\C-c\C-e" 'latex-close-block) diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index 577287c60bc..7c331c7809d 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -663,11 +663,12 @@ Do not append @refill to paragraphs containing @w{TEXT} or @*." ;; 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 @@ insert the text with the @insertcopying command." (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 @@ For example, invoke ;;; Place `provide' at end of file. (provide 'texinfmt) -;; arch-tag: 1e8d9a2d-bca0-40a0-ac6c-dab01bc6f725 ;;; texinfmt.el ends here diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index be23a439bf3..ea691ee8ee4 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -443,7 +443,9 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (define-key map "\C-c\C-s" 'texinfo-show-structure) (define-key map "\C-c}" 'up-list) + ;; FIXME: This is often used for "close block" aka texinfo-insert-@end. (define-key map "\C-c]" 'up-list) + (define-key map "\C-c/" 'texinfo-insert-@end) (define-key map "\C-c{" 'texinfo-insert-braces) ;; bindings for inserting strings @@ -583,11 +585,8 @@ value of `texinfo-mode-hook'." (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate)) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start)) - (make-local-variable 'sentence-end-base) - (setq sentence-end-base + (set (make-local-variable 'sentence-end-base) "\\(@\\(end\\)?dots{}\\|[.?!]\\)[]\"'â€)}]*") - (make-local-variable 'adaptive-fill-mode) - (setq adaptive-fill-mode nil) (make-local-variable 'fill-column) (setq fill-column 70) (make-local-variable 'comment-start) @@ -646,7 +645,13 @@ Puts point on a blank line between them." (completing-read (format "Block name [%s]: " texinfo-block-default) texinfo-environments nil nil nil nil texinfo-block-default)) - \n "@" str \n _ \n "@end " str \n) + \n "@" str + ;; Blocks that take parameters: all the def* blocks take parameters, + ;; plus a few others. + (if (or (string-match "\\`def" str) + (member str '("table" "ftable" "vtable"))) + '(nil " " -)) + \n _ \n "@end " str \n) (defun texinfo-inside-macro-p (macro &optional bound) "Non-nil if inside a macro matching the regexp MACRO." @@ -717,163 +722,131 @@ With prefix argument or inside @code or @example, inserts a plain \"." (not (looking-at "@end")))) (texinfo-next-unmatched-end))) -(defun texinfo-insert-@end () +(define-skeleton texinfo-insert-@end "Insert the matching `@end' for the last Texinfo command that needs one." - (interactive) - (let ((string (ignore-errors (save-excursion + (backward-word 1) (texinfo-last-unended-begin) - (match-string 1))))) - (insert "@end ") - (if string (insert string "\n")))) - -;; The following insert commands accept a prefix arg N, which is the -;; number of words (actually s-exprs) that should be surrounded by -;; braces. Thus you can first paste a variable name into a .texinfo -;; buffer, then say C-u 1 C-c C-c v at the beginning of the just -;; pasted variable name to put @var{...} *around* the variable name. -;; Operate on previous word or words with negative arg. - -;; These commands use texinfo-insert-@-with-arg -(defun texinfo-insert-@-with-arg (string &optional arg) - (if arg - (progn - (setq arg (prefix-numeric-value arg)) - (if (< arg 0) - (progn - (skip-chars-backward " \t\n\r\f") - (save-excursion - (forward-sexp arg) - (insert "@" string "{")) - (insert "}")) - (skip-chars-forward " \t\n\r\f") - (insert "@" string "{") - (forward-sexp arg) - (insert "}"))) - (insert "@" string "{}") - (backward-char))) - -(defun texinfo-insert-braces () + (or (match-string 1) '-))) + \n "@end " str \n) + +(define-skeleton texinfo-insert-braces "Make a pair of braces and be poised to type inside of them. Use \\[up-list] to move forward out of the braces." - (interactive) - (insert "{}") - (backward-char)) + nil + "{" _ "}") -(defun texinfo-insert-@code (&optional arg) +(define-skeleton texinfo-insert-@code "Insert a `@code{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "code" arg)) + nil + "@code{" _ "}") -(defun texinfo-insert-@dfn (&optional arg) +(define-skeleton texinfo-insert-@dfn "Insert a `@dfn{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "dfn" arg)) + nil + "@dfn{" _ "}") -(defun texinfo-insert-@email (&optional arg) +(define-skeleton texinfo-insert-@email "Insert a `@email{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "email" arg)) + nil + "@email{" _ "}") -(defun texinfo-insert-@emph (&optional arg) +(define-skeleton texinfo-insert-@emph "Insert a `@emph{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "emph" arg)) + nil + "@emph{" _ "}") -(defun texinfo-insert-@example () +(define-skeleton texinfo-insert-@example "Insert the string `@example' in a Texinfo buffer." - (interactive) - (insert "@example\n")) + nil + \n "@example" \n) -(defun texinfo-insert-@file (&optional arg) +(define-skeleton texinfo-insert-@file "Insert a `@file{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "file" arg)) + nil + "@file{" _ "}") -(defun texinfo-insert-@item () +(define-skeleton texinfo-insert-@item "Insert the string `@item' in a Texinfo buffer. If in a table defined by @table, follow said string with a space. Otherwise, follow with a newline." - (interactive) - (insert "@item" + nil + \n "@item" (if (equal (ignore-errors (save-excursion (texinfo-last-unended-begin) (match-string 1))) "table") - ?\s - ?\n))) + " " '\n) + _ \n) -(defun texinfo-insert-@kbd (&optional arg) +(define-skeleton texinfo-insert-@kbd "Insert a `@kbd{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "kbd" arg)) + nil + "@kbd{" _ "}") -(defun texinfo-insert-@node () +(define-skeleton texinfo-insert-@node "Insert the string `@node' in a Texinfo buffer. Insert a comment on the following line indicating the order of arguments to @node. Insert a carriage return after the comment line. Leave point after `@node'." - (interactive) - (insert "@node \n@comment node-name, next, previous, up\n") - (forward-line -2) - (forward-char 6)) + nil + \n "@node " _ \n) -(defun texinfo-insert-@noindent () +(define-skeleton texinfo-insert-@noindent "Insert the string `@noindent' in a Texinfo buffer." - (interactive) - (insert "@noindent\n")) + nil + \n "@noindent" \n) -(defun texinfo-insert-@quotation () +(define-skeleton texinfo-insert-@quotation "Insert the string `@quotation' in a Texinfo buffer." - (interactive) - (insert "@quotation\n")) + \n "@quotation" \n) -(defun texinfo-insert-@samp (&optional arg) +(define-skeleton texinfo-insert-@samp "Insert a `@samp{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "samp" arg)) + nil + "@samp{" _ "}") -(defun texinfo-insert-@strong (&optional arg) +(define-skeleton texinfo-insert-@strong "Insert a `@strong{...}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "strong" arg)) + nil + "@strong{" _ "}") -(defun texinfo-insert-@table () +(define-skeleton texinfo-insert-@table "Insert the string `@table' in a Texinfo buffer." - (interactive) - (insert "@table ")) + nil + \n "@table " _ \n) -(defun texinfo-insert-@var (&optional arg) +(define-skeleton texinfo-insert-@var "Insert a `@var{}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "var" arg)) + nil + "@var{" _ "}") -(defun texinfo-insert-@uref (&optional arg) +(define-skeleton texinfo-insert-@uref "Insert a `@uref{}' command in a Texinfo buffer. A numeric argument says how many words the braces should surround. The default is not to surround any existing words with the braces." - (interactive "P") - (texinfo-insert-@-with-arg "uref" arg)) + nil + "@uref{" _ "}") (defalias 'texinfo-insert-@url 'texinfo-insert-@uref) ;;; Texinfo file structure diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index f4fcc95908b..ff021532c50 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -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 @@ section titles are often too short to explain a node well." (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 @@ Single argument, END-OF-MENU, is position limiting search." (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 () @@ -719,34 +715,32 @@ complements the node name rather than repeats it as a title does." (let (beginning end node-name title) (save-excursion (beginning-of-line) - (if (search-forward "* " (save-excursion (end-of-line) (point)) t) + (if (search-forward "* " (line-end-position) t) (progn (skip-chars-forward " \t") (setq beginning (point))) (error "This is not a line in a menu")) (cond ;; "Double colon" entry line; menu entry and node name are the same, - ((search-forward "::" (save-excursion (end-of-line) (point)) t) + ((search-forward "::" (line-end-position) t) (if (looking-at "[ \t]*[^ \t\n]+") (error "Descriptive text already exists")) (skip-chars-backward ": \t") (setq node-name (buffer-substring beginning (point)))) ;; "Single colon" entry line; menu entry and node name are different. - ((search-forward ":" (save-excursion (end-of-line) (point)) t) + ((search-forward ":" (line-end-position) t) (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 @@ section titles are often too short to explain a node well." (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 @@ section titles are often too short to explain a node well." (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)))) @@ -1154,8 +1144,7 @@ Only argument is a string of the general type of section." (save-excursion (goto-char (point-min)) (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t) - (beginning-of-line) - (point))) + (line-beginning-position))) (t (save-excursion (re-search-backward @@ -1206,13 +1195,11 @@ The menu will be located just before this position. First argument is the position of the beginning of the section in which the menu will be located; second argument is the position of the end of that region; it limits the search." - (save-excursion (goto-char beginning) (forward-line 1) (re-search-forward "^@node" end t) - (beginning-of-line) - (point))) + (line-beginning-position))) ;;; Updating a node @@ -1331,7 +1318,7 @@ Point must be at beginning of node line. Does not move point." Starts from the current position of the cursor, and searches forward on the line for a comma and if one is found, deletes the rest of the line, including the comma. Leaves point at beginning of line." - (let ((eol-point (save-excursion (end-of-line) (point)))) + (let ((eol-point (line-end-position))) (if (search-forward "," eol-point t) (delete-region (1- (point)) eol-point))) (beginning-of-line)) @@ -1437,8 +1424,7 @@ will be at some level higher in the Texinfo file. The fourth argument "\\)") (save-excursion (goto-char beginning) - (beginning-of-line) - (point)) + (line-beginning-position)) t) 'normal 'no-pointer)) @@ -1453,7 +1439,7 @@ The argument is the kind of section, either `normal' or `no-pointer'." (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) @@ -1483,7 +1469,7 @@ towards which the pointer is directed, one of `next', `previous', or `up'." "Remove extra commas, if any, at end of node line." (end-of-line) (skip-chars-backward ", ") - (delete-region (point) (save-excursion (end-of-line) (point)))) + (delete-region (point) (line-end-position))) ;;; Updating nodes sequentially @@ -1647,13 +1633,14 @@ node names in pre-existing `@node' lines that lack names." (skip-chars-forward " \t") (setq title (buffer-substring (point) - (save-excursion (end-of-line) (point)))))) + (line-end-position))))) ;; Insert node line if necessary. (if (re-search-backward "^@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. @@ -1675,7 +1662,7 @@ node names in pre-existing `@node' lines that lack names." (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)) @@ -1993,9 +1980,7 @@ chapter." (point-min) (save-excursion (re-search-forward "^@include") - (beginning-of-line) - (point))) - + (line-beginning-position))) ;; If found, leave point after word `menu' on the `@menu' line. (progn (texinfo-incorporate-descriptions main-menu-list) @@ -2021,9 +2006,7 @@ chapter." (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 @@ -2057,5 +2040,4 @@ chapter." ;; Place `provide' at end of file. (provide 'texnfo-upd) -;; arch-tag: d21613a5-c32f-43f4-8af4-bfb1e7455842 ;;; texnfo-upd.el ends here diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 4dedf3dfca5..a3292c42046 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -1,8 +1,8 @@ ;;; tool-bar.el --- setting up the tool bar -;; -;; 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. + ;; Author: Dave Love <fx@gnu.org> ;; Keywords: mouse frames ;; Package: emacs @@ -51,8 +51,8 @@ See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for conveniently adding tool bar items." :init-value t :global t - :group 'mouse - :group 'frames + ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. + :variable tool-bar-mode (let ((val (if tool-bar-mode 1 0))) (dolist (frame (frame-list)) (set-frame-parameter frame 'tool-bar-lines val)) @@ -260,31 +260,28 @@ holds a keymap." ;; People say it's bad to have EXIT on the tool bar, since users ;; might inadvertently click that button. ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") - (tool-bar-add-item-from-menu 'find-file "new" nil :label "New File") - (tool-bar-add-item-from-menu 'menu-find-file-existing "open") - (tool-bar-add-item-from-menu 'dired "diropen") - (tool-bar-add-item-from-menu 'kill-this-buffer "close") - (tool-bar-add-item-from-menu 'save-buffer "save" nil - :visible '(or buffer-file-name - (not (eq 'special - (get major-mode - 'mode-class))))) - (tool-bar-add-item-from-menu 'write-file "saveas" nil + (tool-bar-add-item-from-menu 'find-file "new" nil :label "New File" + :vert-only t) + (tool-bar-add-item-from-menu 'menu-find-file-existing "open" nil + :vert-only t) + (tool-bar-add-item-from-menu 'dired "diropen" nil :vert-only t) + (tool-bar-add-item-from-menu 'kill-this-buffer "close" nil :vert-only t) + (tool-bar-add-item-from-menu 'save-buffer "save" nil :vert-only t :visible '(or buffer-file-name (not (eq 'special (get major-mode 'mode-class))))) - (tool-bar-add-item-from-menu 'undo "undo" nil + (tool-bar-add-item-from-menu 'undo "undo" nil :vert-only t :visible '(not (eq 'special (get major-mode 'mode-class)))) (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) - "cut" nil + "cut" nil :vert-only t :visible '(not (eq 'special (get major-mode 'mode-class)))) (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) - "copy") + "copy" nil :vert-only t) (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) - "paste" nil + "paste" nil :vert-only t :visible '(not (eq 'special (get major-mode 'mode-class)))) (tool-bar-add-item-from-menu 'nonincremental-search-forward "search" @@ -295,16 +292,12 @@ holds a keymap." ;; than a lambda for Read Mail. ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose") - (tool-bar-add-item-from-menu 'print-buffer "print" nil :label "Print") ;; tool-bar-add-item-from-menu itself operates on ;; (default-value 'tool-bar-map), but when we don't use that function, ;; we must explicitly operate on the default value. (let ((tool-bar-map (default-value 'tool-bar-map))) - (tool-bar-add-item "preferences" 'customize 'customize - :help "Edit preferences (customize)") - (tool-bar-add-item "help" (lambda () (interactive) (popup-menu menu-bar-help-menu)) @@ -325,10 +318,10 @@ Customize `tool-bar-mode' if you want to show or hide the tool bar." :initialize 'custom-initialize-default :set (lambda (sym val) (set-default sym val) - (modify-all-frames-parameters + (modify-all-frames-parameters (list (cons 'tool-bar-position val)))))) (provide 'tool-bar) -;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f + ;;; tool-bar.el ends here diff --git a/lisp/type-break.el b/lisp/type-break.el index 641215be8cf..83278cbc6cc 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -1,7 +1,7 @@ ;;; type-break.el --- encourage rests from typing at appropriate intervals -;; Copyright (C) 1994, 1995, 1997, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Noah Friedman ;; Maintainer: Noah Friedman <friedman@splode.com> @@ -495,7 +495,7 @@ variable of the same name." (let ((inhibit-read-only t)) (goto-char (point-min)) (forward-line) - (delete-region (point) (save-excursion (end-of-line) (point))) + (delete-region (point) (line-end-position)) (insert (format "%s" type-break-keystroke-count)) ;; file saving is left to auto-save )))))) @@ -1243,5 +1243,4 @@ With optional non-nil ALL, force redisplay of all mode-lines." (if type-break-mode (type-break-mode 1)) -;; arch-tag: 943a2eb3-07e6-420b-993f-96e4796f5fd0 ;;; type-break.el ends here diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 4ef2b42756b..44cc511c99c 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -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. @@ -86,7 +91,8 @@ 2010-09-14 Julien Danjou <julien@danjou.info> - * url-cache (url-store-in-cache): Make `buff' argument really optional. + * url-cache.el (url-store-in-cache): + Make `buff' argument really optional. 2010-09-14 Glenn Morris <rgm@gnu.org> @@ -103,12 +109,12 @@ 2010-07-27 Michael Albinus <michael.albinus@gmx.de> - * url-http (url-http-parse-headers): Disable file name handlers at + * url-http.el (url-http-parse-headers): Disable file name handlers at all (not only Tramp). (Bug#6717) 2010-07-27 Michael Albinus <michael.albinus@gmx.de> - * url-http (url-http-parse-headers): Disable Tramp. (Bug#6717) + * url-http.el (url-http-parse-headers): Disable Tramp. (Bug#6717) 2010-07-01 Mark A. Hershberger <mah@everybody.org> diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 4e86c653c8c..22d74b3371b 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -103,12 +103,19 @@ to them." (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 diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index b63e482ff05..c356dde8226 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -698,7 +698,7 @@ current buffer to the complete file name. Optional arg BUFFER-FILE overrides `buffer-file-name'." ;; If we are called from a diff, first switch to the source buffer; ;; in order to respect buffer-local settings of change-log-default-name, etc. - (with-current-buffer (let ((buff (if (eq major-mode 'diff-mode) + (with-current-buffer (let ((buff (if (derived-mode-p 'diff-mode) (car (ignore-errors (diff-find-source-location)))))) (if (buffer-live-p buff) buff @@ -1180,7 +1180,7 @@ Has a preference of looking backwards." ((apply 'derived-mode-p add-log-c-like-modes) (or (c-cpp-define-name) (c-defun-name))) - ((memq major-mode add-log-tex-like-modes) + ((apply #'derived-mode-p add-log-tex-like-modes) (if (re-search-backward "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t) diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index e79e72c8b0d..752b12446fe 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -31,6 +31,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (defgroup diff nil "Comparing files with `diff'." :group 'tools) @@ -47,11 +49,6 @@ :type 'string :group 'diff) -(defvar diff-old-temp-file nil - "This is the name of a temp file to be deleted after diff finishes.") -(defvar diff-new-temp-file nil - "This is the name of a temp file to be deleted after diff finishes.") - ;; prompt if prefix arg present (defun diff-switches () (if current-prefix-arg @@ -60,12 +57,12 @@ diff-switches (mapconcat 'identity diff-switches " "))))) -(defun diff-sentinel (code) +(defun diff-sentinel (code &optional old-temp-file new-temp-file) "Code run when the diff process exits. CODE is the exit code of the process. It should be 0 only if no diffs were found." - (if diff-old-temp-file (delete-file diff-old-temp-file)) - (if diff-new-temp-file (delete-file diff-new-temp-file)) + (if old-temp-file (delete-file old-temp-file)) + (if new-temp-file (delete-file new-temp-file)) (save-excursion (goto-char (point-max)) (let ((inhibit-read-only t)) @@ -75,10 +72,6 @@ were found." (t "")) (current-time-string)))))) -(defvar diff-old-file nil) -(defvar diff-new-file nil) -(defvar diff-extra-args nil) - ;;;###autoload (defun diff (old new &optional switches no-async) "Find and display the differences between OLD and NEW files. @@ -91,16 +84,14 @@ When called interactively with a prefix argument, prompt interactively for diff switches. Otherwise, the switches specified in `diff-switches' are passed to the diff command." (interactive - (let (oldf newf) - (setq newf (buffer-file-name) - newf (if (and newf (file-exists-p newf)) + (let* ((newf (if (and buffer-file-name (file-exists-p buffer-file-name)) (read-file-name (concat "Diff new file (default " - (file-name-nondirectory newf) "): ") - nil newf t) + (file-name-nondirectory buffer-file-name) "): ") + nil buffer-file-name t) (read-file-name "Diff new file: " nil nil t))) - (setq oldf (file-newest-backup newf) - oldf (if (and oldf (file-exists-p oldf)) + (oldf (file-newest-backup newf))) + (setq oldf (if (and oldf (file-exists-p oldf)) (read-file-name (concat "Diff original file (default " (file-name-nondirectory oldf) "): ") @@ -108,59 +99,82 @@ specified in `diff-switches' are passed to the diff command." (read-file-name "Diff original file: " (file-name-directory newf) nil t))) (list oldf newf (diff-switches)))) - (setq new (expand-file-name new) - old (expand-file-name old)) + (display-buffer + (diff-no-select old new switches no-async))) + +(defun diff-file-local-copy (file-or-buf) + (if (bufferp file-or-buf) + (with-current-buffer file-or-buf + (let ((tempfile (make-temp-file "buffer-content-"))) + (write-region nil nil tempfile nil 'nomessage) + tempfile)) + (file-local-copy file-or-buf))) + +(defun diff-better-file-name (file) + (if (bufferp file) file + (let ((rel (file-relative-name file)) + (abbr (abbreviate-file-name (expand-file-name file)))) + (if (< (length abbr) (length rel)) + abbr + rel)))) + +(defun diff-no-select (old new &optional switches no-async buf) + ;; Noninteractive helper for creating and reverting diff buffers + (setq new (diff-better-file-name new) + old (diff-better-file-name old)) (or switches (setq switches diff-switches)) ; If not specified, use default. - (let* ((old-alt (file-local-copy old)) - (new-alt (file-local-copy new)) + (unless (listp switches) (setq switches (list switches))) + (or buf (setq buf (get-buffer-create "*Diff*"))) + (let* ((old-alt (diff-file-local-copy old)) + (new-alt (diff-file-local-copy new)) (command (mapconcat 'identity `(,diff-command ;; Use explicitly specified switches - ,@(if (listp switches) switches (list switches)) - ,@(if (or old-alt new-alt) - (list "-L" old "-L" new)) - ,(shell-quote-argument (or old-alt old)) - ,(shell-quote-argument (or new-alt new))) + ,@switches + ,@(mapcar #'shell-quote-argument + (nconc + (when (or old-alt new-alt) + (list "-L" (if (stringp old) + old (prin1-to-string old)) + "-L" (if (stringp new) + new (prin1-to-string new)))) + (list (or old-alt old) + (or new-alt new))))) " ")) - (buf (get-buffer-create "*Diff*")) - (thisdir default-directory) - proc) - (save-excursion - (display-buffer buf) - (set-buffer buf) - (setq buffer-read-only nil) + (thisdir default-directory)) + (with-current-buffer buf + (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) (let ((inhibit-read-only t)) (erase-buffer)) (buffer-enable-undo (current-buffer)) (diff-mode) - ;; Use below 2 vars for backward-compatibility. - (set (make-local-variable 'diff-old-file) old) - (set (make-local-variable 'diff-new-file) new) - (set (make-local-variable 'diff-extra-args) (list switches no-async)) (set (make-local-variable 'revert-buffer-function) - (lambda (ignore-auto noconfirm) - (apply 'diff diff-old-file diff-new-file diff-extra-args))) - (set (make-local-variable 'diff-old-temp-file) old-alt) - (set (make-local-variable 'diff-new-temp-file) new-alt) + (lexical-let ((old old) (new new) + (switches switches) + (no-async no-async)) + (lambda (ignore-auto noconfirm) + (diff-no-select old new switches no-async (current-buffer))))) (setq default-directory thisdir) (let ((inhibit-read-only t)) (insert command "\n")) (if (and (not no-async) (fboundp 'start-process)) - (progn - (setq proc (start-process "Diff" buf shell-file-name - shell-command-switch command)) + (let ((proc (start-process "Diff" buf shell-file-name + shell-command-switch command))) (set-process-filter proc 'diff-process-filter) - (set-process-sentinel - proc (lambda (proc msg) - (with-current-buffer (process-buffer proc) - (diff-sentinel (process-exit-status proc)))))) + (lexical-let ((old-alt old-alt) (new-alt new-alt)) + (set-process-sentinel + proc (lambda (proc msg) + (with-current-buffer (process-buffer proc) + (diff-sentinel (process-exit-status proc) + old-alt new-alt)))))) ;; Async processes aren't available. (let ((inhibit-read-only t)) (diff-sentinel (call-process shell-file-name nil buf nil - shell-command-switch command))))) + shell-command-switch command) + old-alt new-alt)))) buf)) (defun diff-process-filter (proc string) @@ -199,7 +213,14 @@ With prefix arg, prompt for diff switches." (funcall handler 'diff-latest-backup-file fn) (file-newest-backup fn)))) +;;;###autoload +(defun diff-buffer-with-file (&optional buffer) + "View the differences between BUFFER and its associated file. +This requires the external program `diff' to be in your `exec-path'." + (interactive "bBuffer: ") + (with-current-buffer (get-buffer (or buffer (current-buffer))) + (diff buffer-file-name (current-buffer) nil 'noasync))) + (provide 'diff) -;; arch-tag: 7de2c29b-7ea5-4b85-9b9d-72dd860de2bd ;;; diff.el ends here diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index b36599249a5..4eec5577e7b 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -311,7 +311,7 @@ to invocation.") ediff-word-mode-job (ediff-word-mode-job)) ;; Don't delete variants in case of ediff-buffer-* jobs without asking. - ;; This is because one may loose work---dangerous. + ;; This is because one may lose work---dangerous. (if (string-match "buffer" (symbol-name ediff-job-name)) (setq ediff-keep-variants t)) @@ -4289,5 +4289,4 @@ Mail anyway? (y or n) ") ;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) ;; End: -;; arch-tag: f51099b6-ef4b-470f-88a1-3a0e0b03a879 ;;; ediff-util.el ends here diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index 4946df6dcd3..ee34944e448 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -29,25 +29,13 @@ (defvar A-end) (defvar B-begin) (defvar B-end) -(defvar diff) (defvar diff-vector) (defvar merge-begin) (defvar merge-end) -(defvar template) (defvar valid-diff) ;;; Macros -(defmacro emerge-eval-in-buffer (buffer &rest forms) - "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. -Differs from `save-excursion' in that it doesn't save the point and mark." - `(let ((StartBuffer (current-buffer))) - (unwind-protect - (progn - (set-buffer ,buffer) - ,@forms) - (set-buffer StartBuffer)))) - (defmacro emerge-defvar-local (var value doc) "Defines SYMBOL as an advertised variable. Performs a defvar, then executes `make-variable-buffer-local' on @@ -565,7 +553,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (if output-file (setq emerge-last-dir-output (file-name-directory output-file))) ;; Make sure the entire files are seen, and they reflect what is on disk - (emerge-eval-in-buffer + (with-current-buffer buffer-A (widen) (let ((temp (file-local-copy file-A))) @@ -576,7 +564,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) - (emerge-eval-in-buffer + (with-current-buffer buffer-B (widen) (let ((temp (file-local-copy file-B))) @@ -599,10 +587,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) ;; create the merge buffer from buffer A, so it inherits buffer A's ;; default directory, etc. - (merge-buffer (emerge-eval-in-buffer + (merge-buffer (with-current-buffer buffer-A (get-buffer-create merge-buffer-name)))) - (emerge-eval-in-buffer + (with-current-buffer merge-buffer (emerge-copy-modes buffer-A) (setq buffer-read-only nil) @@ -625,14 +613,14 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-remember-buffer-characteristics) (emerge-handle-local-variables)) (emerge-setup-windows buffer-A buffer-B merge-buffer t) - (emerge-eval-in-buffer merge-buffer + (with-current-buffer merge-buffer (run-hooks 'startup-hooks 'emerge-startup-hook) (setq buffer-read-only t)))) ;; Generate the Emerge difference list between two files (defun emerge-make-diff-list (file-A file-B) (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*")) - (emerge-eval-in-buffer + (with-current-buffer emerge-diff-buffer (erase-buffer) (shell-command @@ -648,7 +636,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (defun emerge-extract-diffs (diff-buffer) (let (list) - (emerge-eval-in-buffer + (with-current-buffer diff-buffer (goto-char (point-min)) (while (re-search-forward emerge-match-diff-line nil t) @@ -692,7 +680,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;; Set up buffer of diff/diff3 error messages. (defun emerge-prepare-error-list (ok-regexp) (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*")) - (emerge-eval-in-buffer + (with-current-buffer emerge-diff-error-buffer (erase-buffer) (save-excursion (insert-buffer-substring emerge-diff-buffer)) @@ -719,7 +707,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (if output-file (setq emerge-last-dir-output (file-name-directory output-file))) ;; Make sure the entire files are seen, and they reflect what is on disk - (emerge-eval-in-buffer + (with-current-buffer buffer-A (widen) (let ((temp (file-local-copy file-A))) @@ -730,7 +718,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) - (emerge-eval-in-buffer + (with-current-buffer buffer-B (widen) (let ((temp (file-local-copy file-B))) @@ -741,7 +729,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") startup-hooks)) ;; Verify that the file matches the buffer (emerge-verify-file-buffer)))) - (emerge-eval-in-buffer + (with-current-buffer buffer-ancestor (widen) (let ((temp (file-local-copy file-ancestor))) @@ -768,10 +756,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) ;; create the merge buffer from buffer A, so it inherits buffer A's ;; default directory, etc. - (merge-buffer (emerge-eval-in-buffer + (merge-buffer (with-current-buffer buffer-A (get-buffer-create merge-buffer-name)))) - (emerge-eval-in-buffer + (with-current-buffer merge-buffer (emerge-copy-modes buffer-A) (setq buffer-read-only nil) @@ -796,14 +784,14 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-select-prefer-Bs) (emerge-handle-local-variables)) (emerge-setup-windows buffer-A buffer-B merge-buffer t) - (emerge-eval-in-buffer merge-buffer + (with-current-buffer merge-buffer (run-hooks 'startup-hooks 'emerge-startup-hook) (setq buffer-read-only t)))) ;; Generate the Emerge difference list between two files with an ancestor (defun emerge-make-diff3-list (file-A file-B file-ancestor) (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*")) - (emerge-eval-in-buffer + (with-current-buffer emerge-diff-buffer (erase-buffer) (shell-command @@ -820,7 +808,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (defun emerge-extract-diffs3 (diff-buffer) (let (list) - (emerge-eval-in-buffer + (with-current-buffer diff-buffer (while (re-search-forward "^====\\(.?\\)$" nil t) ;; leave point after matched line @@ -928,10 +916,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (interactive "bBuffer A to merge: \nbBuffer B to merge: ") (let ((emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B"))) - (emerge-eval-in-buffer + (with-current-buffer buffer-A (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) - (emerge-eval-in-buffer + (with-current-buffer buffer-B (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) (emerge-setup (get-buffer buffer-A) emerge-file-A @@ -953,13 +941,13 @@ This is *not* a user option, since Emerge uses it for its own processing.") (let ((emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B")) (emerge-file-ancestor (emerge-make-temp-file "anc"))) - (emerge-eval-in-buffer + (with-current-buffer buffer-A (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) - (emerge-eval-in-buffer + (with-current-buffer buffer-B (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) - (emerge-eval-in-buffer + (with-current-buffer buffer-ancestor (write-region (point-min) (point-max) emerge-file-ancestor nil 'no-message)) @@ -1093,7 +1081,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B"))) ;; Get the revisions into buffers - (emerge-eval-in-buffer + (with-current-buffer buffer-A (erase-buffer) (shell-command @@ -1101,7 +1089,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") t) (write-region (point-min) (point-max) emerge-file-A nil 'no-message) (set-buffer-modified-p nil)) - (emerge-eval-in-buffer + (with-current-buffer buffer-B (erase-buffer) (shell-command @@ -1131,7 +1119,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-file-B (emerge-make-temp-file "B")) (emerge-ancestor (emerge-make-temp-file "ancestor"))) ;; Get the revisions into buffers - (emerge-eval-in-buffer + (with-current-buffer buffer-A (erase-buffer) (shell-command @@ -1140,7 +1128,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") t) (write-region (point-min) (point-max) emerge-file-A nil 'no-message) (set-buffer-modified-p nil)) - (emerge-eval-in-buffer + (with-current-buffer buffer-B (erase-buffer) (shell-command @@ -1148,7 +1136,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") t) (write-region (point-min) (point-max) emerge-file-B nil 'no-message) (set-buffer-modified-p nil)) - (emerge-eval-in-buffer + (with-current-buffer buffer-ancestor (erase-buffer) (shell-command @@ -1379,7 +1367,7 @@ Otherwise, the A or B file present is copied to the output file." (if pos (goto-char (point-min))) ;; If diff/diff3 reports errors, display them rather than the merge buffer. - (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size))) + (if (/= 0 (with-current-buffer emerge-diff-error-buffer (buffer-size))) (progn (ding) (message "Errors found in diff/diff3 output. Merge buffer is %s." @@ -1434,14 +1422,14 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'." (do-auto-save) ;; remember and alter buffer characteristics (setq emerge-A-buffer-values - (emerge-eval-in-buffer + (with-current-buffer emerge-A-buffer (prog1 (emerge-save-variables emerge-saved-variables) (emerge-restore-variables emerge-saved-variables emerge-merging-values)))) (setq emerge-B-buffer-values - (emerge-eval-in-buffer + (with-current-buffer emerge-B-buffer (prog1 (emerge-save-variables emerge-saved-variables) @@ -1452,10 +1440,10 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'." "Restore characteristics saved by `emerge-remember-buffer-characteristics'." (let ((A-values emerge-A-buffer-values) (B-values emerge-B-buffer-values)) - (emerge-eval-in-buffer emerge-A-buffer + (with-current-buffer emerge-A-buffer (emerge-restore-variables emerge-saved-variables A-values)) - (emerge-eval-in-buffer emerge-B-buffer + (with-current-buffer emerge-B-buffer (emerge-restore-variables emerge-saved-variables B-values)))) @@ -1470,15 +1458,15 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'." merge-buffer lineno-list) (let* (marker-list - (A-point-min (emerge-eval-in-buffer A-buffer (point-min))) + (A-point-min (with-current-buffer A-buffer (point-min))) (offset (1- A-point-min)) - (B-point-min (emerge-eval-in-buffer B-buffer (point-min))) + (B-point-min (with-current-buffer B-buffer (point-min))) ;; Record current line number in each buffer ;; so we don't have to count from the beginning. (a-line 1) (b-line 1)) - (emerge-eval-in-buffer A-buffer (goto-char (point-min))) - (emerge-eval-in-buffer B-buffer (goto-char (point-min))) + (with-current-buffer A-buffer (goto-char (point-min))) + (with-current-buffer B-buffer (goto-char (point-min))) (while lineno-list (let* ((list-element (car lineno-list)) a-begin-marker @@ -1493,13 +1481,13 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'." (b-end (aref list-element 3)) (state (aref list-element 4))) ;; place markers at the appropriate places in the buffers - (emerge-eval-in-buffer + (with-current-buffer A-buffer (setq a-line (emerge-goto-line a-begin a-line)) (setq a-begin-marker (point-marker)) (setq a-line (emerge-goto-line a-end a-line)) (setq a-end-marker (point-marker))) - (emerge-eval-in-buffer + (with-current-buffer B-buffer (setq b-line (emerge-goto-line b-begin b-line)) (setq b-begin-marker (point-marker)) @@ -1759,7 +1747,7 @@ This resets the horizontal scrolling of all three merge buffers to the left margin, if they are in windows." (interactive) (emerge-operate-on-windows - (function (lambda (x) (set-window-hscroll (selected-window) 0))) + (lambda (x) (set-window-hscroll (selected-window) 0)) nil)) ;; Attempt to show the region nicely. @@ -1869,13 +1857,13 @@ buffer after this will cause serious problems." (emerge-restore-buffer-characteristics) ;; null out the difference markers so they don't slow down future editing ;; operations - (mapc (function (lambda (d) - (set-marker (aref d 0) nil) - (set-marker (aref d 1) nil) - (set-marker (aref d 2) nil) - (set-marker (aref d 3) nil) - (set-marker (aref d 4) nil) - (set-marker (aref d 5) nil))) + (mapc (lambda (d) + (set-marker (aref d 0) nil) + (set-marker (aref d 1) nil) + (set-marker (aref d 2) nil) + (set-marker (aref d 3) nil) + (set-marker (aref d 4) nil) + (set-marker (aref d 5) nil)) emerge-difference-list) ;; allow them to be garbage collected (setq emerge-difference-list nil) @@ -1900,19 +1888,18 @@ A prefix argument forces the variant to be selected even if the difference has been edited." (interactive "P") (let ((operate - (function (lambda () - (emerge-select-A-edit merge-begin merge-end A-begin A-end) - (if emerge-auto-advance - (emerge-next-difference))))) + (lambda () + (emerge-select-A-edit merge-begin merge-end A-begin A-end) + (if emerge-auto-advance + (emerge-next-difference)))) (operate-no-change - (function (lambda () - (if emerge-auto-advance - (emerge-next-difference)))))) + (lambda () (if emerge-auto-advance + (emerge-next-difference))))) (emerge-select-version force operate-no-change operate operate))) ;; Actually select the A variant (defun emerge-select-A-edit (merge-begin merge-end A-begin A-end) - (emerge-eval-in-buffer + (with-current-buffer emerge-merge-buffer (delete-region merge-begin merge-end) (goto-char merge-begin) @@ -1929,19 +1916,18 @@ A prefix argument forces the variant to be selected even if the difference has been edited." (interactive "P") (let ((operate - (function (lambda () - (emerge-select-B-edit merge-begin merge-end B-begin B-end) - (if emerge-auto-advance - (emerge-next-difference))))) + (lambda () + (emerge-select-B-edit merge-begin merge-end B-begin B-end) + (if emerge-auto-advance + (emerge-next-difference)))) (operate-no-change - (function (lambda () - (if emerge-auto-advance - (emerge-next-difference)))))) + (lambda () (if emerge-auto-advance + (emerge-next-difference))))) (emerge-select-version force operate operate-no-change operate))) ;; Actually select the B variant (defun emerge-select-B-edit (merge-begin merge-end B-begin B-end) - (emerge-eval-in-buffer + (with-current-buffer emerge-merge-buffer (delete-region merge-begin merge-end) (goto-char merge-begin) @@ -2134,12 +2120,12 @@ Use C-u l to reset the windows afterward." (interactive) (delete-other-windows) (let ((temp-buffer-show-function - (function (lambda (buf) - (split-window-vertically) - (switch-to-buffer buf) - (other-window 1))))) + (lambda (buf) + (split-window-vertically) + (switch-to-buffer buf) + (other-window 1)))) (with-output-to-temp-buffer "*Help*" - (emerge-eval-in-buffer emerge-A-buffer + (with-current-buffer emerge-A-buffer (if buffer-file-name (progn (princ "File A is: ") @@ -2148,7 +2134,7 @@ Use C-u l to reset the windows afterward." (princ "Buffer A is: ") (princ (buffer-name)))) (princ "\n")) - (emerge-eval-in-buffer emerge-B-buffer + (with-current-buffer emerge-B-buffer (if buffer-file-name (progn (princ "File B is: ") @@ -2158,7 +2144,7 @@ Use C-u l to reset the windows afterward." (princ (buffer-name)))) (princ "\n")) (if emerge-ancestor-buffer - (emerge-eval-in-buffer emerge-ancestor-buffer + (with-current-buffer emerge-ancestor-buffer (if buffer-file-name (progn (princ "Ancestor file is: ") @@ -2229,9 +2215,9 @@ With a prefix argument, join with the preceding one." ;; check that this is a valid difference (emerge-validate-difference) ;; get the point values and old difference - (let ((A-point (emerge-eval-in-buffer emerge-A-buffer + (let ((A-point (with-current-buffer emerge-A-buffer (point-marker))) - (B-point (emerge-eval-in-buffer emerge-B-buffer + (B-point (with-current-buffer emerge-B-buffer (point-marker))) (merge-point (point-marker)) (old-diff (aref emerge-difference-list n))) @@ -2313,10 +2299,10 @@ ancestor version does not share.)" (while success (setq size (min size (- bottom-a top-a) (- bottom-b top-b) (- bottom-m top-m))) - (setq sa (emerge-eval-in-buffer emerge-A-buffer + (setq sa (with-current-buffer emerge-A-buffer (buffer-substring top-a (+ size top-a)))) - (setq sb (emerge-eval-in-buffer emerge-B-buffer + (setq sb (with-current-buffer emerge-B-buffer (buffer-substring top-b (+ size top-b)))) (setq sm (buffer-substring top-m (+ size top-m))) @@ -2335,10 +2321,10 @@ ancestor version does not share.)" (while success (setq size (min size (- bottom-a top-a) (- bottom-b top-b) (- bottom-m top-m))) - (setq sa (emerge-eval-in-buffer emerge-A-buffer + (setq sa (with-current-buffer emerge-A-buffer (buffer-substring (- bottom-a size) bottom-a))) - (setq sb (emerge-eval-in-buffer emerge-B-buffer + (setq sb (with-current-buffer emerge-B-buffer (buffer-substring (- bottom-b size) bottom-b))) (setq sm (buffer-substring (- bottom-m size) bottom-m)) @@ -2351,14 +2337,14 @@ ancestor version does not share.)" ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends ;; of the difference regions. Move them to the beginning of lines, as ;; appropriate. - (emerge-eval-in-buffer emerge-A-buffer + (with-current-buffer emerge-A-buffer (goto-char top-a) (beginning-of-line) (aset diff 0 (point-marker)) (goto-char bottom-a) (beginning-of-line 2) (aset diff 1 (point-marker))) - (emerge-eval-in-buffer emerge-B-buffer + (with-current-buffer emerge-B-buffer (goto-char top-b) (beginning-of-line) (aset diff 2 (point-marker)) @@ -2413,7 +2399,7 @@ the nearest previous difference." ;; search for the point in the A buffer, using the markers ;; for the beginning and end of the differences in the A buffer (emerge-find-difference1 arg - (emerge-eval-in-buffer emerge-A-buffer (point)) + (with-current-buffer emerge-A-buffer (point)) 0 1)) (defun emerge-find-difference-B (arg) @@ -2426,7 +2412,7 @@ the nearest previous difference." ;; search for the point in the B buffer, using the markers ;; for the beginning and end of the differences in the B buffer (emerge-find-difference1 arg - (emerge-eval-in-buffer emerge-B-buffer (point)) + (with-current-buffer emerge-B-buffer (point)) 2 3)) (defun emerge-find-difference1 (arg location begin end) @@ -2474,26 +2460,27 @@ merge buffers." (let* ((valid-diff (and (>= emerge-current-difference 0) (< emerge-current-difference emerge-number-of-differences))) - (diff (and valid-diff - (aref emerge-difference-list emerge-current-difference))) - (merge-line (emerge-line-number-in-buf 4 5)) - (A-line (emerge-eval-in-buffer emerge-A-buffer - (emerge-line-number-in-buf 0 1))) - (B-line (emerge-eval-in-buffer emerge-B-buffer - (emerge-line-number-in-buf 2 3)))) + (emerge-line-diff (and valid-diff + (aref emerge-difference-list + emerge-current-difference))) + (merge-line (emerge-line-number-in-buf 4 5)) + (A-line (with-current-buffer emerge-A-buffer + (emerge-line-number-in-buf 0 1))) + (B-line (with-current-buffer emerge-B-buffer + (emerge-line-number-in-buf 2 3)))) (message "At lines: merge = %d, A = %d, B = %d" merge-line A-line B-line))) +(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 diff begin-marker)) + (if (> (point) (aref emerge-line-diff begin-marker)) (setq temp (- temp emerge-before-flag-lines))) - (if (> (point) (aref diff end-marker)) + (if (> (point) (aref emerge-line-diff end-marker)) (setq temp (- temp emerge-after-flag-lines))))) temp)) @@ -2548,30 +2535,32 @@ been edited." (error "Register does not contain text")) (emerge-combine-versions-internal template force))) -(defun emerge-combine-versions-internal (template force) +(defun emerge-combine-versions-internal (emerge-combine-template force) (let ((operate - (function (lambda () - (emerge-combine-versions-edit merge-begin merge-end - A-begin A-end B-begin B-end) - (if emerge-auto-advance - (emerge-next-difference)))))) + (lambda () + (emerge-combine-versions-edit merge-begin merge-end + A-begin A-end B-begin B-end) + (if emerge-auto-advance + (emerge-next-difference))))) (emerge-select-version force operate operate operate))) +(defvar emerge-combine-template) + (defun emerge-combine-versions-edit (merge-begin merge-end A-begin A-end B-begin B-end) - (emerge-eval-in-buffer + (with-current-buffer emerge-merge-buffer (delete-region merge-begin merge-end) (goto-char merge-begin) (let ((i 0)) - (while (< i (length template)) - (let ((c (aref template i))) + (while (< i (length emerge-combine-template)) + (let ((c (aref emerge-combine-template i))) (if (= c ?%) (progn (setq i (1+ i)) (setq c (condition-case nil - (aref template i) + (aref emerge-combine-template i) (error ?%))) (cond ((= c ?a) (insert-buffer-substring emerge-A-buffer A-begin A-end)) @@ -2620,7 +2609,7 @@ keymap. Leaves merge in fast mode." (defun emerge-place-flags-in-buffer (buffer difference before-index after-index) (if buffer - (emerge-eval-in-buffer + (with-current-buffer buffer (emerge-place-flags-in-buffer1 difference before-index after-index)) (emerge-place-flags-in-buffer1 difference before-index after-index))) @@ -2689,7 +2678,7 @@ keymap. Leaves merge in fast mode." (run-hooks 'emerge-unselect-hook)) (defun emerge-remove-flags-in-buffer (buffer before after) - (emerge-eval-in-buffer + (with-current-buffer buffer (let ((buffer-read-only nil)) ;; remove the flags, if they're there @@ -2838,11 +2827,11 @@ keymap. Leaves merge in fast mode." (while (< x-begin x-end) ;; bite off and compare no more than 1000 characters at a time (let* ((compare-length (min (- x-end x-begin) 1000)) - (x-string (emerge-eval-in-buffer + (x-string (with-current-buffer buffer-x (buffer-substring x-begin (+ x-begin compare-length)))) - (y-string (emerge-eval-in-buffer + (y-string (with-current-buffer buffer-y (buffer-substring y-begin (+ y-begin compare-length))))) @@ -2879,9 +2868,9 @@ keymap. Leaves merge in fast mode." ;; A "function" is anything that funcall can handle as an argument. (defun emerge-save-variables (vars) - (mapcar (function (lambda (v) (if (symbolp v) - (symbol-value v) - (funcall (car v))))) + (mapcar (lambda (v) (if (symbolp v) + (symbol-value v) + (funcall (car v)))) vars)) (defun emerge-restore-variables (vars values) @@ -2972,7 +2961,7 @@ around the current difference are removed." ;; buffer. (defun emerge-copy-modes (buffer) ;; Set the major mode - (funcall (emerge-eval-in-buffer buffer major-mode))) + (funcall (with-current-buffer buffer major-mode))) ;; Define a key, even if a prefix of it is defined (defun emerge-force-define-key (keymap key definition) @@ -3163,11 +3152,11 @@ See also `auto-save-file-name-p'." (aref s i)) 65536)) (setq i (1+ i))) - (mapconcat (function (lambda (b) - (setq b (+ (% b 93) ?!)) - (if (>= b ?/) - (setq b (1+ b))) - (char-to-string b))) + (mapconcat (lambda (b) + (setq b (+ (% b 93) ?!)) + (if (>= b ?/) + (setq b (1+ b))) + (char-to-string b)) bins ""))) ;; Quote any /s in a string by replacing them with \!. @@ -3205,5 +3194,4 @@ More precisely, a [...] regexp to match any one such character." (provide 'emerge) -;; arch-tag: a575f092-6e44-400e-b8a2-4124e9377585 ;;; emerge.el ends here diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 27290eeec8a..2bce58f50f2 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -350,17 +350,16 @@ automatically." (defvar log-edit-font-lock-keywords ;; Copied/inspired by message-font-lock-keywords. `((log-edit-match-to-eoh - (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp - "\\|\\(.*\\)") + (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp) (progn (goto-char (match-beginning 0)) (match-end 0)) nil (1 (if (assoc (match-string 2) log-edit-headers-alist) 'log-edit-header 'log-edit-unknown-header) nil lax) + ;; From `log-edit-header-contents-regexp': (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist)) 'log-edit-header) - nil lax) - (4 font-lock-warning-face))))) + nil lax))))) ;;;###autoload (defun log-edit (callback &optional setup params buffer mode &rest ignore) @@ -572,6 +571,16 @@ can thus take some time." (log-edit-comment-to-change-log))))) (defvar log-edit-changelog-use-first nil) + +(defvar log-edit-rewrite-fixes nil + "Rule to rewrite bug numbers into Fixes: headers. +The value should be of the form (REGEXP . REPLACEMENT) +where REGEXP should match the expression referring to a bug number +in the text, and REPLACEMENT is an expression to pass to `replace-match' +to build the Fixes: header.") +(put 'log-edit-rewrite-fixes 'safe-local-variable + (lambda (v) (and (stringp (car-safe v)) (stringp (cdr v))))) + (defun log-edit-insert-changelog (&optional use-first) "Insert a log message by looking at the ChangeLog. The idea is to write your ChangeLog entries first, and then use this @@ -593,18 +602,34 @@ regardless of user name or time." (when (<= (point) eoh) (goto-char eoh) (if (looking-at "\n") (forward-char 1)))) - (let ((log-edit-changelog-use-first - (or use-first (eq last-command 'log-edit-insert-changelog)))) - (log-edit-insert-changelog-entries (log-edit-files))) - (log-edit-set-common-indentation) - (goto-char (point-min)) - (when (and log-edit-strip-single-file-name (looking-at "\\*\\s-+")) - (forward-line 1) - (when (not (re-search-forward "^\\*\\s-+" nil t)) - (goto-char (point-min)) - (skip-chars-forward "^():") - (skip-chars-forward ": ") - (delete-region (point-min) (point))))) + (let ((author + (let ((log-edit-changelog-use-first + (or use-first (eq last-command 'log-edit-insert-changelog)))) + (log-edit-insert-changelog-entries (log-edit-files))))) + (log-edit-set-common-indentation) + ;; Add an Author: field if appropriate. + (when author + (rfc822-goto-eoh) + (insert "Author: " author "\n" (if (looking-at "\n") "" "\n"))) + ;; Add a Fixes: field if applicable. + (when (consp log-edit-rewrite-fixes) + (rfc822-goto-eoh) + (when (re-search-forward (car log-edit-rewrite-fixes) nil t) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (fixes (match-substitute-replacement + (cdr log-edit-rewrite-fixes)))) + (delete-region start end) + (rfc822-goto-eoh) + (insert "Fixes: " fixes "\n" (if (looking-at "\n") "" "\n"))))) + (goto-char (point-min)) + (when (and log-edit-strip-single-file-name (looking-at "\\*\\s-+")) + (forward-line 1) + (when (not (re-search-forward "^\\*\\s-+" nil t)) + (goto-char (point-min)) + (skip-chars-forward "^():") + (skip-chars-forward ": ") + (delete-region (point-min) (point)))))) ;;;; ;;;; functions for getting commit message from ChangeLog a file... @@ -670,6 +695,9 @@ for more details." (defvar user-full-name) (defvar user-mail-address) + +(defvar log-edit-author) ;Dynamically scoped. + (defun log-edit-changelog-ours-p () "See if ChangeLog entry at point is for the current user, today. Return non-nil if it is." @@ -684,9 +712,23 @@ Return non-nil if it is." (functionp add-log-time-format) (funcall add-log-time-format)) (format-time-string "%Y-%m-%d")))) - (looking-at (if log-edit-changelog-use-first - "[^ \t]" - (regexp-quote (format "%s %s <%s>" time name mail)))))) + (if (null log-edit-changelog-use-first) + (looking-at (regexp-quote (format "%s %s <%s>" time name mail))) + ;; Check the author, to potentially add it as a "Author: " header. + (when (looking-at "[^ \t]") + (when (and (boundp 'log-edit-author) + (not (looking-at (format ".+ .+ <%s>" + (regexp-quote mail)))) + (looking-at ".+ \\(.+ <.+>\\)")) + (let ((author (replace-regexp-in-string " " " " + (match-string 1)))) + (unless (and log-edit-author + (string-match (regexp-quote author) log-edit-author)) + (setq log-edit-author + (if log-edit-author + (concat log-edit-author ", " author) + author))))) + t)))) (defun log-edit-changelog-entries (file) "Return the ChangeLog entries for FILE, and the ChangeLog they came from. @@ -776,7 +818,8 @@ Rename relative filenames in the ChangeLog entry as FILES." (defun log-edit-insert-changelog-entries (files) "Given a list of files FILES, insert the ChangeLog entries for them." - (let ((log-entries nil)) + (let ((log-entries nil) + (log-edit-author nil)) ;; Note that any ChangeLog entry can apply to more than one file. ;; Here we construct a log-entries list with elements of the form ;; ((LOGBUFFER ENTRYSTART ENTRYEND) FILE1 FILE2...) @@ -793,7 +836,8 @@ Rename relative filenames in the ChangeLog entry as FILES." (dolist (log-entry (nreverse log-entries)) (apply 'log-edit-changelog-insert-entries (append (car log-entry) (cdr log-entry))) - (insert "\n")))) + (insert "\n")) + log-edit-author)) (defun log-edit-extract-headers (headers comment) "Extract headers from COMMENT to form command line arguments. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 6e72071b6a0..32f829f814e 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1009,6 +1009,10 @@ repeating the command will highlight other two parts." (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))) diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el index 3ca9d59e3c1..ba91f7f23c6 100644 --- a/lisp/vc/vc-arch.el +++ b/lisp/vc/vc-arch.el @@ -428,7 +428,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) -(defun vc-arch-checkin (files rev comment &optional extra-args-ignored) +(defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) ;; FIXME: This implementation probably only works for singleton filesets (let ((summary (file-relative-name (car files) (vc-arch-root (car files))))) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 78441772bd4..9c253e027e4 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -115,6 +115,8 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and (concat vc-bzr-admin-dirname "/branch/revision-history")) (defconst vc-bzr-admin-lastrev (concat vc-bzr-admin-dirname "/branch/last-revision")) +(defconst vc-bzr-admin-branchconf + (concat vc-bzr-admin-dirname "/branch/branch.conf")) ;;;###autoload (defun vc-bzr-registered (file) ;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file) @@ -129,6 +131,13 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file))) (when root (vc-file-setprop file 'bzr-root root))))) +(defun vc-bzr--branch-conf (file) + "Return the Bzr branch config for file FILE, as a string." + (with-temp-buffer + (insert-file-contents + (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file))) + (buffer-string))) + (require 'sha1) ;For sha1-program (defun vc-bzr-sha1 (file) @@ -228,6 +237,9 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown" "Regexp matching file status words as reported in `bzr' output.") +;; History of Bzr commands. +(defvar vc-bzr-history nil) + (defun vc-bzr-file-name-relative (filename) "Return file name FILENAME stripped of the initial Bzr repository path." (lexical-let* @@ -236,6 +248,94 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and (when rootdir (file-relative-name filename* rootdir)))) +(defun vc-bzr-async-command (command args) + "Run Bzr COMMAND asynchronously with ARGS, displaying the result. +Send the output to a buffer named \"*vc-bzr : NAME*\", where NAME +is the root of the current Bzr branch. Display the buffer in +some window, but don't select it." + ;; TODO: set up hyperlinks. + (let* ((dir default-directory) + (root (vc-bzr-root default-directory)) + (buffer (get-buffer-create + (format "*vc-bzr : %s*" + (expand-file-name root))))) + (with-current-buffer buffer + (setq default-directory root) + (goto-char (point-max)) + (unless (eq (point) (point-min)) + (insert " \n")) + (insert "Running \"" vc-bzr-program " " command) + (dolist (arg args) + (insert " " arg)) + (insert "\"...\n") + ;; Run bzr in the original working directory. + (let ((default-directory dir)) + (apply 'vc-bzr-command command t 'async nil args))) + (display-buffer buffer))) + +(defun vc-bzr-pull (prompt) + "Pull changes into the current Bzr branch. +Normally, this runs \"bzr pull\". However, if the branch is a +bound branch, run \"bzr update\" instead. If there is no default +location from which to pull or update, or if PROMPT is non-nil, +prompt for the Bzr command to run." + (let* ((vc-bzr-program vc-bzr-program) + (branch-conf (vc-bzr--branch-conf default-directory)) + ;; Check whether the branch is bound. + (bound (string-match "^bound\\s-*=\\s-*True" branch-conf)) + ;; If we need to do a "bzr pull", check for a parent. If it + ;; does not exist, bzr will need a pull location. + (parent (unless bound + (string-match + "^parent_location\\s-*=\\s-*[^\n[:space:]]+" + branch-conf))) + (command (if bound "update" "pull")) + args) + ;; If necessary, prompt for the exact command. + (when (or prompt (not (or bound parent))) + (setq args (split-string + (read-shell-command + "Run Bzr (like this): " + (concat vc-bzr-program " " command) + 'vc-bzr-history) + " " t)) + (setq vc-bzr-program (car args) + command (cadr args) + args (cddr args))) + (vc-bzr-async-command command args))) + +(defun vc-bzr-merge-branch () + "Merge another Bzr branch into the current one. +Prompt for the Bzr command to run, providing a pre-defined merge +source (an upstream branch or a previous merge source) as a +default if it is available." + (let* ((branch-conf (vc-bzr--branch-conf default-directory)) + ;; "bzr merge" without an argument defaults to submit_branch, + ;; then parent_location. We extract the specific location + ;; and add it explicitly to the command line. + (location + (cond + ((string-match + "^submit_branch\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$" + branch-conf) + (match-string 1 branch-conf)) + ((string-match + "^parent_location\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$" + branch-conf) + (match-string 1 branch-conf)))) + (cmd + (split-string + (read-shell-command + "Run Bzr (like this): " + (concat vc-bzr-program " merge --pull" + (if location (concat " " location) "")) + 'vc-bzr-history) + " " t)) + (vc-bzr-program (car cmd)) + (command (cadr cmd)) + (args (cddr cmd))) + (vc-bzr-async-command command args))) + (defun vc-bzr-status (file) "Return FILE status according to Bzr. Return value is a cons (STATUS . WARNING), where WARNING is a diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 03ff1f555a1..a78b59ffba5 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -314,7 +314,7 @@ its parents." (directory-file-name dir)))) (eq dir t))) -(defun vc-cvs-checkin (files rev comment &optional extra-args-ignored) +(defun vc-cvs-checkin (files rev comment) "CVS-specific version of `vc-backend-checkin'." (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 4397251959d..cd40468199f 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -753,12 +753,11 @@ To continue searching for next match, use command \\[tags-loop-continue]." (defun vc-dir-query-replace-regexp (from to &optional delimited) "Do `query-replace-regexp' of FROM with TO, on all marked files. -For marked directories, use the files displayed from those directories. If a directory is marked, then use the files displayed for that directory. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]." - ;; FIXME: this is almost a copy of `dired-do-replace-regexp'. This + ;; FIXME: this is almost a copy of `dired-do-query-replace-regexp'. This ;; should probably be made generic and used in both places instead of ;; duplicating it here. (interactive diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 689cd4d12bd..2a2879aadb8 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -134,6 +134,10 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :version "23.1" :group 'vc) +(defcustom vc-hg-program "hg" + "Name of the Mercurial executable (excluding any arguments)." + :type 'string + :group 'vc) ;;; Properties of the backend @@ -174,7 +178,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (append (list "TERM=dumb" "LANGUAGE=C") process-environment))) (process-file - "hg" nil t nil + vc-hg-program nil t nil "--config" "alias.status=status" "--config" "defaults.status=" "status" "-A" (file-relative-name file))) @@ -212,7 +216,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (let ((process-environment avoid-local-env)) ;; Ignore all errors. (process-file - "hg" nil t nil + vc-hg-program nil t nil "--config" "alias.parents=parents" "--config" "defaults.parents=" "parents" "--template" "{rev}" (file-relative-name file))) @@ -227,7 +231,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (condition-case nil (let ((process-environment avoid-local-env)) (process-file - "hg" nil nil nil + vc-hg-program nil nil nil ;; We use "log" here, if there's a faster command ;; that returns true for an 'added file and false ;; for an 'unregistered one, we could use that. @@ -620,7 +624,7 @@ REV is the revision to check out into WORKFILE." "A wrapper around `vc-do-command' for use in vc-hg.el. The difference to vc-do-command is that this function always invokes `hg', and that it passes `vc-hg-global-switches' to it before FLAGS." - (apply 'vc-do-command (or buffer "*vc*") okstatus "hg" file-or-list + (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list (if (stringp vc-hg-global-switches) (cons vc-hg-global-switches flags) (append vc-hg-global-switches diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index cb03853f865..a1ca6ab4d65 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -110,7 +110,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (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 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (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 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (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) @@ -175,7 +175,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-mtn-checkin (files rev comment &optional extra-args-ignored) +(defun vc-mtn-checkin (files rev comment) (apply 'vc-mtn-command nil 0 files (nconc (list "commit" "-m") (log-edit-extract-headers '(("Author" . "--author") diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 6537c2b96f3..f8d5214d776 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -349,7 +349,7 @@ whether to remove it." (yes-or-no-p (format "Directory %s is empty; remove it? " dir)) (delete-directory dir)))) -(defun vc-rcs-checkin (files rev comment &optional extra-args-ignored) +(defun vc-rcs-checkin (files rev comment) "RCS-specific version of `vc-backend-checkin'." (let ((switches (vc-switches 'RCS 'checkin))) ;; Now operate on the files diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index fb9cb3fc3f8..2acd778881a 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -237,7 +237,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "") (file-name-nondirectory file))))) -(defun vc-sccs-checkin (files rev comment &optional extra-args-ignored) +(defun vc-sccs-checkin (files rev comment) "SCCS-specific version of `vc-backend-checkin'." (dolist (file (vc-expand-dirs files)) (apply 'vc-sccs-do-command nil 0 "delta" (vc-name file) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 665dafb10df..40f91b70757 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -100,7 +100,7 @@ ;; In the list of functions below, each identifier needs to be prepended ;; with `vc-sys-'. Some of the functions are mandatory (marked with a ;; `*'), others are optional (`-'). -;; + ;; BACKEND PROPERTIES ;; ;; * revision-granularity @@ -109,7 +109,7 @@ ;; that return 'file have per-file revision numbering; backends ;; that return 'repository have per-repository revision numbering, ;; so a revision level implicitly identifies a changeset -;; + ;; STATE-QUERYING FUNCTIONS ;; ;; * registered (file) @@ -313,11 +313,24 @@ ;; ;; - merge (file rev1 rev2) ;; -;; Merge the changes between REV1 and REV2 into the current working file. +;; Merge the changes between REV1 and REV2 into the current working file +;; (for non-distributed VCS). +;; +;; - merge-branch () +;; +;; Merge another branch into the current one, prompting for a +;; location to merge from. ;; ;; - merge-news (file) ;; ;; Merge recent changes from the current branch into FILE. +;; (for non-distributed VCS). +;; +;; - pull (prompt) +;; +;; Pull "upstream" changes into the current branch (for distributed +;; VCS). If PROMPT is non-nil, or if necessary, prompt for a +;; location to pull from. ;; ;; - steal-lock (file &optional revision) ;; @@ -335,7 +348,7 @@ ;; ;; Mark conflicts as resolved. Some VC systems need to run a ;; command to mark conflicts as resolved. -;; + ;; HISTORY FUNCTIONS ;; ;; * print-log (files buffer &optional shortlog start-revision limit) @@ -440,7 +453,7 @@ ;; If the backend supports annotating through copies and renames, ;; and displays a file name and a revision, then return a cons ;; (REVISION . FILENAME). -;; + ;; TAG SYSTEM ;; ;; - create-tag (dir name branchp) @@ -461,7 +474,7 @@ ;; does a sanity check whether there aren't any uncommitted changes at ;; or below DIR, and then performs a tree walk, using the `checkout' ;; function to retrieve the corresponding revisions. -;; + ;; MISCELLANEOUS ;; ;; - make-version-backups-p (file) @@ -920,7 +933,8 @@ Within directories, only files already under version control are noticed." (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 +1000,7 @@ current buffer." (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." @@ -1815,53 +1829,65 @@ The headers are reset to their non-expanded form." ;;;###autoload (defun vc-merge () - "Merge changes between two revisions into the current buffer's file. -This asks for two revisions to merge from in the minibuffer. If the -first revision is a branch number, then merge all changes from that -branch. If the first revision is empty, merge news, i.e. recent changes -from the current branch. - -See Info node `Merging'." + "Perform a version control merge operation. +On a distributed version control system, this runs a \"merge\" +operation to incorporate changes from another branch onto the +current branch, prompting for an argument list. + +On a non-distributed version control system, this merges changes +between two revisions into the current fileset. This asks for +two revisions to merge from in the minibuffer. If the first +revision is a branch number, then merge all changes from that +branch. If the first revision is empty, merge the most recent +changes from the current branch." (interactive) - (vc-ensure-vc-buffer) - (vc-buffer-sync) - (let* ((file buffer-file-name) - (backend (vc-backend file)) - (state (vc-state file)) - first-revision second-revision status) + (let* ((vc-fileset (vc-deduce-fileset t)) + (backend (car vc-fileset)) + (files (cadr vc-fileset))) (cond - ((stringp state) ;; Locking VCses only - (error "File is locked by %s" state)) - ((not (vc-editable-p file)) - (if (y-or-n-p - "File must be checked out for merging. Check out now? ") - (vc-checkout file t) - (error "Merge aborted")))) - (setq first-revision - (vc-read-revision - (concat "Branch or revision to merge from " - "(default news on current branch): ") - (list file) - backend)) - (if (string= first-revision "") - (setq status (vc-call-backend backend 'merge-news file)) - (if (not (vc-find-backend-function backend 'merge)) - (error "Sorry, merging is not implemented for %s" backend) - (if (not (vc-branch-p first-revision)) - (setq second-revision - (vc-read-revision - "Second revision: " - (list file) backend nil - ;; FIXME: This is CVS/RCS/SCCS specific. - (concat (vc-branch-part first-revision) "."))) - ;; We want to merge an entire branch. Set revisions - ;; accordingly, so that vc-BACKEND-merge understands us. - (setq second-revision first-revision) - ;; first-revision must be the starting point of the branch - (setq first-revision (vc-branch-part first-revision))) - (setq status (vc-call-backend backend 'merge file - first-revision second-revision)))) - (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))) + ;; If a branch-merge operation is defined, use it. + ((vc-find-backend-function backend 'merge-branch) + (vc-call-backend backend 'merge-branch)) + ;; Otherwise, do a per-file merge. + ((vc-find-backend-function backend 'merge) + (vc-buffer-sync) + (dolist (file files) + (let* ((state (vc-state file)) + first-revision second-revision status) + (cond + ((stringp state) ;; Locking VCses only + (error "File %s is locked by %s" file state)) + ((not (vc-editable-p file)) + (vc-checkout file t))) + (setq first-revision + (vc-read-revision + (concat "Merge " file + "from branch or revision " + "(default news on current branch): ") + (list file) + backend)) + (cond + ((string= first-revision "") + (setq status (vc-call-backend backend 'merge-news file))) + (t + (if (not (vc-branch-p first-revision)) + (setq second-revision + (vc-read-revision + "Second revision: " + (list file) backend nil + ;; FIXME: This is CVS/RCS/SCCS specific. + (concat (vc-branch-part first-revision) "."))) + ;; We want to merge an entire branch. Set revisions + ;; accordingly, so that vc-BACKEND-merge understands us. + (setq second-revision first-revision) + ;; first-revision must be the starting point of the branch + (setq first-revision (vc-branch-part first-revision))) + (setq status (vc-call-backend backend 'merge file + first-revision second-revision)))) + (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))) + (t + (error "Sorry, merging is not implemented for %s" backend))))) + (defun vc-maybe-resolve-conflicts (file status &optional name-A name-B) (vc-resynch-buffer file t (not (buffer-modified-p))) @@ -2273,35 +2299,47 @@ depending on the underlying version-control system." (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") ;;;###autoload -(defun vc-update () - "Update the current fileset's files to their tip revisions. -For each one that contains no changes, and is not locked, then this simply -replaces the work file with the latest revision on its branch. If the file -contains changes, and the backend supports merging news, then any recent -changes from the current branch are merged into the working file." - (interactive) - (let* ((vc-fileset (vc-deduce-fileset)) +(defun vc-update (&optional arg) + "Update the current fileset or branch. +On a distributed version control system, this runs a \"pull\" +operation to update the current branch, prompting for an argument +list if required. Optional prefix ARG forces a prompt. + +On a non-distributed version control system, update the current +fileset to the tip revisions. For each unchanged and unlocked +file, this simply replaces the work file with the latest revision +on its branch. If the file contains changes, any changes in the +tip revision are merged into the working file." + (interactive "P") + (let* ((vc-fileset (vc-deduce-fileset t)) (backend (car vc-fileset)) (files (cadr vc-fileset))) - (save-some-buffers ; save buffers visiting files - nil (lambda () - (and (buffer-modified-p) - (let ((file (buffer-file-name))) - (and file (member file files)))))) - (dolist (file files) - (if (vc-up-to-date-p file) - (vc-checkout file nil t) - (if (eq (vc-checkout-model backend (list file)) 'locking) - (if (eq (vc-state file) 'edited) - (error "%s" - (substitute-command-keys - "File is locked--type \\[vc-revert] to discard changes")) - (error "Unexpected file state (%s) -- type %s" - (vc-state file) - (substitute-command-keys - "\\[vc-next-action] to correct"))) - (vc-maybe-resolve-conflicts - file (vc-call-backend backend 'merge-news file))))))) + (cond + ;; If a pull operation is defined, use it. + ((vc-find-backend-function backend 'pull) + (vc-call-backend backend 'pull arg)) + ;; If VCS has `merge-news' functionality (CVS and SVN), use it. + ((vc-find-backend-function backend 'merge-news) + (save-some-buffers ; save buffers visiting files + nil (lambda () + (and (buffer-modified-p) + (let ((file (buffer-file-name))) + (and file (member file files)))))) + (dolist (file files) + (if (vc-up-to-date-p file) + (vc-checkout file nil t) + (vc-maybe-resolve-conflicts + file (vc-call-backend backend 'merge-news file))))) + ;; For a locking VCS, check out each file. + ((eq (vc-checkout-model backend files) 'locking) + (dolist (file files) + (if (vc-up-to-date-p file) + (vc-checkout file nil t)))) + (t + (error "VC update is unsupported for `%s'" backend))))) + +;;;###autoload +(defalias 'vc-pull 'vc-update) (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 1abb29febc7..0c6c56f84fb 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -32,34 +32,6 @@ ;;;; Function keys -(defvar x-alternatives-map - (let ((map (make-sparse-keymap))) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (define-key map [M-backspace] [?\M-\d]) - (define-key map [M-delete] [?\M-\d]) - (define-key map [M-tab] [?\M-\t]) - (define-key map [M-linefeed] [?\M-\n]) - (define-key map [M-clear] [?\M-\C-l]) - (define-key map [M-return] [?\M-\C-m]) - (define-key map [M-escape] [?\M-\e]) - (define-key map [iso-lefttab] [backtab]) - (define-key map [S-iso-lefttab] [backtab]) - (define-key map [S-tab] [backtab]) - map) - "Keymap of possible alternative meanings for some keys.") - -(defun x-setup-function-keys (frame) - "Set up `function-key-map' on the graphical frame FRAME." - ;; Don't do this twice on the same display, or it would break - ;; normal-erase-is-backspace-mode. - (unless (terminal-parameter frame 'x-setup-function-keys) - ;; Map certain keypad keys into ASCII characters that people usually expect. - (with-selected-frame frame - (let ((map (copy-keymap x-alternatives-map))) - (set-keymap-parent map (keymap-parent local-function-key-map)) - (set-keymap-parent local-function-key-map map))) - (set-terminal-parameter frame 'x-setup-function-keys t))) - (declare-function set-message-beep "w32console.c") (declare-function w32-get-clipboard-data "w32select.c") (declare-function w32-get-locale-info "w32proc.c") @@ -432,22 +404,6 @@ bit output with no translation." ;; from x-selection-value. (defvar x-last-selected-text nil) -(defun x-select-text (text) - "Select TEXT, a string, according to the window system. - -On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the -clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. - -On Nextstep, put TEXT in the pasteboard." - (if x-select-enable-clipboard - (w32-set-clipboard-data text)) - (setq x-last-selected-text text)) - (defun x-get-selection-value () "Return the value of the current selection. Consult the selection. Treat empty strings as if they were unset." @@ -503,5 +459,4 @@ to include Sed, which is used by leim/Makefile.in to do the job." (delete-matching-lines "^$\\|^;") (save-buffers-kill-emacs t)) -;; arch-tag: c49b48cc-0f4f-454f-a274-c2dc34815e14 ;;; w32-fns.el ends here diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el index 91676dd12da..80cdfb57129 100644 --- a/lisp/w32-vars.el +++ b/lisp/w32-vars.el @@ -148,17 +148,6 @@ menu if the variable `w32-use-w32-font-dialog' is nil." (string :tag "Font"))))))) :group 'w32) -(defcustom x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection. - -On MS-Windows, this is non-nil by default, since Windows does not -support other types of selections. \(The primary selection that is -set by Emacs is not accessible to other programs on Windows.\)" - :type 'boolean - :group 'killing) - (provide 'w32-vars) -;; arch-tag: ee2394fb-9db7-4c15-a8f0-66b47f4a2bb1 ;;; w32-vars.el ends here diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 4b8b9a61173..1a54d8afc3e 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: data, wp -;; Version: 13.1 +;; Version: 13.2 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -1103,7 +1103,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'." :init-value nil :global nil :group 'whitespace - (let ((whitespace-style '(newline-mark newline))) + (let ((whitespace-style '(face newline-mark newline))) (whitespace-mode whitespace-newline-mode) ;; sync states (running a batch job) (setq whitespace-newline-mode whitespace-mode))) @@ -1652,12 +1652,12 @@ documentation." (whitespace-replace-action (if whitespace-indent-tabs-mode 'tabify 'untabify) rstart rend whitespace-space-before-tab-regexp - (if whitespace-indent-tabs-mode 1 2))) + (if whitespace-indent-tabs-mode 0 2))) ;; ACTION: replace SPACEs before TAB by TABs. ((memq 'space-before-tab::tab whitespace-style) (whitespace-replace-action 'tabify rstart rend - whitespace-space-before-tab-regexp 1)) + whitespace-space-before-tab-regexp 0)) ;; ACTION: replace TABs by SPACEs. ((memq 'space-before-tab::space whitespace-style) (whitespace-replace-action diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 3b9a0372de5..9c7de61d7cd 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -316,9 +316,8 @@ size field.") (defvar widget-field-use-before-change t "Non-nil means use `before-change-functions' to track editable fields. -This enables the use of undo, but doesn't work on Emacs 19.34 and earlier. -Using before hooks also means that the :notify function can't know the -new value.") +This enables the use of undo. Using before hooks also means that +the :notify function can't know the new value.") (defun widget-specify-field (widget from to) "Specify editable button for WIDGET between FROM and TO." @@ -638,7 +637,8 @@ extension (xpm, xbm, gif, jpg, or png) located in specs) (dolist (elt widget-image-conversion) (dolist (ext (cdr elt)) - (push (list :type (car elt) :file (concat image ext)) specs))) + (push (list :type (car elt) :file (concat image ext) + :ascent 'center) specs))) (find-image (nreverse specs)))) (t ;; Oh well. @@ -1052,7 +1052,7 @@ POS defaults to the value of (point)." (defvar widget-use-overlay-change t "If non-nil, use overlay change functions to tab around in the buffer. -This is much faster, but doesn't work reliably on Emacs 19.34.") +This is much faster.") (defun widget-move (arg) "Move point to the ARG next field or button. @@ -2195,9 +2195,9 @@ when he invoked the menu." ;; We could probably do the same job as the images using single ;; space characters in a boxed face with a stretch specification to ;; make them square. - :on-glyph image-checkbox-checked + :on-glyph "checked" :off "[ ]" - :off-glyph image-checkbox-unchecked + :off-glyph "unchecked" :help-echo "Toggle this item." :action 'widget-checkbox-action) @@ -3781,5 +3781,4 @@ example: (provide 'wid-edit) -;; arch-tag: a076e75e-18a1-4b46-8be5-3f317bcbc707 ;;; wid-edit.el ends here diff --git a/lisp/woman.el b/lisp/woman.el index 358cb8fee61..25113419deb 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1508,7 +1508,7 @@ Also make each path-info component into a list. ;; (topic) ;; (topic (path-index) (path-index) ... ) ;; (topic (path-index filename) (path-index filename) ... ) - ;; where the are no duplicates in the value lists. + ;; where there are no duplicates in the value lists. ;; Topic must match first `word' of filename, so ... (let ((topic-regexp (concat @@ -2475,23 +2475,23 @@ Preserves location of `point'." Start at FROM and re-scan new text as appropriate." (goto-char from) (let ((woman0-if-to (make-marker)) - request woman0-macro-alist + woman-request woman0-macro-alist (woman0-search-regex-start woman0-search-regex-start) (woman0-search-regex (concat woman0-search-regex-start woman0-search-regex-end)) woman0-rename-alist) (set-marker-insertion-type woman0-if-to t) (while (re-search-forward woman0-search-regex nil t) - (setq request (match-string 1)) - (cond ((string= request "ig") (woman0-ig)) - ((string= request "if") (woman0-if "if")) - ((string= request "ie") (woman0-if "ie")) - ((string= request "el") (woman0-el)) - ((string= request "so") (woman0-so)) - ((string= request "rn") (woman0-rn)) - ((string= request "de") (woman0-de)) - ((string= request "am") (woman0-de 'append)) - (t (woman0-macro request)))) + (setq woman-request (match-string 1)) + (cond ((string= woman-request "ig") (woman0-ig)) + ((string= woman-request "if") (woman0-if "if")) + ((string= woman-request "ie") (woman0-if "ie")) + ((string= woman-request "el") (woman0-el)) + ((string= woman-request "so") (woman0-so)) + ((string= woman-request "rn") (woman0-rn)) + ((string= woman-request "de") (woman0-de)) + ((string= woman-request "am") (woman0-de 'append)) + (t (woman0-macro woman-request)))) (set-marker woman0-if-to nil) (woman0-rename) ;; Should now re-run `woman0-roff-buffer' if any renaming was @@ -2522,6 +2522,7 @@ Start at FROM and re-scan new text as appropriate." (goto-char from) ; necessary! (woman2-process-escapes to 'numeric)) +;; request does not appear to be used dynamically by any callees. (defun woman0-if (request) ".if/ie c anything -- Discard unless c evaluates to true. Remember condition for use by a subsequent `.el'. @@ -2573,6 +2574,7 @@ REQUEST is the invoking directive without the leading dot." (woman-if-ignore woman0-if-to request) ; ERROR! (woman-if-body request woman0-if-to (eq c negated))))) +;; request is not used dynamically by any callees. (defun woman-if-body (request to delete) ; should be reversed as `accept'? "Process if-body, including \\{ ... \\}. REQUEST is the invoking directive without the leading dot. @@ -2629,6 +2631,7 @@ If DELETE is non-nil then delete from point." (if (looking-at "[ \t]*\\{") (search-forward "\\}")) (forward-line 1)))) +;; request is not used dynamically by any callees. (defun woman-if-ignore (to request) "Ignore but warn about an if request ending at TO, named REQUEST." (WoMan-warn-ignored request "ignored -- condition not handled!") @@ -2760,15 +2763,17 @@ Optional argument APPEND, if non-nil, means append macro." (beginning-of-line) ; delete .de/am line (woman-delete-line 1)) -(defun woman0-macro (request) - "Process the macro call named REQUEST." +;; request may be used dynamically (woman-interpolate-macro calls +;; woman-forward-arg). +(defun woman0-macro (woman-request) + "Process the macro call named WOMAN-REQUEST." ;; Leaves point at start of new text. - (let ((macro (assoc request woman0-macro-alist))) + (let ((macro (assoc woman-request woman0-macro-alist))) (if macro (woman-interpolate-macro (cdr macro)) ;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!! ;; Output this message once only per call (cf. strings)? - (WoMan-warn "Undefined macro %s not interpolated!" request)))) + (WoMan-warn "Undefined macro %s not interpolated!" woman-request)))) (defun woman-interpolate-macro (macro) "Interpolate (.de) or append (.am) expansion of MACRO into the buffer." @@ -2985,8 +2990,10 @@ Useful for constructing the alist variable `woman-special-characters'." ;;; Formatting macros that do not cause a break: -(defvar request) ; Bound locally by woman1-roff-buffer -(defvar unquote) ; Bound locally by woman1-roff-buffer +;; Bound locally by woman[012]-roff-buffer, and also, annoyingly and +;; confusingly, as a function argument. Use dynamically in +;; woman-unquote and woman-forward-arg. +(defvar woman-request) (defun woman-unquote (to) "Delete any double-quote characters between point and TO. @@ -3001,7 +3008,7 @@ Leave point at TO (which should be a marker)." (setq in-quote (not in-quote)) )) (if in-quote - (WoMan-warn "Unpaired \" in .%s arguments." request)))) + (WoMan-warn "Unpaired \" in .%s arguments." woman-request)))) (defsubst woman-unquote-args () "Delete any double-quote characters up to the end of the line." @@ -3010,7 +3017,7 @@ Leave point at TO (which should be a marker)." (defun woman1-roff-buffer () "Process non-breaking requests." (let ((case-fold-search t) - request fn unquote) + woman-request fn woman1-unquote) (while ;; Find next control line: (re-search-forward woman-request-regexp nil t) @@ -3018,14 +3025,14 @@ Leave point at TO (which should be a marker)." ;; Construct woman function to call: ((setq fn (intern-soft (concat "woman1-" - (setq request (match-string 1))))) + (setq woman-request (match-string 1))))) (if (get fn 'notfont) ; not a font-change request (funcall fn) ;; Delete request or macro name: (woman-delete-match 0) ;; If no args then apply to next line else unquote args - ;; (unquote is used by called function): - (setq unquote (not (eolp))) + ;; (woman1-unquote is used by called function): + (setq woman1-unquote (not (eolp))) (if (eolp) (delete-char 1)) ; ;; Hide leading control character in unquoted argument: ; (cond ((memq (following-char) '(?. ?')) @@ -3034,7 +3041,7 @@ Leave point at TO (which should be a marker)." ;; Call the appropriate function: (funcall fn) ;; Hide leading control character in quoted argument (only): - (if (and unquote (memq (following-char) '(?. ?'))) + (if (and woman1-unquote (memq (following-char) '(?. ?'))) (insert "\\&")))))))) ;;; Font-changing macros: @@ -3047,6 +3054,8 @@ Leave point at TO (which should be a marker)." ".I -- Set words of current line in italic font." (woman1-B-or-I ".ft I\n")) +(defvar woman1-unquote) ; bound locally by woman1-roff-buffer + (defun woman1-B-or-I (B-or-I) ".B/I -- Set words of current line in bold/italic font. B-OR-I is the appropriate complete control line." @@ -3055,7 +3064,7 @@ B-OR-I is the appropriate complete control line." ;; Return to bol to process .SM/.B, .B/.if etc. ;; or start of first arg to hide leading control char. (save-excursion - (if unquote + (if woman1-unquote (woman-unquote-args) (while (looking-at "^[.']") (forward-line)) (end-of-line) @@ -3102,11 +3111,12 @@ B-OR-I is the appropriate complete control line." ;; Return to start of first arg to hide leading control char: (save-excursion (setq fonts (cdr fonts)) - (woman-forward-arg unquote 'concat) ; unquote is bound above + ;; woman1-unquote is bound in woman1-roff-buffer. + (woman-forward-arg woman1-unquote 'concat) (while (not (eolp)) (insert (car fonts)) (setq fonts (cdr fonts)) - (woman-forward-arg unquote 'concat)) ; unquote is bound above + (woman-forward-arg woman1-unquote 'concat)) (insert "\\fR"))) (defun woman-forward-arg (&optional unquote concat) @@ -3123,7 +3133,7 @@ If optional arg CONCAT is non-nil then join arguments." (re-search-forward "\"\\|$")) (if (eq (preceding-char) ?\") (if unquote (delete-char -1)) - (WoMan-warn "Unpaired \" in .%s arguments." request))) + (WoMan-warn "Unpaired \" in .%s arguments." woman-request))) ;; (re-search-forward "[^\\\n] \\|$") ; inconsistent (skip-syntax-forward "^ ")) (cond ((null concat) (skip-chars-forward " \t")) ; don't skip eol! @@ -3338,7 +3348,12 @@ Ignore the default face and underline only word characters." ;;; Output translation: -(defvar translations nil) ; Also bound locally by woman2-roff-buffer +;; This is only set by woman2-tr. It is bound locally in woman2-roff-buffer. +;; It is also used by woman-translate. woman-translate may be called +;; outside the scope of woman2-roff-buffer (by experiment). Therefore +;; this used to be globally bound to nil, to avoid an error. Instead +;; we can use bound-and-true-p in woman-translate. +(defvar woman-translations) ;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil. (defun woman-get-next-char () @@ -3358,8 +3373,8 @@ Format paragraphs upto TO. Supports special chars. ;; This should be an update, but consing onto the front of the alist ;; has the same effect and match duplicates should not matter. ;; Initialize translation data structures: - (let ((matches (car translations)) - (alist (cdr translations)) + (let ((matches (car woman-translations)) + (alist (cdr woman-translations)) a b) ;; `matches' must be a string: (setq matches @@ -3381,15 +3396,15 @@ Format paragraphs upto TO. Supports special chars. (if (= (string-to-char matches) ?\]) (substring matches 3) (concat "[" matches)) - translations (cons matches alist)) + woman-translations (cons matches alist)) ;; Format any following text: (woman2-format-paragraphs to))) (defsubst woman-translate (to) "Translate up to marker TO. Do this last of all transformations." - (if translations - (let ((matches (car translations)) - (alist (cdr translations)) + (if (bound-and-true-p woman-translations) + (let ((matches (car woman-translations)) + (alist (cdr woman-translations)) ;; Translations are case-sensitive, eg ".tr ab" does not ;; affect "A" (bug#6849). (case-fold-search nil)) @@ -3528,8 +3543,8 @@ The expression may be an argument in quotes." ; (WoMan-warn "Unimplemented numerical operator `%c' in %s" ; (following-char) ; (buffer-substring -; (save-excursion (beginning-of-line) (point)) -; (save-excursion (end-of-line) (point)))) +; (line-beginning-position) +; (line-end-position))) ; (skip-syntax-forward "^ ")) value )) @@ -3598,7 +3613,7 @@ expression in parentheses. Leaves point after the value." (WoMan-warn "Numeric/register argument error: %s" (buffer-substring (point) - (save-excursion (end-of-line) (point)))) + (line-end-position))) (skip-syntax-forward "^ ") 0) (goto-char (match-end 0)) @@ -3633,7 +3648,7 @@ expression in parentheses. Leaves point after the value." (insert-and-inherit (symbol-function 'insert-and-inherit)) (set-text-properties (symbol-function 'set-text-properties)) (woman-registers woman-registers) - fn request translations + fn woman-request woman-translations tab-stop-list) (set-marker-insertion-type to t) ;; ?roff does not squeeze multiple spaces, but does fill, so... @@ -3649,13 +3664,13 @@ expression in parentheses. Leaves point after the value." ;; Construct woman function to call: ((setq fn (intern-soft (concat "woman2-" - (setq request (match-string 1))))) + (setq woman-request (match-string 1))))) ;; Delete request or macro name: (woman-delete-match 0)) ;; Unrecognised request: ((prog1 nil - ;; (WoMan-warn ".%s request ignored!" request) - (WoMan-warn-ignored request "ignored!") + ;; (WoMan-warn ".%s request ignored!" woman-request) + (WoMan-warn-ignored woman-request "ignored!") ;; (setq fn 'woman2-LP) ;; AVOID LEAVING A BLANK LINE! ;; (setq fn 'woman2-format-paragraphs) @@ -3748,8 +3763,7 @@ v alters page foot left; m alters page head center. (buffer-substring start here)) (delete-region here (point))))) ;; Embolden heading (point is at end of heading): - (woman-set-face - (save-excursion (beginning-of-line) (point)) (point) 'woman-bold) + (woman-set-face (line-beginning-position) (point) 'woman-bold) (forward-line) (delete-blank-lines) (setq woman-left-margin woman-default-indent) @@ -3768,8 +3782,7 @@ Format paragraphs upto TO. Set prevailing indent to 5." (setq woman-leave-blank-lines nil) ;; Optionally embolden heading (point is at beginning of heading): (if woman-bold-headings - (woman-set-face - (point) (save-excursion (end-of-line) (point)) 'woman-bold)) + (woman-set-face (point) (line-end-position) 'woman-bold)) (forward-line) (setq woman-left-margin woman-default-indent woman-nofill nil) ; fill output lines @@ -4361,7 +4374,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C." eol n) (if type (setq tab (woman-get-tab-stop tab) - eol (save-excursion (end-of-line) (point)) + eol (line-end-position) n (save-excursion (search-forward "\t" eol t)) n (- (if n (1- n) eol) (point)) @@ -4486,12 +4499,13 @@ Format paragraphs upto TO." (setq format (apply 'format format args)) (WoMan-log-1 (concat "** " format))) +;; request is not used dynamically by any callees. (defun WoMan-warn-ignored (request ignored) "Log a warning message about ignored directive REQUEST. IGNORED is a string appended to the log message." (let ((tail (buffer-substring (point) - (save-excursion (end-of-line) (point))))) + (line-end-position)))) (if (and (> (length tail) 0) (/= (string-to-char tail) ?\ )) (setq tail (concat " " tail))) @@ -4557,5 +4571,4 @@ logging the message." (provide 'woman) -;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651 ;;; woman.el ends here diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index c589382e014..f071bc49b74 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -220,7 +220,7 @@ The first string is the URL, the second string is the title of that URL. DATA is encoded in utf-16. Decode the URL and call `x-dnd-handle-uri-list'." ;; Mozilla and applications based on it (Galeon for example) uses ;; text/unicode, but it is impossible to tell if it is le or be. Use what - ;; the machine Emacs runs on use. This looses if dropping between machines + ;; the machine Emacs runs on use. This loses if dropping between machines ;; with different endian, but it is the best we can do. (let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le)) (string (decode-coding-string data coding)) @@ -766,5 +766,4 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (provide 'x-dnd) -;; arch-tag: b621fb7e-50da-4323-850b-5fc71ae64621 ;;; x-dnd.el ends here diff --git a/make-dist b/make-dist index 713d88481b3..7f7b01112ae 100755 --- a/make-dist +++ b/make-dist @@ -130,7 +130,6 @@ fi ### (Accept only absolute file names.) if [ $update = yes ]; then - unset EMACS_UNIBYTE if [ -f src/emacs ]; then EMACS=`pwd`/src/emacs @@ -186,72 +185,66 @@ them, and try again." >&2 exit 1 fi -### Find where to run Emacs. -if [ $check = yes ]; -then - ### Check for .elc files with no corresponding .el file. +if [ $check = yes ]; then ls -1 lisp/[a-zA-Z]*.el lisp/[a-z]*/[a-zA-Z0-9]*.el \ lisp/[a-z]*/[a-z]*/[a-zA-Z0-9]*.el \ lisp/[a-z]*/[a-z]*/[a-z]*/[a-zA-Z0-9]*.el \ - leim/[a-z]*/[a-z]*.el | sed 's/\.el$/.elc/' > /tmp/el + leim/[a-z]*/[a-z]*.el > /tmp/el + ls -1 lisp/[a-zA-Z]*.elc lisp/[a-z]*/[a-zA-Z0-9]*.elc \ lisp/[a-z]*/[a-z]*/[a-zA-Z0-9]*.elc \ lisp/[a-z]*/[a-z]*/[a-z]*/[a-zA-Z0-9]*.elc \ leim/[a-z]*/[a-z]*.elc > /tmp/elc - bogosities="`comm -13 /tmp/el /tmp/elc`" - if [ "${bogosities}" != "" ]; then + + ## Check for .elc files with no corresponding .el file. + sed 's/\.el$/.elc/' /tmp/el > /tmp/elelc + + bogosities="`comm -13 /tmp/elelc /tmp/elc`" + if [ x"${bogosities}" != x"" ]; then echo "The following .elc files have no corresponding .el files:" echo "${bogosities}" fi - rm -f /tmp/el /tmp/elc ### Check for .el files with no corresponding .elc file. - ls -1 lisp/[a-zA-Z]*.el lisp/[a-z]*/[a-zA-Z0-9]*.el \ - lisp/[a-z]*/[a-z]*/[a-zA-Z0-9]*.el \ - lisp/[a-z]*/[a-z]*/[a-z]*/[a-zA-Z0-9]*.el \ - leim/[a-z]*/[a-z]*.el > /tmp/el - ls -1 lisp/[a-zA-Z]*.elc lisp/[a-z]*/[a-zA-Z0-9]*.elc \ - lisp/[a-z]*/[a-z]*/[a-zA-Z0-9]*.el \ - lisp/[a-z]*/[a-z]*/[a-z]*/[a-zA-Z0-9]*.el \ - leim/[a-z]*/[a-z]*.elc | sed 's/\.elc$/.el/' > /tmp/elc - losers="`comm -23 /tmp/el /tmp/elc`" + sed 's/\.elc$/.el/' /tmp/elc > /tmp/elcel + losers="`comm -23 /tmp/el /tmp/elcel`" + + rm -f /tmp/el /tmp/elc /tmp/elcel /tmp/elelc + bogosities= for file in $losers; do - if ! grep -q "no-byte-compile: t" $file; then - case $file in - site-init.el | site-load.el | site-start.el | default.el) - ;; - *) - bogosities="$file $bogosities" - ;; - esac - fi + grep -q "no-byte-compile: t" $file && continue + case $file in + site-init.el | site-load.el | site-start.el | default.el) continue ;; + esac + + bogosities="$file $bogosities" + done if [ x"${bogosities}" != x"" ]; then echo "The following .el files have no corresponding .elc files:" echo "${bogosities}" fi - rm -f /tmp/el /tmp/elc fi -### Make sure configure is newer than configure.in. -if [ "x`ls -t configure configure.in | sed q`" != "xconfigure" ]; then - echo "\`./configure.in' is newer than \`./configure'" >&2 - echo "Running autoconf" >&2 - autoconf || { x=$?; echo Autoconf FAILED! >&2; exit $x; } -fi +if [ $update = yes ]; then -### Make sure src/stamp-h.in is newer than configure.in. -if [ "x`ls -t src/stamp-h.in configure.in | sed q`" != "xsrc/stamp-h.in" ]; then - echo "\`./configure.in' is newer than \`./src/stamp-h.in'" >&2 - echo "Running autoheader" >&2 - autoheader || { x=$?; echo Autoheader FAILED! >&2; exit $x; } - rm -f src/stamp-h.in - echo timestamp > src/stamp-h.in -fi + ## Make sure configure is newer than configure.in. + if [ "x`ls -t configure configure.in | sed q`" != "xconfigure" ]; then + echo "\`./configure.in' is newer than \`./configure'" >&2 + echo "Running autoconf" >&2 + autoconf || { x=$?; echo Autoconf FAILED! >&2; exit $x; } + fi + + ## Make sure src/stamp-h.in is newer than configure.in. + if [ "x`ls -t src/stamp-h.in configure.in | sed q`" != "xsrc/stamp-h.in" ]; then + echo "\`./configure.in' is newer than \`./src/stamp-h.in'" >&2 + echo "Running autoheader" >&2 + autoheader || { x=$?; echo Autoheader FAILED! >&2; exit $x; } + rm -f src/stamp-h.in + echo timestamp > src/stamp-h.in + fi -if [ $update = yes ]; -then echo "Updating Info files" (cd doc/emacs; make info) (cd doc/misc; make info) @@ -268,19 +261,7 @@ then echo "Recompiling Lisp files" $EMACS -batch -f batch-byte-recompile-directory lisp leim -fi - -## What is this file for? It goes in srcdir, not the tarfile. -## Why does it exclude term/ ? -echo "Making lisp/MANIFEST" - -files=`find lisp -type f -name '*.el'` -for file in $files; do - case "$file" in - */subdirs.el|*/default.el|*/loaddefs.el|*/term/*) continue ;; - esac - sed -n 's/^;;; //p; q' $file -done | sort > lisp/MANIFEST +fi # $update = yes echo "Creating staging directory: \`${tempparent}'" diff --git a/msdos/ChangeLog b/msdos/ChangeLog index 1be2916aa7b..75906cf5017 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,15 @@ +2010-12-04 Andreas Schwab <schwab@linux-m68k.org> + + * sed1v2.inp (M_FILE, S_FILE): Add $(srcdir)/ prefix. + +2010-10-15 Eli Zaretskii <eliz@gnu.org> + + * sed1v2.inp: Use $(..) instead of ${..} in all edit commands. + Needed because of changes in revno 101897. + + * sed6.inp (mkinfodir): Edit to avoid Unix shell-isms. Needed + because of changes in revno 101876. + 2010-10-10 Dan Nicolaescu <dann@ics.uci.edu> * sed1v2.inp (PROFILING_LDFLAGS): diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 3c1770d1ba1..e2384ef2866 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -128,15 +128,15 @@ s/\.h\.in/.h-in/ /^DEPFLAGS *=/s/@DEPFLAGS@// /^MKDEPDIR *=/s/@MKDEPDIR@// /^version *=/s/@[^@\n]*@// -/^M_FILE *=/s!@[^@\n]*@!m/intel386.h! -/^S_FILE *=/s!@[^@\n]*@!s/msdos.h! +/^M_FILE *=/s!@M_FILE@!$(srcdir)/m/intel386.h! +/^S_FILE *=/s!@S_FILE@!$(srcdir)/s/msdos.h! /^@SET_MAKE@$/s/@SET_MAKE@// -/^.\${libsrc}make-docfile.*>/s!make-docfile!make-docfile -o ../etc/DOC! -/^.\${libsrc}make-doc/s!>.*$!! +/^.\$(libsrc)\/make-docfile.*>/s!make-docfile!make-docfile -o ../etc/DOC! +/^.\$(libsrc)\/make-doc/s!>.*$!! /^[ ]*$/d /^ if test -f/,/^ fi$/c\ command.com /c if exist .gdbinit rm -f _gdbinit -/^ if test "\${CANNOT_DUMP}" =/,/^ else /d +/^ if test "\$(CANNOT_DUMP)" =/,/^ else /d /^ fi/d /^ LC_ALL=C \$(RUN_TEMACS)/i\ stubedit temacs.exe minstack=1024k @@ -152,7 +152,7 @@ s/ || true\; \\$// /^ if test -f/,/^ fi$/c\ command.com /c if exist .gdbinit rm -f _gdbinit /^ #/d -/^ cd.*make-docfile/s!$!; cd ${dot}${dot}/src! +/^ cd.*make-docfile/s!$!; cd ../src! /^ @: /d /^ -\{0,1\} *ln -/s/ln -f/cp -pf/ /^[ ]touch /s/touch/djecho $@ >/ diff --git a/msdos/sed6.inp b/msdos/sed6.inp index f8ad38e4dd9..2382971c30c 100644 --- a/msdos/sed6.inp +++ b/msdos/sed6.inp @@ -43,4 +43,6 @@ export texinputdir := $(srcdir)";"$(TEXINPUTS) s/^ for file in $(INFO_TARGETS)\; do rm -f.*$/ rm -f $(INFO_TARGETS)/ } +/^mkinfodir *=/s| @.*$|@command.com /c if not exist ..\\..\\info\\emacs mkdir ..\\..\\info| + # arch-tag: defe1001-f35a-47f7-9635-3f5d33ee5e97 diff --git a/nt/ChangeLog b/nt/ChangeLog index bed7f2be4d1..f5e950aa3d3 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,7 @@ +2010-11-23 Eli Zaretskii <eliz@gnu.org> + + * config.nt (EXTERNALLY_VISIBLE): Define. + 2010-10-13 Juanma Barranquero <lekktu@gmail.com> * INSTALL: Refer to `dynamic-library-alist'. diff --git a/nt/INSTALL b/nt/INSTALL index 357cc8d0a8e..a000b21ade4 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -105,9 +105,9 @@ since v1.3.3, include the MinGW headers and libraries as an integral part). - Note that building Emacs with Visual Studio 2005 (VC++ 8.0) is not - supported at this time, due to changes introduced by Microsoft into - the libraries shipped with the compiler. + Note that building Emacs with Visual Studio 2005 (VC++ 8.0) and + later is not supported at this time, due to changes introduced by + Microsoft into the libraries shipped with the compiler. The rest of this file assumes you have a working development environment. If you just installed such an environment, try diff --git a/nt/README b/nt/README index 175c5550813..d8a12293f58 100644 --- a/nt/README +++ b/nt/README @@ -1,7 +1,7 @@ Emacs for Windows NT/2000 and Windows 95/98/ME - 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. See the end of the file for license conditions. This directory contains support for compiling and running GNU Emacs on @@ -61,9 +61,6 @@ a mail spool or POP server to a local user mailbox. See the `Movemail' node of the Emacs manual. - + digest-doc.exe, sorted-doc.exe - Tools for rebuilding the - built-in documentation. - * Further information There is a web page that serves as a FAQ for the Windows port of diff --git a/nt/README.W32 b/nt/README.W32 index 9f1df8abd3a..df869d6569d 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,5 +1,5 @@ -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. See the end of the file for license conditions. Emacs for Windows @@ -106,9 +106,6 @@ See the end of the file for license conditions. a mail spool or POP server to a local user mailbox. See the `Movemail' node of the Emacs manual. - + digest-doc.exe, sorted-doc.exe - Tools for rebuilding the - built-in documentation. - * Image support Emacs has built in support for XBM and PPM/PGM/PBM images, and the diff --git a/nt/config.nt b/nt/config.nt index 49f823c9ba4..3df58a29ba3 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -281,6 +281,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define INLINE #endif +#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1)) +#define EXTERNALLY_VISIBLE __attribute__((externally_visible)) +#else +#define EXTERNALLY_VISIBLE +#endif + #undef EMACS_CONFIGURATION #undef EMACS_CONFIG_OPTIONS diff --git a/oldXMenu/ChangeLog b/oldXMenu/ChangeLog index f05553a38b3..329a4ac9565 100644 --- a/oldXMenu/ChangeLog +++ b/oldXMenu/ChangeLog @@ -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>. diff --git a/oldXMenu/XDelAssoc.c b/oldXMenu/XDelAssoc.c index 7aca50aa56b..43446ae8a25 100644 --- a/oldXMenu/XDelAssoc.c +++ b/oldXMenu/XDelAssoc.c @@ -17,6 +17,7 @@ void emacs_remque(struct qelem*); * 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; diff --git a/oldXMenu/XMakeAssoc.c b/oldXMenu/XMakeAssoc.c index 84157399b43..3c79d17dc6a 100644 --- a/oldXMenu/XMakeAssoc.c +++ b/oldXMenu/XMakeAssoc.c @@ -26,6 +26,7 @@ void emacs_insque (struct qelem *elem, struct qelem *prev); * 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; diff --git a/src/.gdbinit b/src/.gdbinit index b3bb6b58267..73fecea5972 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -494,14 +494,30 @@ define pgx 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 - # IMAGE_GLYPH + # 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 == 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 @@ define pgx 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 diff --git a/src/ChangeLog.9 b/src/ChangeLog.9 index fc4f2d4ad37..3c3a5068939 100644 --- a/src/ChangeLog.9 +++ b/src/ChangeLog.9 @@ -12476,9 +12476,9 @@ * atimer.c (stop_other_atimers): Don't call cancel_atimer because that unblocks alarms. - * alloc.c, bytecode.c, data.c, dispnew.c, ecrt0.c, editfns.c, - emacs.c, floatfns.c, fns.c, lread.c, print.c, config.in, lisp.h, - Makefile.in: Remove `LISP_FLOAT_TYPE' and `standalone'. + * alloc.c, bytecode.c, data.c, dispnew.c, ecrt0.c, editfns.c: + * emacs.c, floatfns.c, fns.c, lread.c, print.c, config.in, lisp.h: + * Makefile.in: Remove `LISP_FLOAT_TYPE' and `standalone'. * frame.c (make_frame): Set frame initially to `garbaged'. @@ -13312,4 +13312,3 @@ See ChangeLog.8 for earlier changes. 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: 38875948-6e89-4f08-b0ca-ff328f1e8b72 diff --git a/src/ChangeLog.trunk b/src/ChangeLog.trunk index 72bedcae3fe..738c8b998d0 100644 --- a/src/ChangeLog.trunk +++ b/src/ChangeLog.trunk @@ -1,5 +1,936 @@ +2010-12-08 Glenn Morris <rgm@gnu.org> + + * fileio.c (Fverify_visited_file_modtime): Default to current buffer. + +2010-12-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (parse_region): Ignore blank HTML nodes. + (make_dom): Return CDATA sections (like <style>foo</style>) as + text nodes. + +2010-12-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * lread.c (read1): Allow newstyle unquote outside of backquote. + Disallow old-style backquotes inside new-style backquotes. + Don't count unquotes to figure out when we're "syntactically inside + but semantically outside of a backquote" any more. + Extend the restriction no-unescaped-commas-and-backquotes-in-symbols + to all contexts. + +2010-12-05 Chong Yidong <cyd@stupidchicken.com> + + * process.c: Remove checks for HAVE_SYS_IOCTL_H (Bug#7484). + +2010-12-04 Andreas Schwab <schwab@linux-m68k.org> + + * Makefile.in (M_FILE): Substitute @M_FILE@ instead of @machfile@. + (S_FILE): Substitute @S_FILE@ instead of @opsysfile@. + * m/arm.h, m/sh3.h, m/xtensa.h: Remove files. + +2010-12-03 Andreas Schwab <schwab@linux-m68k.org> + + * lisp.h (union Lisp_Object): Explicitly declare signedness of + bit-field. + (XINT): Remove variant for EXPLICIT_SIGN_EXTEND. + * m/alpha.h (EXPLICIT_SIGN_EXTEND): Don't define. + * m/amdx86-64.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/ia64.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/ibms390.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/ibms390x.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/iris4d.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/m68k.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/sparc.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/template.h (EXPLICIT_SIGN_EXTEND): Likewise. + * m/hp800.h: Remove file. + * m/mips.h: Remove file. + +2010-12-03 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (ns_dumpglyphs_image): If drawing cursor, fill background + with cursor color and draw a rectangle around the image (Bug#7412). + +2010-12-03 Andreas Schwab <schwab@linux-m68k.org> + + * frame.c (x_set_font): Remove unused variable. + +2010-12-02 Jan Djärv <jan.h.d@swipnet.se> + + * nsmenu.m (update_frame_tool_bar): Remove NSLog on invalid image. + + * nsterm.m (ns_draw_glyph_string): Switch fore- and background if + drawing text under filled box cursor (Bug#7479). + +2010-11-27 Kenichi Handa <handa@m17n.org> + + * charset.c (emacs_mule_charset): Make it an array of charset ID; + i.e. integer. + (Fdefine_charset_internal): Adjust for the above change. + (init_charset_once): Likewise. + + * charset.h (emacs_mule_charset): Adjust the prototype. + Delete duplicated extern. + + * coding.c (emacs_mule_char): Adjust for the change of + emacs_mule_charset. + + * lread.c (read_emacs_mule_char): Adjust for the change of + emacs_mule_charset. + +2010-11-27 Eli Zaretskii <eliz@gnu.org> + + * w32.c (_PROCESS_MEMORY_COUNTERS_EX): Don't define with versions + of w32api >= 3.15. (Bug#6989) (Bug#7452) + +2010-11-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * alloc.c (mark_terminals): Ensure that the image cache is marked + even if the terminal object was marked earlier (Bug#6301). + +2010-11-21 Chong Yidong <cyd@stupidchicken.com> + + * editfns.c (Fbyte_to_string): Signal an error arg is not a byte. + +2010-11-27 Jan Djärv <jan.h.d@swipnet.se> + + * gtkutil.c (menubar_map_cb): New function (Bug#7425). + (xg_update_frame_menubar): Connect signal map to menubar_map_cb. + Use 23 as menubar height if 0. (Bug#7425). + +2010-11-26 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (set_message_1): Force paragraph direction in echo area + be left-to-right. + + * keyboard.c (make_lispy_position): Put a meaningful value in yret + when the click is on the header or mode line. + +2010-11-25 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (set_cursor_from_row): Don't forget to consider the + `cursor' property of the first character in overlay strings. + (Bug#7474) (Bug#7481) + +2010-11-24 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (NSLeftControlKeyMask, NSLeftCommandKeyMask) + (NSLeftAlternateKeyMask): New defines. + (keyDown): Parse left and right keys separately (Bug#7458). + Compare Left key masks exactly (Bug#7458). + +2010-11-23 Eli Zaretskii <eliz@gnu.org> + + * intervals.c (temp_set_point_both): Define before calling, to + avoid GCC warnings. + +2010-11-23 Dan Nicolaescu <dann@ics.uci.edu> + + * nsmenu.m: Use #include <config.h> instead of "config.h". + + * term.c (Qglyphless_char,last_glyphless_glyph_frame) + (last_glyphless_glyph_face_id. last_glyphless_glyph_merged_face_id): + Move declarations ... + * lisp.h (Qglyphless_char,last_glyphless_glyph_frame) + (last_glyphless_glyph_face_id. last_glyphless_glyph_merged_face_id): + ... here. + + * emacs.c (gdb_use_union, gdb_valbits,gdb_gctypebits) + (gdb_data_seg_bits, gdb_array_mark_flag, PVEC_FLAG) + (gdb_pvec_type): + * print.c (print_output_debug_flag): + * lisp.h (debug_print): Mark as EXTERNALLY_VISIBLE. + (safe_debug_print): New declaration. + + * xterm.c: + * systty.h: + * sound.c: Include <sys/ioctl.h> unconditionally. + +2010-11-22 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * alloc.c (mark_maybe_object): Return early if given a Lisp + integer (Bug#6301). + +2010-11-21 Ken Brown <kbrown@cornell.edu> + + * sheap.c (STATIC_HEAP_SIZE): Revert previous change. + +2010-11-21 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (ns_right_command_modifier, ns_right_control_modifier): + Define (Bug#7458). + (NSRightCommandKeyMask, NSRightControlKeyMask): Define (Bug#7458). + (EV_MODIFIERS): Check for NSRightCommandKeyMask and + NSRightControlKeyMask also (Bug#7458). + (keyDown): Ditto (Bug#7458). + (syms_of_nsterm): Defvar ns-right-command-modifier and + ns-right-control-modifier (Bug#7458). + +2010-11-21 Dan Nicolaescu <dann@ics.uci.edu> + + * sysdep.c (sys_subshell): Remove SET_EMACS_PRIORITY. + * emacs.c (emacs_priority, syms_of_emacs): Remove emacs_priority. + + * intervals.h (temp_set_point, temp_set_point_both): + * buffer.h (offset_intervals, copy_intervals): Remove INLINE. + +2010-11-20 Ken Brown <kbrown@cornell.edu> + + * sheap.c (STATIC_HEAP_SIZE): Increase to 13MB. + +2010-11-20 Eli Zaretskii <eliz@gnu.org> + + * term.c (produce_glyphless_glyph): Use \uNNNN, \UNNNNNN, or + \xNNNNNN for hex-code display of glyphless characters. + +2010-11-20 Jan Djärv <jan.h.d@swipnet.se> + + * gtkutil.c (xg_make_tool_item): Take vert_only as argument. + Set important to ! vert_only. + (xg_show_toolbar_item): Don't show label horizontally if + tool item isn't important. + (update_frame_tool_bar): Get TOOL_BAR_ITEM_VERT_ONLY and pass it to + xg_make_tool_item, or update important on existing tool item. + + * keyboard.c (QCvert_only): New variable. + (parse_tool_bar_item): Check for QCvert_only. + (syms_of_keyboard): Initialize QCvert_only. + + * dispextern.h (tool_bar_item_idx): Add TOOL_BAR_ITEM_VERT_ONLY. + +2010-11-20 Eli Zaretskii <eliz@gnu.org> + + * msdos.c (dos_rawgetc): Use gen_help_event, instead of doing the + same in-line. + +2010-11-20 Andreas Schwab <schwab@linux-m68k.org> + + * xfaces.c (lookup_face): Make static. + * dispnew.c (copy_row_except_pointers): Likewise. + * syntax.c (dec_bytepos): Likewise. + (inc_bytepos): Remove. + * dispextern.h (lookup_face): Remove declaration. + +2010-11-19 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (set_cursor_from_row): Display cursor after all the + glyphs that come from an overlay. Don't overstep the last glyph + when skipping glyphs from an overlay. (Bug#6687) + +2010-11-18 Dan Nicolaescu <dann@ics.uci.edu> + + * alloc.c (refill_memory_reserve): Move declaration ... + * lisp.h (refill_memory_reserve): ... here. + + * strftime.c (_strftime_copytm): Add declaration. + + * callproc.c (syms_of_callproc): Use intern_c_string. + + Move declarations from .c files to .h files. + * process.c (timers_run): + * minibuf.c (quit_char): + * lread.c (read_emacs_mule_char): + * keyboard.c (minibuf_level, message_enable_multibyte) + (pending_malloc_warning): + * insdel.c (Vselect_active_regions, Vsaved_region_selection) + (Qonly): Remove declarations. + * lisp.h (pending_malloc_warning, Vsaved_region_selection) + (Vselect_active_regions): + * keyboard.h (timers_run): Add declarations. + + * strftime.c (my_strftime_gmtime_r, my_strftime_localtime_r) + (tm_diff): Convert definitions to standard C. + (extra_args_spec_iso): Remove, unused. + +2010-11-18 Jan Djärv <jan.h.d@swipnet.se> + + * xsettings.c (init_gconf): Check HAVE_G_TYPE_INIT. + + * config.in (HAVE_G_TYPE_INIT): New symbol. + +2010-11-18 Eli Zaretskii <eliz@gnu.org> + + * lread.c (Fload): Mention `load-in-progress' and + `load-file-name'. (Bug#7346) + + * keyboard.c (kbd_buffer_nr_stored): Define only ifdef subprocesses. + (kbd_buffer_store_event_hold, kbd_buffer_get_event) + (tty_read_avail_input): Call kbd_buffer_nr_stored only ifdef + subprocesses. Use buffer_free only ifdef subprocesses. + + * process.c (init_process) [subprocesses]: Init kbd_is_on_hold in + the subprocesses version, not in the non-subprocesses one. + + * Makefile.in: Don't use ## comment, it breaks the MSDOS build. + +2010-11-17 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (set_cursor_from_row): Fix cursor positioning in empty + lines on text-mode terminals. (bug#7417) + +2010-11-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * xterm.c (get_current_wm_state): Rename from get_current_vm_state. + (do_ewmh_fullscreen, x_handle_net_wm_state): Update callers. + +2010-11-17 Kenichi Handa <handa@m17n.org> + + * coding.c (Fset_terminal_coding_system_internal): Fix previous + change (set charset-ID list instead of charset-symbol list). + +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. + + * xdisp.c (note_mode_line_or_margin_highlight): + Initialize Cursor to No_Cursor for HAVE_WINDOW_SYSTEM also. + +2010-11-06 Eli Zaretskii <eliz@gnu.org> + + * xfns.c (Fx_show_tip): If any of the tool-tip text lines is R2L, + adjust width of tool-tip frame to the width of text, excluding the + stretch glyph at the beginning of R2L glyph rows. + + * w32fns.c (Fx_show_tip): Likewise. + +2010-11-06 Jan Djärv <jan.h.d@swipnet.se> + + * nsfont.m: Include termchar for new mouse-highlight. + (nsfont_draw): Use MOUSE_HL_INFO. + +2010-11-05 Eli Zaretskii <eliz@gnu.org> + + Unify mouse-highlight code for all GUI and TTY sessions. + + * term.c: Remove static mouse_face_* variables. All users + changed. + (term_show_mouse_face, term_clear_mouse_face) + (fast_find_position, term_mouse_highlight): Functions deleted. + (tty_draw_row_with_mouse_face): New function. + (term_mouse_movement): Call note_mouse_highlight instead of + term_mouse_highlight. + + * nsterm.m (ns_update_window_begin, ns_update_window_end) + (ns_update_end, x_destroy_window, ns_frame_up_to_date) + (ns_dumpglyphs_box_or_relief, ns_maybe_dumpglyphs_background) + (ns_dumpglyphs_image, ns_dumpglyphs_stretch) + (ns_initialize_display_info, keyDown, mouseMoved, mouseExited): + Replace Display_Info with Mouse_HLInfo everywhere where + mouse_face_* members were accessed for mouse highlight purposes. + + * xterm.c (x_update_window_begin, x_update_window_end) + (x_update_end, XTframe_up_to_date, x_set_mouse_face_gc) + (handle_one_xevent, x_free_frame_resources, x_term_init): + Replace Display_Info with Mouse_HLInfo everywhere where mouse_face_* + members were accessed for mouse highlight purposes. + + * w32term.c (x_update_window_begin, x_update_window_end) + (x_update_end, w32_read_socket, x_free_frame_resources) + (w32_initialize_display_info): Replace Display_Info with + Mouse_HLInfo everywhere where mouse_face_* members were accessed + for mouse highlight purposes. + + * xdisp.c (show_mouse_face, note_mode_line_or_margin_highlight) + (note_mouse_highlight) [HAVE_WINDOW_SYSTEM]: Don't run GUI code + unless the frame is on a window-system. + (get_tool_bar_item, handle_tool_bar_click) + (note_tool_bar_highlight, draw_glyphs, erase_phys_cursor) + (show_mouse_face, clear_mouse_face, coords_in_mouse_face_p) + (note_mode_line_or_margin_highlight, note_mouse_highlight) + (x_clear_window_mouse_face, cancel_mouse_face, expose_frame): + Replace Display_Info with Mouse_HLInfo everywhere where + mouse_face_* members were accessed for mouse highlight purposes. + (coords_in_mouse_face_p): Move prototype out of the + HAVE_WINDOW_SYSTEM conditional. + (x_y_to_hpos_vpos, frame_to_window_pixel_xy): Move out of the + HAVE_WINDOW_SYSTEM block. + (try_window_id) [HAVE_GPM || MSDOS]: + Call x_clear_window_mouse_face. + (draw_row_with_mouse_face): Implementation for HAVE_WINDOW_SYSTEM + systems. Call tty_draw_row_with_mouse_face for TTY systems. + (show_mouse_face): Call draw_row_with_mouse_face, instead of + calling draw_glyphs directly. + (show_mouse_face, clear_mouse_face, coords_in_mouse_face_p) + (cursor_in_mouse_face_p, rows_from_pos_range) + (mouse_face_from_buffer_pos, mouse_face_from_string_pos) + (note_mode_line_or_margin_highlight, note_mouse_highlight) + (x_clear_window_mouse_face, cancel_mouse_face): Move out of the + HAVE_WINDOW_SYSTEM block. Ifdef away window-system specific + fragments. + (note_mouse_highlight): Call popup_activated for MSDOS as well. + Clear mouse highlight if pointer is over glyphs whose OBJECT is an + integer. + (mouse_face_from_buffer_pos): Add parentheses around && within ||. + (x_consider_frame_title, tool_bar_lines_needed): + Move prototypes to HAVE_WINDOW_SYSTEM-only part. + (get_window_cursor_type): Move inside a HAVE_WINDOW_SYSTEM-only + part. Remove "#ifdef HAVE_WINDOW_SYSTEM" from body of function. + (null_glyph_slice): Move declaration into HAVE_WINDOW_SYSTEM-only + part. + + * dispnew.c (mirror_make_current): Set Y coordinate of the + mode-line and header-line rows. + (init_display): Setup initial frame's output_data for text + terminal frames. + + * xmenu.c (popup_activated): Don't define on MSDOS, which now has + its own definition on msdos.c. + + * msdos.c (show_mouse_face, clear_mouse_face) + (fast_find_position, IT_note_mode_line_highlight) + (IT_note_mouse_highlight): Functions deleted. + (IT_frame_up_to_date, dos_rawgetc): Call note_mouse_highlight + instead of IT_note_mouse_highlight. + (draw_row_with_mouse_face, popup_activated): New functions. + (dos_set_window_size, draw_row_with_mouse_face, IT_update_begin) + (IT_update_end, IT_frame_up_to_date, internal_terminal_init) + (dos_rawgetc): Replace Display_Info with Mouse_HLInfo everywhere + where mouse_face_* members were accessed for mouse highlight + purposes. + + * msdos.h (initialize_msdos_display): Add prototype. + + * frame.h (MOUSE_HL_INFO): New macro. + + * lisp.h (Mouse_HLInfo): New data type. + + * xterm.h (struct x_display_info): + * w32term.h (struct w32_display_info): + * nsterm.h (struct ns_display_info): + * termchar.h (struct tty_display_info): Use it instead of + mouse_face_* members. + + * dispextern.h (show_mouse_face, clear_mouse_face): Update type of + 1st argument. + (frame_to_window_pixel_xy, note_mouse_highlight) + (x_clear_window_mouse_face, cancel_mouse_face, clear_mouse_face) + (show_mouse_face, cursor_in_mouse_face_p): Move prototypes out of + HAVE_WINDOW_SYSTEM conditional. + (draw_row_with_mouse_face): Declare prototype. + (tty_draw_row_with_mouse_face): Declare prototype. + +2010-11-05 Eli Zaretskii <eliz@gnu.org> + + * term.c (append_glyphless_glyph, produce_glyphless_glyph): + Remove unused variables. + +2010-11-05 Adrian Robert <Adrian.B.Robert@gmail.com> + + * nsterm.m (EmacsView-mouseExited:): Correct error in conditional + logic pointed out by Eli Zaretskii. + +2010-11-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * coding.c (coding-category-list): Refer to set-coding-system-priority + instead of the obsolete set-coding-priority in the doc string. + + +2010-11-04 Adrian Robert <Adrian.B.Robert@gmail.com> + + * nsfont.m (nsfont_draw): Correct previous patch to return + correct value. + * nsimage.m (EmacsImage-setXBMColor:): Correct previous patch: + don't change the method signature, change the return. + +2010-11-04 Ismail Donmez <ismail@namtrac.org> (tiny change) + + * nsfont.m (nsfont_draw) + * nsimage.m (EmacsImage-setXBMColor:) + * nsterm.m (EmacsView-performDragOperation:): Correct empty return. + +2010-11-03 Julien Danjou <julien@danjou.info> + + * image.c (gif_load): Add support for transparency and specified + :background. + +2010-11-01 Kenichi Handa <handa@m17n.org> + + * dispextern.h (lookup_glyphless_char_display): Extern it. + + * termhooks.h (struct terminal): New member charset_list. + + * coding.c (Fset_terminal_coding_system_internal): Set the + `charset_list' member of struct terminal. + + * term.c (produce_glyphs): Handle the case it->what == IT_GLYPHLESS. + (append_glyphless_glyph, produce_glyphless_glyph): New functions. + + * xdisp.c (lookup_glyphless_char_display): Make it non-static. + (lookup_glyphless_char_display): Set it->what at the end. + (last_glyphless_glyph_frame, last_glyphless_glyph_face_id) + (last_glyphless_glyph_merged_face_id): Make them non-static. + + * w32term.c (x_draw_glyphless_glyph_string_foreground): + Fix the arg with_background for font->driver->draw. + +2010-11-01 Kenichi Handa <handa@m17n.org> + + * w32gui.h (STORE_XCHAR2B, XCHAR2B_BYTE1, XCHAR2B_BYTE2): + Surround chp by parentheses. + +2010-11-01 Kenichi Handa <handa@m17n.org> + + Implement various display methods for glyphless characters. + + * xdisp.c (Qglyphless_char, Vglyphless_char_display) + (Qglyphless_char_display, Qhexa_code, Qempty_box, Qthin_space) + (Qzero_width): New variables. + (THIN_SPACE_WIDTH): New macro. + (lookup_glyphless_char_display): New funciton. + (last_glyphless_glyph_frame, last_glyphless_glyph_face_id) + (last_glyphless_glyph_merged_face_id): New variables. + (get_next_display_element): Check glyphless characters. + (redisplay_internal): Initialize last_glyphless_glyph_frame and + last_glyphless_glyph_face_id. + (fill_glyphless_glyph_string): New function. + (BUILD_GLYPHLESS_GLYPH_STRING): New macro. + (BUILD_GLYPH_STRINGS): Handle the case GLYPHLESS_GLYPH. + (append_glyphless_glyph, produce_glyphless_glyph): New functions. + (x_produce_glyphs): If a suitable font is not found, produce a + glyphless glyph. Handle the case it->what == IT_GLYPHLESS. + (syms_of_xdisp): Intern and staticpro Qglyphless_char, + Qglyphless_char_display, Qhexa_code, Qempty_box, Qthin_space, and + Qzero_width. + (Vglyphless_char_display): Declare it as a Lisp variable. + + * dispextern.h (enum glyph_type): Add GLYPHLESS_GLYPH. + (struct glyph): Change the size of the member "type" to 3. + Add glyphless to the union slice and u. + (enum display_element_type): Add IT_GLYPHLESS. + (enum glyphless_display_method): New enum. + (struct it): New member glyphless_method. + (Vglyphless_char_display): Extern it. + + * xterm.c (x_draw_glyphless_glyph_string_foreground): New function. + (x_draw_glyph_string): Handle the case GLYPHLESS_GLYPH. + + * w32term.c (x_draw_glyphless_glyph_string_foreground): New function. + (x_draw_glyph_string): Handle the case GLYPHLESS_GLYPH. + + * nsterm.m (ns_draw_glyph_string): Handle the case + GLYPHLESS_GLYPH (the detail is not yet implemented). + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * xterm.c (x_connection_closed) [USE_X_TOOLKIT]: Fix merge, maybe. + + * frame.c (syms_of_frame) <tool-bar-mode>: + Default to nil if !HAVE_WINDOW_SYSTEM. (Bug#7299) + +2010-10-31 Chong Yidong <cyd@stupidchicken.com> + + * xterm.c (x_connection_closed): Print informative error message + when aborting on GTK. This requires using shut_down_emacs + directly instead of Fkill_emacs. + +2010-10-29 Eli Zaretskii <eliz@gnu.org> + + * emacs.c (main): Call syms_of_filelock unconditionally. + + * filelock.c (syms_of_filelock): Move out of #ifdef CLASH_DETECTION + clause, but keep part of it conditioned on CLASH_DETECTION. + +2010-10-29 Glenn Morris <rgm@gnu.org> + + * nsfns.m (Fx-display-save-under, Fx-open-connection) + (Fxw-color-defined-p, Fxw-display-color-p, Fx-show-tip): + * w32fns.c (Fxw_color_defined_p, Fx_open_connection): + * xfns.c (Fxw_color_defined_p, Fx_open_connection): + Sync docs between X, W32, NS. + + * buffer.c (syms_of_buffer) <abbrev-mode, transient-mark-mode>: + * frame.c (syms_of_frame) <tool-bar-mode>: Move doc here from Lisp. + +2010-10-26 Juanma Barranquero <lekktu@gmail.com> + + * eval.c (init_eval_once): Set max_lisp_eval_depth to 600; + otherwise, bootstrapping on Windows fails to compile macroexp.el. + +2010-10-26 Eli Zaretskii <eliz@gnu.org> + + * cmds.c (internal_self_insert): Don't insert if argument N is + zero or negative. (Bug#7281) + +2010-10-26 Jan Djärv <jan.h.d@swipnet.se> + + * gtkutil.c (qttip_cb): Set title to empty for ATK (Bug#7278). + +2010-10-25 Glenn Morris <rgm@gnu.org> + + * Makefile.in (SOME_MACHINE_LISP): Remove easymenu.elc. + +2010-10-24 Glenn Morris <rgm@gnu.org> + + * w32fns.c (Fx_synchronize, Fx_change_window_property) + (Fx_window_property, Fx_file_dialog): + * xfns.c (Fx_synchronize, Fx_change_window_property) + (Fx_window_property, Fx_file_dialog): Sync docs between w32 and X. + +2010-10-24 Chong Yidong <cyd@stupidchicken.com> + + * xterm.c (x_connection_closed): Kill Emacs unconditionally. + +2010-10-24 Eli Zaretskii <eliz@gnu.org> + + * frame.c (Fframep, Fwindow_system): Deprecate use as a predicate. + + * dispnew.c (syms_of_display) <initial-window-system, window-system>: + Deprecate use as a boolean flag. + +2010-10-24 Jim Meyering <jim@meyering.net> + + * emacs.c (argmatch): Don't treat "--" as "--chdir". + +2010-10-24 Glenn Morris <rgm@gnu.org> + + * w16select.c (syms_of_win16select) <selection-coding-system>: + <next-selection-coding-system>: + * w32select.c (syms_of_w32select) <selection-coding-system>: + <next-selection-coding-system>: + Sync docs with select.el. + + * xfaces.c (syms_of_xfaces) <tty-defined-color-alist>: Sync doc with + Lisp version. + + * w32term.c (syms_of_w32term) <x-use-underline-position-properties>: + Sync doc with the xterm.c version. + + * w32term.c (syms_of_w32term) <x-toolkit-scroll-bars>: + * xterm.c (syms_of_xterm) <x-toolkit-scroll-bars>: Sync docs. + +2010-10-23 Glenn Morris <rgm@gnu.org> + + * buffer.c (syms_of_buffer) <cursor-in-non-selected-windows>: + * frame.c (syms_of_frame) <menu-bar-mode>: + * xdisp.c (syms_of_xdisp) <auto-hscroll-mode, display-hourglass>: + <hourglass-delay>: Sync docs with Lisp. + +2010-10-23 Eli Zaretskii <eliz@gnu.org> + + Implement mouse highlight for bidi-reordered lines. + + * xdisp.c (fast_find_string_pos): #ifdef away, not used anymore. + (mouse_face_from_string_pos): New function, replaces + fast_find_string_pos. + (note_mouse_highlight): Call it instead of fast_find_string_pos. + (note_mode_line_or_margin_highlight): Support bidi-reordered + strings and R2L glyph rows. Fix comments. + (note_mouse_highlight): When bidi reordering is turned on in a + buffer, call next-single-property-change and + previous-single-property-change with last argument nil. Clear + mouse highlight when mouse pointer is in a R2L row on the stretch + glyph that stands for no text beyond the line end. + (row_containing_pos): Don't return too early when CHARPOS is in a + bidi-reordered continued line. Return immediately when the first + hit is found in a line that is not continued, or when an exact + match for CHARPOS is found. + (rows_from_pos_range): New function. + (mouse_face_from_buffer_pos): Use it instead of calling + row_containing_pos for START_CHARPOS and END_CHARPOS. Rewrite the + function to support mouse highlight in bidi-reordered lines and + not to assume that START_CHARPOS is always in mouse_face_beg_row. + If necessary, swap mouse_face_beg_row and mouse_face_end_row so + that the former is always above the latter or identical to it. + (show_mouse_face): Support drawing highlighted R2L lines. + (coords_in_mouse_face_p): New function, bidi-aware. + (cursor_in_mouse_face_p, note_mouse_highlight, erase_phys_cursor): + Call it instead of comparing with mouse-face members of dpyinfo. + (note_mode_line_or_margin_highlight): Fix confusingly swapped + usage of hpos and vpos. + +2010-10-22 Jan Djärv <jan.h.d@swipnet.se> + + * xrdb.c: Include keyboard.h for MOTIF. + + * xmenu.c: Revert 2010-07-27 change: lwlib.h is needed for + MOTIF (Bug#7263). + + * xfns.c: Include Xm/TextF and Xm/List. + (file_dialog_cb, file_dialog_unmap_cb, clean_up_file_dialog): + Make ANSI prototypes. + +2010-10-22 Glenn Morris <rgm@gnu.org> + + * Makefile.in (SOME_MACHINE_LISP): Add w32-vars. + Remove ccl and duplicate mouse. + +2010-10-21 Chong Yidong <cyd@stupidchicken.com> + + * insdel.c (prepare_to_modify_buffer): Don't set + saved-region-selection if modification hooks are disabled. + +2010-10-19 Chong Yidong <cyd@stupidchicken.com> + + * cmds.c (Fdelete_char): Doc fix. + +2010-10-19 Ken Brown <kbrown@cornell.edu> + + * s/cygwin.h (SIGNALS_VIA_CHARACTERS): New define (bug#7225). + +2010-10-19 Kenichi Handa <handa@m17n.org> + + Fix incorrect font metrics when the same font is opened with + different pixelsizes. + + * xftfont.c: Include composite.h. + (xftfont_shape): New function. + (syms_of_xftfont): Set xftfont_driver.shape. + +2010-10-18 Julien Danjou <julien@danjou.info> + + * frame.c (Fframe_pointer_visible_p): + Add `frame-pointer-visible-p' to get the pointer visibility. + +2010-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnutls.c (emacs_gnutls_read): Return 0 if we get a + non-"EAGAIN"-like error to signal to Emacs that the socket should + be closed. + 2010-10-15 Eli Zaretskii <eliz@gnu.org> + * unexcoff.c (make_hdr): Fix prototype according to changes in + revno 101757. + * image.c (tiff_load): Cast 3rd argument to avoid compiler warning. 2010-10-15 Tassilo Horn <tassilo@member.fsf.org> @@ -236,8 +1167,8 @@ anything on any platform. Remove unused code. - * sysdep.c (select_alarm, sys_select, read_input_waiting): Remove - select emulation, all systems support select. + * sysdep.c (select_alarm, sys_select, read_input_waiting): + Remove select emulation, all systems support select. (set_exclusive_use): Remove, the only user is in an #if 0 block. * process.c (create_process): Remove #if 0 code. @@ -302,7 +1233,7 @@ 2010-10-02 Lars Magne Ingebrigtsen <larsi@gnus.org> * xml.c (Flibxml_parse_xml_region, Flibxml_parse_html_region) - (parse_region): Reworked to take regions instead of strings, and + (parse_region): Rework to take regions instead of strings, and renamed to reflect that these are the libxml functions. 2010-10-01 Eli Zaretskii <eliz@gnu.org> @@ -340,7 +1271,8 @@ * msdos.c: * charset.c: Do not include stdlib.h and string.h, config.h does it. - * callproc.c (SIGCHLD): Remove conditional definition, syssignal.h defines it. + * callproc.c (SIGCHLD): Remove conditional definition, syssignal.h + defines it. * process.c: Move #include <pty.h> earlier. (SIGCHLD): Remove conditional definition, syssignal.h defines it. @@ -430,8 +1362,8 @@ (find_last_unchanged_at_beg_row) (find_first_unchanged_at_end_row, row_containing_pos) (trailing_whitespace_p, display_mode_element, decode_mode_spec) - (display_count_lines, x_produce_glyphs, note_mouse_highlight): Use - EMACS_INT for buffer and string positions. + (display_count_lines, x_produce_glyphs, note_mouse_highlight): + Use EMACS_INT for buffer and string positions. * dispextern.h (struct it) <string_nchars>: Declare EMACS_INT. (row_containing_pos): Adjust prototype. @@ -518,7 +1450,7 @@ * dispextern.h (struct glyph): Change the member "slice" to union. Remove u.cmp.from and u.cmp.to. Give more bits to u.cmp.id. - (GLYPH_SLICE_EQUAL_P): Adjusted for the above change. + (GLYPH_SLICE_EQUAL_P): Adjust for the above change. * dispnew.c (buffer_posn_from_coords): Use glyph->slice.img instead of glyph->slice. @@ -714,8 +1646,8 @@ positions. * xdisp.c (redisplay_internal, try_window_id) - (set_cursor_from_row, find_first_unchanged_at_end_row): Use - EMACS_INT for buffer positions. + (set_cursor_from_row, find_first_unchanged_at_end_row): + Use EMACS_INT for buffer positions. * dispextern.h (set_cursor_from_row): Adjust prototype. @@ -725,8 +1657,8 @@ positions. * dispextern.h (mode_line_string, marginal_area_string) - (increment_matrix_positions, increment_row_positions): Adjust - prototypes. + (increment_matrix_positions, increment_row_positions): + Adjust prototypes. * data.c (Faref, Faset): Use EMACS_INT for string length and positions. @@ -739,8 +1671,8 @@ * syntax.c (scan_words, update_syntax_table) (prev_char_comend_first, back_comment, skip_chars) - (skip_syntaxes, Fforward_comment, Fbackward_prefix_chars): Use - EMACS_INT for buffer and string positions. + (skip_syntaxes, Fforward_comment, Fbackward_prefix_chars): + Use EMACS_INT for buffer and string positions. * syntax.h (scan_words, update_syntax_table): Adjust prototypes. @@ -788,8 +1720,8 @@ (modify_overlay, Fmove_overlay, report_overlay_modification) (evaporate_overlays): Use EMACS_INT for buffer positions. - * lisp.h (fix_start_end_in_overlays, overlay_touches_p): Adjust - prototypes. + * lisp.h (fix_start_end_in_overlays, overlay_touches_p): + Adjust prototypes. * dispextern.h (struct bidi_saved_info): Use EMACS_INT for buffer positions. @@ -880,13 +1812,13 @@ * indent.c (compute_motion): Use EMACS_INT for arguments to region_cache_forward. - * region-cache.c (struct boundary, struct region_cache): Use - EMACS_INT for positions. + * region-cache.c (struct boundary, struct region_cache): + Use EMACS_INT for positions. (find_cache_boundary, move_cache_gap, insert_cache_boundary) (delete_cache_boundaries, set_cache_region) (invalidate_region_cache, know_region_cache) - (region_cache_forward, region_cache_backward, pp_cache): Use - EMACS_INT for buffer positions. + (region_cache_forward, region_cache_backward, pp_cache): + Use EMACS_INT for buffer positions. * region-cache.h (know_region_cache, invalidate_region_cache) (region_cache_forward, region_cache_backward): Adjust prototypes. @@ -907,8 +1839,8 @@ (Fline_beginning_position, Fline_end_position, Fprevious_char) (Fchar_after, Fchar_before, Finsert_char) (Finsert_buffer_substring, Fcompare_buffer_substrings) - (Fsubst_char_in_region, Fformat, Ftranspose_regions): Use - EMACS_INT for buffer and string position variables. + (Fsubst_char_in_region, Fformat, Ftranspose_regions): + Use EMACS_INT for buffer and string position variables. (Finsert_char): Protect against too large insertions. * lisp.h (clip_to_bounds): Adjust prototype. @@ -945,8 +1877,8 @@ * editfns.c (Fformat): Use EMACS_INT for string size variables. - * xdisp.c (store_mode_line_noprop, display_mode_element): Use - EMACS_INT for string positions. + * xdisp.c (store_mode_line_noprop, display_mode_element): + Use EMACS_INT for string positions. * intervals.c (get_property_and_range): Use EMACS_INT for buffer position arguments. @@ -956,13 +1888,13 @@ * character.c (parse_str_as_multibyte, str_as_multibyte) (parse_str_to_multibyte, str_to_multibyte, str_as_unibyte) (string_count_byte8, string_escape_byte8, c_string_width) - (strwidth, lisp_string_width, multibyte_chars_in_text): Use - EMACS_INT for string length variables and arguments. + (strwidth, lisp_string_width, multibyte_chars_in_text): + Use EMACS_INT for string length variables and arguments. * character.h (parse_str_as_multibyte, str_as_multibyte) (parse_str_to_multibyte, str_to_multibyte, str_as_unibyte) - (c_string_width, strwidth, lisp_string_width): Adjust - prototypes. + (c_string_width, strwidth, lisp_string_width): + Adjust prototypes. * font.c (font_intern_prop): Use EMACS_INT for string length variables. @@ -982,8 +1914,8 @@ (allocate_string_data, compact_small_strings, Fmake_string) (Fmake_bool_vector, make_string, make_unibyte_string) (make_multibyte_string, make_string_from_bytes) - (make_specified_string_string, Fmake_list, Fmake_vector): Use - EMACS_INT for string length variables and arguments. + (make_specified_string_string, Fmake_list, Fmake_vector): + Use EMACS_INT for string length variables and arguments. (find_string_data_in_pure, make_pure_string, make_pure_c_string) (Fpurecopy): Use EMACS_INT for string size. (mark_vectorlike, mark_char_table, mark_object): Use EMACS_UINT @@ -1248,8 +2180,8 @@ 2010-09-04 Eli Zaretskii <eliz@gnu.org> - * w32uniscribe.c (uniscribe_shape): Update commentary. Don't - try to reorder grapheme clusters, since LGSTRING should always + * w32uniscribe.c (uniscribe_shape): Update commentary. + Don't try to reorder grapheme clusters, since LGSTRING should always hold them in the logical order. (uniscribe_encode_char, uniscribe_shape): Force ScriptShape to return glyph codes in the logical order. @@ -1448,16 +2380,16 @@ Do not define EMACS_HAVE_TTY_PGRP. Only define EMACS_GET_TTY_PGRP for !DOS_NT. * sysdep.c: Include sysselect.h unconditionally. Do not include - sys/ioctl.h and termios.h, systty.h does it. Use - HAVE_SYS_UTSNAME_H instead of USG as an include guard. + sys/ioctl.h and termios.h, systty.h does it. + Use HAVE_SYS_UTSNAME_H instead of USG as an include guard. (init_baud_rate): Remove HAVE_TERMIO code. (child_setup_tty): Remove HAVE_TERMIO code. (emacs_get_tty, emacs_set_tty): Remove HAVE_TERMIO, HAVE_TCHARS and HAVE_LTCHARS code. Use !DOS_NT instead of HAVE_TCATTR. (new_ltchars, new_tchars): Remove, unused. (init_sys_modes): Remove HAVE_TERMIO, HAVE_TCHARS and HAVE_LTCHARS - code. Remove special casing for __mips__, it was a no-op. Remove - HAVE_TCATTR conditional, it is implied by HAVE_TERMIOS. + code. Remove special casing for __mips__, it was a no-op. + Remove HAVE_TCATTR conditional, it is implied by HAVE_TERMIOS. (init_sys_modes): Remove HPUX special case. * process.c: Include stdlib.h unconditionally. Do not include fcntl.h, systty.h does it. Remove conditional code for @@ -2181,8 +3113,8 @@ (initial_argv, last_nonmenu_event, load_in_progress) (noninteractive_need_newline, scroll_margin): Add declarations. - * keyboard.h (xmalloc_widget_value, digest_single_submenu): Remove - declarations, menu.h has them. + * keyboard.h (xmalloc_widget_value, digest_single_submenu): + Remove declarations, menu.h has them. (QCbutton, QCtoggle, QCradio, QClabel, extra_keyboard_modifiers) (Vinput_method_function, Qinput_method_function) (Qevent_symbol_element_mask, last_event_timestamp): @@ -2489,8 +3421,8 @@ * term.c (Qspace, QCalign_to, QCwidth): Remove declarations. (encode_terminal_code, produce_composite_glyph): Remove unused variables. - (set_tty_color_mode, term_mouse_highlight, term_get_fkeys): Remove - local extern declarations. + (set_tty_color_mode, term_mouse_highlight, term_get_fkeys): + Remove local extern declarations. * xmenu.c: Do not included lwlib.h, not needed. @@ -2855,8 +3787,8 @@ (cvt_pixel_dtor, x_window_to_menu_bar, xt_action_hook) (xaw_jump_callback, xaw_scroll_callback) (x_create_toolkit_scroll_bar, x_set_toolkit_scroll_bar_thumb) - (x_wm_set_size_hint, x_activate_timeout_atimer): Convert - definitions to standard C. + (x_wm_set_size_hint, x_activate_timeout_atimer): + Convert definitions to standard C. * xmenu.c (menubar_id_to_frame, popup_get_selection) (popup_activate_callback, popup_deactivate_callback) (menu_highlight_callback, menubar_selection_callback) @@ -2969,7 +3901,7 @@ (Ffont_put): Accept font-entity and font-object too. (Ffont_get_glyhphs): Renamed from Fget_font_glyphs. Arguments and return value changed. - (syms_of_font): Adjusted for the above change. + (syms_of_font): Adjust for the above change. 2010-07-11 Andreas Schwab <schwab@linux-m68k.org> @@ -3060,8 +3992,8 @@ * frame.c (make_frame): Initialize menu_bar_lines and tool_bar_lines members. - (make_initial_frame, make_terminal_frame): Initialize - menu_bar_lines using value of menu-bar-mode. + (make_initial_frame, make_terminal_frame): + Initialize menu_bar_lines using value of menu-bar-mode. * msdos.c (IT_set_frame_parameters): Don't set menu-bar-lines. @@ -3509,8 +4441,8 @@ * xsmfns.c (SSDATA): New macro. (smc_save_yourself_CB, x_session_initialize): Use SSDATA for strings passed to strlen/strcpy/strcat. - (create_client_leader_window): Surround with #ifndef USE_GTK. Cast - 7:th arg to XChangeProperty to (unsigned char *). + (create_client_leader_window): Surround with #ifndef USE_GTK. + Cast 7:th arg to XChangeProperty to (unsigned char *). * xsettings.c (something_changedCB, parse_settings) (apply_xft_settings): Reformat prototype. @@ -3668,8 +4600,8 @@ * msdos.c (IT_set_frame_parameters): Fix setting of colors in frames other than the initial one. Fix reversal of colors when - `reverse' is specified in the frame parameters. Call - update_face_from_frame_parameter instead of + `reverse' is specified in the frame parameters. + Call update_face_from_frame_parameter instead of internal-set-lisp-face-attribute. Initialize screen colors from initial_screen_colors[] when f->default_face_done_p is zero, instead of depending on being called with default-frame-alist as @@ -3854,8 +4786,8 @@ 2010-06-30 Chong Yidong <cyd@stupidchicken.com> - * frame.c (get_future_frame_param, Fmake_terminal_frame): Don't - check default-frame-alist. + * frame.c (get_future_frame_param, Fmake_terminal_frame): + Don't check default-frame-alist. 2010-06-30 Andreas Schwab <schwab@linux-m68k.org> @@ -3947,8 +4879,8 @@ (Bug#6526). * xterm.h (gtk_widget_get_window, gtk_widget_get_mapped) - (gtk_adjustment_get_page_size, gtk_adjustment_get_upper): New - defines based on what configure finds. + (gtk_adjustment_get_page_size, gtk_adjustment_get_upper): + New defines based on what configure finds. * xterm.c (XTflash): Use gtk_widget_get_window. (xg_scroll_callback): Use gtk_adjustment_get_upper and @@ -3962,8 +4894,8 @@ * gtkutil.h: Replace HAVE_GTK_FILE_BOTH with HAVE_GTK_FILE_SELECTION_NEW. - * gtkutil.c (xg_display_open, xg_display_close): Remove - HAVE_GTK_MULTIDISPLAY, it is always defined. + * gtkutil.c (xg_display_open, xg_display_close): + Remove HAVE_GTK_MULTIDISPLAY, it is always defined. (xg_display_open): Return type is void. (gtk_widget_set_has_window) (gtk_dialog_get_action_area, gtk_dialog_get_content_area) @@ -3972,8 +4904,8 @@ (gtk_adjustment_get_step_increment): #define these if not found by configure. (remove_submenu): New define based on Gtk+ version. - (xg_set_cursor, xg_frame_resized, xg_event_is_for_scrollbar): Use - gtk_widget_get_window. + (xg_set_cursor, xg_frame_resized, xg_event_is_for_scrollbar): + Use gtk_widget_get_window. (xg_frame_resized, xg_update_frame_menubar): Use gtk_widget_get_mapped. (xg_create_frame_widgets): Use gtk_widget_set_has_window. (create_dialog): Use gtk_dialog_get_action_area and @@ -3981,10 +4913,10 @@ (xg_uses_old_file_dialog, xg_get_file_name): Remove HAVE_GTK_FILE_BOTH and HAVE_GTK_FILE_CHOOSER_DIALOG_NEW. File chooser is always available, so checking for HAVE_GTK_FILE_SELECTION_NEW is enough. - (xg_update_menubar, xg_update_submenu, xg_show_toolbar_item): Use - g_object_ref and g_object_unref. - (xg_update_menu_item, xg_tool_bar_menu_proxy): Use - gtk_widget_get_sensitive. + (xg_update_menubar, xg_update_submenu, xg_show_toolbar_item): + Use g_object_ref and g_object_unref. + (xg_update_menu_item, xg_tool_bar_menu_proxy): + Use gtk_widget_get_sensitive. (xg_update_submenu): Use remove_submenu. (xg_update_scrollbar_pos): Don't use GtkFixedChild, use child properties instead to get old x and y position. @@ -4517,8 +5449,8 @@ Move static/dynamic dependency stuff to deps.mk/autodeps.mk. * deps.mk, autodeps.mk: New files, extracted from Makefile.in. - * bidi.c (bidi_cache_shrink, bidi_cache_iterator_state): Fix - reallocation of the cache. (Bug#6210) + * bidi.c (bidi_cache_shrink, bidi_cache_iterator_state): + Fix reallocation of the cache. (Bug#6210) 2010-05-19 Glenn Morris <rgm@gnu.org> @@ -5225,8 +6157,8 @@ Reduce CPP usage. * Makefile.in (LIB_X11_LIB): Remove, inline in the only user. (obj): Use autoconf for unexec instead of cpp. - (C_SWITCH_SYSTEM, C_SWITCH_MACHINE, C_SWITCH_X_SITE): Remove - definitions and undefs. Inline definitions in the only user. + (C_SWITCH_SYSTEM, C_SWITCH_MACHINE, C_SWITCH_X_SITE): + Remove definitions and undefs. Inline definitions in the only user. (ALL_CFLAGS): Substitute C_SWITCH_X_SYSTEM using autoconf. 2010-04-27 Glenn Morris <rgm@gnu.org> @@ -5337,8 +6269,8 @@ the only user: s/unixware.h. * ecrt0.c: Remove #ifndef static. Inline CRT0_DUMMIES definition from m/intel386.h. - * s/unixware.h (LOAD_AVE_TYPE, LOAD_AVE_CVT, FSCALE): Definitions - moved here from m/intel386.h. + * s/unixware.h (LOAD_AVE_TYPE, LOAD_AVE_CVT, FSCALE): + Definitions moved here from m/intel386.h. * m/mips.h: Remove #if 0 code. @@ -5420,14 +6352,14 @@ HAVE_XFT. (something_changedCB): store_font_changed_event is now store_config_changed_event. - (parse_settings): Rename from parse_xft_settings. Read - non-xft xsettings outside #ifdef HAVE_XFT. + (parse_settings): Rename from parse_xft_settings. + Read non-xft xsettings outside #ifdef HAVE_XFT. (read_settings): Renamed from read_xft_settings. (apply_xft_settings): Take current settings as parameter. Do not call read_(xft)_settings. (read_and_apply_settings): New function. - (xft_settings_event): Do non-xft stuff out of HAVE_XFT. Call - read_and_apply_settings if there are settings to be read. + (xft_settings_event): Do non-xft stuff out of HAVE_XFT. + Call read_and_apply_settings if there are settings to be read. (init_xsettings): Renamed from init_xfd_settings. Call read_and_apply_settings unconditionally. (xsettings_initialize): Call init_xsettings. @@ -5555,19 +6487,19 @@ * xdisp.c [HAVE_WINDOW_SYSTEM]: Add prototype for append_stretch_glyph. - (set_cursor_from_row) <cursor_x>: Remove unused variable. Fix - off-by-one error in computing x at end of text in the row. + (set_cursor_from_row) <cursor_x>: Remove unused variable. + Fix off-by-one error in computing x at end of text in the row. (append_stretch_glyph): In reversed row, prepend the glyph rather than append it. Set resolved_level and bidi_type of the glyph. (extend_face_to_end_of_line): If the row is reversed, prepend a stretch glyph whose width is such that the rightmost glyph will be drawn at the right margin of the window. Fix off-by-one error on - TTY frames in testing whether a line needs face extension. Fix - face extension at ZV. If this is the last glyph row, use + TTY frames in testing whether a line needs face extension. + Fix face extension at ZV. If this is the last glyph row, use DEFAULT_FACE_ID, to avoid painting the rest of the window with the region face. - (set_cursor_from_row, display_line): Use - MATRIX_ROW_CONTINUATION_LINE_P instead of testing value of + (set_cursor_from_row, display_line): + Use MATRIX_ROW_CONTINUATION_LINE_P instead of testing value of row->continuation_lines_width. (next_element_from_buffer): Don't call bidi_paragraph_init if we are at ZV. Fixes a crash when reseated to ZV by @@ -5933,8 +6865,8 @@ * xmenu.c: include xsettings.h and xlwmenu.h if USE_LUCID. (apply_systemfont_to_menu): New function. - (set_frame_menubar, create_and_show_popup_menu): Call - apply_systemfont_to_menu. + (set_frame_menubar, create_and_show_popup_menu): + Call apply_systemfont_to_menu. 2010-04-07 Jan Djärv <jan.h.d@swipnet.se> @@ -5962,8 +6894,8 @@ 2010-04-03 Eli Zaretskii <eliz@gnu.org> - * bidi.c (bidi_resolve_explicit, bidi_level_of_next_char): Check - bidi_it->bytepos against ZV_BYTE instead of bidi_it->ch against + * bidi.c (bidi_resolve_explicit, bidi_level_of_next_char): + Check bidi_it->bytepos against ZV_BYTE instead of bidi_it->ch against BIDI_EOB. Fixes infloop with vertical cursor motion at ZV. * w32fns.c (x_create_tip_frame): Copy `parms' before we modify it @@ -6186,8 +7118,8 @@ (prepare_desired_row): Preserve the reversed_p flag. (row_equal_p): Compare the reversed_p attributes as well. - * xdisp.c (init_iterator): Initialize it->bidi_p. Call - bidi_init_it and set it->paragraph_embedding from the current + * xdisp.c (init_iterator): Initialize it->bidi_p. + Call bidi_init_it and set it->paragraph_embedding from the current buffer's value of bidi_paragraph_direction. (reseat_1): Initialize bidi_it.first_elt. (set_iterator_to_next, next_element_from_buffer): Use the value of @@ -6198,8 +7130,8 @@ (next_element_from_buffer): If bidi_it.first_elt is set, initialize paragraph direction and find the first character to display in the visual order. If reseated to a middle of a line, - prime the bidi iterator starting at the line's beginning. Handle - the situation where we overstepped stop_charpos due to + prime the bidi iterator starting at the line's beginning. + Handle the situation where we overstepped stop_charpos due to non-linearity of the bidi iteration. Likewise for when we back up beyond the previous stop_charpos. When moving across stop_charpos, record it in prev_stop. @@ -6220,8 +7152,8 @@ now EMACS_INT; all callers changed. (set_cursor_from_row): Rewritten to support bidirectional text and reversed glyph rows. - (text_outside_line_unchanged_p, try_window_id): Disable - optimizations if we are reordering bidirectional text and the + (text_outside_line_unchanged_p, try_window_id): + Disable optimizations if we are reordering bidirectional text and the paragraph direction can be affected by the change. (append_glyph, append_composite_glyph) (produce_image_glyph, append_stretch_glyph): Set the @@ -8374,8 +9306,8 @@ 2009-09-18 Adrian Robert <Adrian.B.Robert@gmail.com> * emacs.c (inhibit_x_resources): Update doc string for NS. - (main) [HAVE_NS]: Don't process --no-init-file option. Remove - legacy code for -NXHost. Fix error printf in daemon case. + (main) [HAVE_NS]: Don't process --no-init-file option. + Remove legacy code for -NXHost. Fix error printf in daemon case. * nsterm.h (ns_no_defaults): Remove. @@ -8384,8 +9316,8 @@ (ns_use_qd_smoothing): Remove legacy variable. (EmacsView-windowShouldZoom:): Set frame left_pos, top_pos and don't update the NSWindow itself. - (EmacsView-windowWillUseStandardFrame:defaultFrame:): Improve - state detection and store user rect ourselves. (Bug #3581) + (EmacsView-windowWillUseStandardFrame:defaultFrame:): + Improve state detection and store user rect ourselves. (Bug #3581) * nsfont.m (nsfont_draw) [NS_IMPL_COCOA]: Don't use ns_use_qd_smoothing. @@ -8688,8 +9620,8 @@ 2009-08-21 Adrian Robert <Adrian.B.Robert@gmail.com> * nsterm.m (ns_get_color): Update documentation properly for last - change, and clean up loose ends in the code left by it. Fix - longstanding bug with 16-bit hex parsing, and add support for + change, and clean up loose ends in the code left by it. + Fix longstanding bug with 16-bit hex parsing, and add support for yet another X11 format (rgb:r/g/b) for compatibility. * nsfns.m (EmacsDialogPanel-runDialogAt): Add declaration of timer_check() to avoid crash on Leopard/PPC. Bug #2154. @@ -10584,8 +11516,8 @@ (Fdefine_coding_system_internal): Likewise. (setup_coding_system): Likewise. Remove unneeded casts. (detect_coding_iso_2022): Compare Viso_2022_charset_list with - CODING_ATTR_CHARSET_LIST, not CODING_ATTR_SAFE_CHARSETS. Remove - unneeded casts. + CODING_ATTR_CHARSET_LIST, not CODING_ATTR_SAFE_CHARSETS. + Remove unneeded casts. * insdel.c (del_range_2): Don't modify gap contents when called from decode_coding_object. (Bug#1809) @@ -10598,8 +11530,8 @@ * lisp.h: Define Qfont_spec, Qfont_entity, Qfont_object extern. - * font.c (Qfont_spec, Qfont_entity, Qfont_object): Definitions - moved to data.c. + * font.c (Qfont_spec, Qfont_entity, Qfont_object): + Definitions moved to data.c. 2009-02-20 Adrian Robert <Adrian.B.Robert@gmail.com> @@ -11615,8 +12547,8 @@ here; it will be done in init_frame_faces. * xterm.h (struct xim_inst_t): Definition moved from xterm.c. - (struct x_display_info): Remove unused member null_pixel. New - member xim_callback_data. + (struct x_display_info): Remove unused member null_pixel. + New member xim_callback_data. * xterm.c (struct xim_inst_t): Definition moved to xterm.h. (xim_initialize): Save pointer to callback function data. @@ -11641,8 +12573,8 @@ 2008-12-12 Jason Rumney <jasonr@gnu.org> - * w32fns.c (x_display_info_for_name, Fx_open_connection): Set - Vwindow_system_version to the real w32 major version. + * w32fns.c (x_display_info_for_name, Fx_open_connection): + Set Vwindow_system_version to the real w32 major version. 2008-12-12 Dan Nicolaescu <dann@ics.uci.edu> @@ -11892,7 +12824,7 @@ (set_category_set): Extern it. * category.c (hash_get_category_set): New function. - (Fmodify_category_entry): Adjusted for the change of + (Fmodify_category_entry): Adjust for the change of char_table_ref_and_range. Call hash_get_category_set to get a category set to store in the table. @@ -11910,8 +12842,8 @@ (SET_TEMP_CHARSET_WORK_ENCODER, GET_TEMP_CHARSET_WORK_ENCODER) (SET_TEMP_CHARSET_WORK_DECODER, GET_TEMP_CHARSET_WORK_DECODER): New macros. - (load_charset_map): Meaning of control_flag changed. If - inhibit_load_charset_map is nonzero, setup a table in + (load_charset_map): Meaning of control_flag changed. + If inhibit_load_charset_map is nonzero, setup a table in temp_charset_work. (load_charset): New argument control_flag. (map_charset_for_dump): New function. @@ -11930,18 +12862,18 @@ (syms_of_charset): Make `inhibit-load-charset-map' a Lisp variable. - * chartab.c (sub_char_table_ref_and_range): Adjusted for the + * chartab.c (sub_char_table_ref_and_range): Adjust for the change of char_table_ref_and_range. (char_table_ref_and_range): Change the meaning of argument FROM and TO. Now the caller must provide initial values for *FROM and *TO. - * fontset.c (fontset_add): Adjusted for the change of + * fontset.c (fontset_add): Adjust for the change of char_table_ref_and_range. (fontset_get_font_group): Likewise. (Ffontset_info): Likewise. - * keymap.c (describe_vector): Adjusted for the change of + * keymap.c (describe_vector): Adjust for the change of char_table_ref_and_range. For char-table, put boundary between non-ASCII and 8-bit characters. @@ -13755,8 +14687,8 @@ * s/darwin.h: Add #define DARWIN_OS. Get rid of C_SWITCH_SYSTEM def. Change LIBS_MACGUI to LIBS_NSGUI. Move temacs-conditionalized defs - closer to C_SWITCH_SYSTEM_TEMACS so usage is understood. Expand - comment on NO_SOCK_SIGIO. + closer to C_SWITCH_SYSTEM_TEMACS so usage is understood. + Expand comment on NO_SOCK_SIGIO. 2008-08-03 Chong Yidong <cyd@stupidchicken.com> @@ -14748,8 +15680,8 @@ 2008-07-15 Chris Hall <chris@web.workinglinux.com> (tiny change) - * callproc.c (set_initial_environment): Initialize - Vprocess_environment under CANNOT_DUMP (fixes crash when + * callproc.c (set_initial_environment): + Initialize Vprocess_environment under CANNOT_DUMP (fixes crash when batch-compiling for bootstrap). 2008-07-15 Chris Hall <chris@web.workinglinux.com> (tiny change) @@ -15165,8 +16097,8 @@ * xftfont.c (struct xftfont_info): New member ft_size. Make the member order compatible with struct ftfont_info. - (xftfont_open): Add FC_CHARSET to the pattern. Set - xftfont_info->ft_size. Don't unlock the face. Check BDF + (xftfont_open): Add FC_CHARSET to the pattern. + Set xftfont_info->ft_size. Don't unlock the face. Check BDF properties if appropriate. (xftfont_close): Unlock the face. (xftfont_anchor_point, xftfont_shape): Deleted. @@ -15592,8 +16524,8 @@ truncate only if the window width is below that integer. (start_display, resize_mini_window, produce_stretch_glyph) (display_string, move_it_in_display_line_to): Use line_wrap. - (back_to_previous_visible_line_start, reseat_1): Reset - string_from_display_prop_p. + (back_to_previous_visible_line_start, reseat_1): + Reset string_from_display_prop_p. (display_line): Extend default face to end of line when wrapping. 2008-06-24 Kim F. Storm <storm@cua.dk> @@ -16961,8 +17893,8 @@ (struct glyph_string): New member underline_position and underline_thickness. (enum lface_attribute_index): Remove LFACE_AVGWIDTH_INDEX. - (struct face): Change type of `font' to `struct font *'. Remove - members `font_name', `font_info_id'. + (struct face): Change type of `font' to `struct font *'. + Remove members `font_name', `font_info_id'. (per_char_metric, encode_char): Delete externs. (calc_pixel_width_or_height): Adjust the prototype. @@ -16990,8 +17922,8 @@ (CHECK_FONT_GET_OBJECT): Likewise. (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT, XSETFONT): New macros. (PT_PER_INCH, POINT_TO_PIXEL, PIXEL_TO_POINT): Moved from font.h. - (struct font_driver): New members case_sensitive anc check. Type - of the member list and open changed. + (struct font_driver): New members case_sensitive anc check. + Type of the member list and open changed. (enable_font_backend, font_symbolic_weight, font_symbolic_slant) (font_symbolic_width, font_find_object, font_get_spec) (font_set_lface_from_name): Delete extern. @@ -17011,7 +17943,7 @@ (font_make_spec, font_make_entity, font_make_object) (font_intern_prop): Renamed from intern_downcase. Don't downcase the string. Callers changed. - (font_pixel_size): Adjusted for the format change of font-related + (font_pixel_size): Adjust for the format change of font-related objects. (prop_name_to_numeric, prop_numeric_to_name): Delete them. (font_style_to_value, font_style_symbolic): New function. @@ -17019,19 +17951,19 @@ (font_registry_charsets): Use Fassoc_string instead of assq_no_quit. (font_prop_validate_symbol): Don't return null_string. - (font_prop_validate_style): Adjusted for the change of + (font_prop_validate_style): Adjust for the change of style-related values in a font vector. (font_property_table): Delete entries for QClanguage and QCantialias, add entries for QCavgwidth. (get_font_prop_index): Delete the 2nd argument FROM. (font_prop_validate): Arguments changed. - (font_put_extra): Adjusted for the change of font-related objects. + (font_put_extra): Adjust for the change of font-related objects. (font_expand_wildcards, font_parse_xlfd, font_unparse_xlfd) (font_parse_fcname, font_unparse_fcname) (font_prepare_composition): Likewise. (font_parse_family_registry): Renamed from font_merge_old_spec. (otf_open): Delete the 1st arg entity. - (font_otf_capability): Adjusted for the above change. + (font_otf_capability): Adjust for the above change. (font_score): New arg alternate_families. Adjusted for the change of font-related objects. (font_sort_entites): New arg best_only. @@ -17040,27 +17972,27 @@ (font_match_p): Check alternate families. (font_find_object): Delete it. (font_check_object): New function. - (font_clear_cache): Adjusted for the change of font-related objects. + (font_clear_cache): Adjust for the change of font-related objects. (font_delete_unmatched): New arg. (font_list_entities): Call font_driver->list with a spec that doesn't specify style-related properties. (font_matching_entity): Arguments changed. Caller changed. - (font_open_entity): Adjusted for the change of font-related objects. + (font_open_entity): Adjust for the change of font-related objects. (font_close_object, font_has_char, font_encode_char) (font_get_name, font_get_spec): Likewise. (font_spec_from_name, font_clear_prop, font_update_lface): New functions. (font_find_for_lface, font_open_for_lface, font_load_for_lface) (font_prepare_for_face, font_done_for_face, font_open_by_name) - (font_at): Adjusted for the change of font-related objects. + (font_at): Adjust for the change of font-related objects. (font_range): New function. (Ffontp, Ffont_spec, Ffont_get, Ffont_put, Flist_fonts) - (Ffont_xlfd_name): Adjusted for the change of font-related objects. + (Ffont_xlfd_name): Adjust for the change of font-related objects. (Fcopy_font_spec, Fmerge_font_spec): New function. (Ffont_family_list): Renamed from list-families. (Finternal_set_font_style_table): Arguments changed. (Ffont_fill_gstring, Ffont_shape_text, Fopen_font) - (Ffont_drive_otf, Fquery_font, Ffont_match_p): Adjusted for the + (Ffont_drive_otf, Fquery_font, Ffont_match_p): Adjust for the change of font-related objects. (syms_of_font): Delete "ifdef USE_FONT_BACKEND". DEFSYM new symbols. @@ -17070,8 +18002,8 @@ (enum FONT_SPEC_INDEX): Delete it. (font_info, list_fonts_func, load_font_func, query_font_func) (set_frame_fontset_func, find_ccl_program_func) - (get_font_repertory_func, new_fontset_from_font_name): Delete - externs. + (get_font_repertory_func, new_fontset_from_font_name): + Delete externs. (fontset_from_font_name): Extern it. (FS_LOAD_FONT, FONT_INFO_ID, FONT_INFO_FROM_ID) (FONT_INFO_FROM_FACE): Deleted. @@ -17101,7 +18033,7 @@ (face_for_char): Likewise. Call face_for_char with font_object. (fs_load_font): Delete. Delete #pragma surrounding it. (fs_query_fontset): Use strcasecmp instead of strcmp. - (generate_ascii_font_name): Adjusted for the format change of + (generate_ascii_font_name): Adjust for the format change of font-spec. (Fset_fontset_font): Likewise. Use new macros to set elements of font-def. @@ -17112,7 +18044,7 @@ a fontset is already created for the font. FIx updating of Vfontset_alias_alist. (fontset_ascii_font): Deleted. - (Ffont_info): Adjusted for the format change of font-spec. + (Ffont_info): Adjust for the format change of font-spec. (Finternal_char_font): Likewise. (Ffontset_info): Likewise. (syms_of_fontset): Don't check load_font_func. @@ -17128,13 +18060,13 @@ (x_set_font_backend): Use FRAME_FONT macro to check if a font is already set for the frame. - * ftfont.c (ftfont_pattern_entity): Argument FRAME removed. Make - a font-entity by font_make_entity. Use font_intern_prop instead + * ftfont.c (ftfont_pattern_entity): Argument FRAME removed. + Make a font-entity by font_make_entity. Use font_intern_prop instead of intern_downcase. Use FONT_SET_STYLE to set a style-related font property. If a font is scalable, set avgwidth property to 0. Set font-entity property by font_put_extra. (ftfont_list_generic_family): Argument SPEC and REGISTRY removed. - (ffont_driver): Adjusted for the change of struct font_driver. + (ffont_driver): Adjust for the change of struct font_driver. (ftfont_spec_pattern): New function. (ftfont_list): Return a list, not vector. (ftfont_match): Use ftfont_spec_pattern to get a pattern. @@ -17145,7 +18077,7 @@ font property. Don't update dpyinfo->smallest_font_height and dpyinfo->smallest_char_width. (ftfont_close): Don't free `struct font'. - (ftfont_has_char): Adjusted for the format change of font-entity. + (ftfont_has_char): Adjust for the format change of font-entity. (ftfont_encode_char, ftfont_text_extents): Likewise. * ftxfont.c (ftxfont_list): Return a list, not vector. @@ -17154,10 +18086,10 @@ font property. Don't update dpyinfo->smallest_font_height and dpyinfo->smallest_char_width. (ftxfont_close): Don't decrease FRAME_X_DISPLAY_INFO (f)->n_fonts. - (ftxfont_draw): Adjusted for the change of struct font. + (ftxfont_draw): Adjust for the change of struct font. - * image.c (image_ascent): Don't include "charset.h". Include - "character.h" and "font.h". + * image.c (image_ascent): Don't include "charset.h". + Include "character.h" and "font.h". * lisp.h (enum pvec_type): New member PREV_FONT. (Fassoc_string): EXFUN it. @@ -17175,19 +18107,19 @@ 'struct font *'. (get_char_face_and_encoding): Assign the whole encoding task to the `encode-char' method of a font driver. - (fill_composite_glyph_string): Adjusted for the change of `struct + (fill_composite_glyph_string): Adjust for the change of `struct face' and `struct glyph_string'. (fill_glyph_string): Likewise. (get_per_char_metric): Arguments changed. - (x_get_glyph_overhangs): Adjusted for the change of `struct face' + (x_get_glyph_overhangs): Adjust for the change of `struct face' and `struct glyph_string'. (produce_stretch_glyph, calc_line_height_property) (x_produce_glyphs): Likewise. * xfaces.c: Throughout the file, delete all USE_FONT_BACKEND conditionals. Don't check enable_font_backend. Delete all codes - used only when USE_FONT_BACKEND is not defined. Use - FONT_XXX_NAME_NUMERIC instead of face_numeric_xxx. + used only when USE_FONT_BACKEND is not defined. + Use FONT_XXX_NAME_NUMERIC instead of face_numeric_xxx. (QCfoundry, QCadstyle, QCregistry, QCspacing, QCsize, QCavgwidth) (Qp): Extern them. (clear_font_table, load_face_font, xlfd_lookup_field_contents): @@ -17260,7 +18192,7 @@ (xfont_query_font): Deleted. (xfont_find_ccl_program): Renamed from x_find_ccl_program and moved from xterm.c. - (xfont_driver): Adjusted for the change of struct font_driver. + (xfont_driver): Adjust for the change of struct font_driver. (compare_font_names): New function. (xfont_list_pattern): Sort font names case insensitively. Make font_entity by calling font_make_entity. Avoid auto-scaled fonts. @@ -17272,16 +18204,16 @@ font property. Don't update dpyinfo->smallest_font_height and dpyinfo->smallest_char_width. (xfont_close): Don't free struct font. - (xfont_prepare_face): Adjusted for the change of struct font. + (xfont_prepare_face): Adjust for the change of struct font. (xfont_done_face): Deleted. - (xfont_has_char): Adjusted for the change of struct font. + (xfont_has_char): Adjust for the change of struct font. (xfont_encode_char, xfont_draw): Likewise. (xfont_check): New function. - * xftfont.c (xftfont_list): Adjusted for the change of `list' + * xftfont.c (xftfont_list): Adjust for the change of `list' callback function. - (xftfont_match): Adjusted for the format change of font-entity. - (xftfont_open): Adjusted for the format change of font-entity and + (xftfont_match): Adjust for the format change of font-entity. + (xftfont_open): Adjust for the format change of font-entity and font-object. Adjusted for the change of struct font. Return a font-object. Don't update dpyinfo->smallest_font_height and dpyinfo->smallest_char_width. @@ -17305,7 +18237,7 @@ used only when USE_FONT_BACKEND is not defined. Don't include ccl.h. (x_per_char_metric, x_encode_char): Deleted. (x_set_cursor_gc, x_set_mouse_face_gc): Don't set GCFont. - (x_compute_glyph_string_overhangs): Adjusted for the change of + (x_compute_glyph_string_overhangs): Adjust for the change of `struct face'. (x_draw_glyph_string_foreground) (x_draw_composite_glyph_string_foreground): Likewise. @@ -17317,7 +18249,7 @@ (x_font_min_bounds, x_compute_min_glyph_bounds, x_load_font) (x_query_font, x_get_font_repertory): Deleted. (x_find_ccl_program): Renamed and moved to xfont.c. - (x_redisplay_interface): Adjusted for the change of `struct + (x_redisplay_interface): Adjust for the change of `struct redisplay_interface'. * w32fns.c: Throughout the file, delete all USE_FONT_BACKEND @@ -17352,19 +18284,19 @@ Use FONT_SET_STYLE to set a style-related font property. If a font is scalable, set avgwidth property to 0. Set font-entity property by font_put_extra. - (font_matches_spec): Adjusted for the format change of font-entity. + (font_matches_spec): Adjust for the format change of font-entity. (w32_weight_table, w32_decode_weight): New variables. (w32_encode_weight): New function. - (fill_in_logfont): Adjusted for the format change of font-spec. + (fill_in_logfont): Adjust for the format change of font-spec. (w32font_full_name): Use FONT_WEIGHT_SYMBOLIC to get a symbol weight value. - (w32font_driver): Adjusted for the change of struct font_driver. + (w32font_driver): Adjust for the change of struct font_driver. * w32term.h: Throughout the file, delete all USE_FONT_BACKEND conditionals. Don't check enable_font_backend. Surround non-used code by "#ifdef OLD_FONT" and "endif". (FONT_WIDTH, FONT_HEIGHT, FONT_BASE, FONT_DESCENT) - (FONT_AVG_WIDTH): Adjusted for the change of struct font. + (FONT_AVG_WIDTH): Adjust for the change of struct font. * w32term.c: Throughout the file, delete all USE_FONT_BACKEND conditionals. Don't check enable_font_backend. Delete all codes @@ -17374,9 +18306,9 @@ * w32uniscribe.c: Delete USE_FONT_BACKEND conditional. (uniscribe_open): Return value changed to font-object. Adjusted for the format change of font-object. - (uniscribe_otf_capability): Adjusted for the change of struct font. + (uniscribe_otf_capability): Adjust for the change of struct font. (add_opentype_font_name_to_list): Don't downcase names. - (uniscribe_font_driver): Adjusted for the change of struct + (uniscribe_font_driver): Adjust for the change of struct font_driver. 2008-05-13 Chong Yidong <cyd@stupidchicken.com> @@ -19527,8 +20459,8 @@ 2008-02-01 Kenichi Handa <handa@ni.aist.go.jp> - * coding.c (decode_coding_object, encode_coding_object): Adjust - marker positions after conversion. + * coding.c (decode_coding_object, encode_coding_object): + Adjust marker positions after conversion. * lisp.h (struct Lisp_Marker): New member need_adjustment. @@ -20097,8 +21029,8 @@ 2008-02-01 Jason Rumney <jasonr@gnu.org> - * w32term.c (x_set_glyph_string_clipping): Use - get_glyph_string_clip_rects. + * w32term.c (x_set_glyph_string_clipping): + Use get_glyph_string_clip_rects. (x_set_glyph_string_clipping_exactly, x_draw_glyph_string): Adjust for the change of struct glyph_string. @@ -20109,8 +21041,8 @@ * xftfont.c (xftfont_draw): Adjust for the change of struct glyph_string. - * xterm.c (x_set_glyph_string_clipping): Use - get_glyph_string_clip_rects. + * xterm.c (x_set_glyph_string_clipping): + Use get_glyph_string_clip_rects. (x_set_glyph_string_clipping_exactly, x_draw_glyph_string): Adjust for the change of struct glyph_string. @@ -20287,8 +21219,8 @@ constant. Save QCspacing value. Save list of scripts instead of binary subranges. (w32_generic_family, logfonts_match, font_matches_spec): New functions. - (add_font_entity_to_list): Use font_callback_data struct. Filter - unwanted fonts. + (add_font_entity_to_list): Use font_callback_data struct. + Filter unwanted fonts. (add_one_font_entity_to_list): Use font_callback_data struct. (w32_registry): Default to iso10646_1. (fill_in_logfont): Use dpi from extra slot. Don't bother with @@ -20509,8 +21441,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * xterm.c (x_draw_composite_glyph_string_foreground): Fix - indexing into elements of s->cmp and s->char2b. + * xterm.c (x_draw_composite_glyph_string_foreground): + Fix indexing into elements of s->cmp and s->char2b. 2008-02-01 Juanma Barranquero <lekktu@gmail.com> @@ -20748,8 +21680,8 @@ * font.c (font_parse_fcname, font_parse_name): Don't change :name property of FONT. - (LGSTRING_HEADER_SIZE, LGSTRING_GLYPH_SIZE, check_gstring): Define - them unconditionally. + (LGSTRING_HEADER_SIZE, LGSTRING_GLYPH_SIZE, check_gstring): + Define them unconditionally. (font_matching_entity): New function. (font_open_by_name): Try font_matching_entity if exact match is not found. @@ -20794,8 +21726,8 @@ (font_prepare_composition): Set cmp->glyph_len. (font_open_entity): Set font->scalable. (Ffont_get): Handle :otf property. - (Ffont_otf_gsub, Ffont_otf_gpos, Ffont_otf_alternates): New - functions. + (Ffont_otf_gsub, Ffont_otf_gpos, Ffont_otf_alternates): + New functions. (Fquery_font): Use font->font.full_name. (syms_of_font): Defsubr Sfont_otf_gsub, Sfont_otf_gpos, and Sfont_otf_alternates. @@ -20864,8 +21796,8 @@ (font_at): New function. (Ffont_get): If FONT is a font-object, get entity from it. (Ffont_make_gstring): Initialize elements of glyphs with nil. - (Ffont_fill_gstring): Use macro LGSTRING_XXX and LGLYPH_XXX. Fix - range check. + (Ffont_fill_gstring): Use macro LGSTRING_XXX and LGLYPH_XXX. + Fix range check. (Ffont_at): New function. (syms_of_font): Defsubr Sfont_at. @@ -20896,7 +21828,7 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> * font.h (LGLYPH_XOFF, LGLYPH_YOFF, LGLYPH_WIDTH, LGLYPH_WADJUST) - (LGLYPH_SET_WIDTH): Adjusted for the change of LGLYPH format. + (LGLYPH_SET_WIDTH): Adjust for the change of LGLYPH format. (LGLYPH_ADJUSTMENT, LGLYPH_SET_ADJUSTMENT): New macros. * font.c (font_merge_old_spec): Treat '*' in foundry as a wild card. @@ -20958,8 +21890,8 @@ (font_prop_validate_extra): Delete. (font_prop_validate_spacing): New function. (font_property_table): Add elements for all known properties. - (get_font_prop_index): Rename from check_font_prop_name. New - argument FROM. Change caller. + (get_font_prop_index): Rename from check_font_prop_name. + New argument FROM. Change caller. (font_prop_validate): Validate all known properties. (font_put_extra): Delete argument force. Change caller. (font_expand_wildcards): Make it static. Fix the way of shrinking @@ -21031,8 +21963,8 @@ (font_open_for_lface, font_open_by_name): Fix handling of font size. (Ffont_spec): Add QCname property that contains only unknown properties. - * ftfont.c (ftfont_list): Use assq_no_quit, not Fassq. Don't - include weight in listing pattern, instead check weight of each + * ftfont.c (ftfont_list): Use assq_no_quit, not Fassq. + Don't include weight in listing pattern, instead check weight of each listed font. Don't include scalable in pattern. Pay attention to FONT_PIXEL_SIZE_QUANTUM. @@ -21067,8 +21999,8 @@ * font.c (XLFD_SMALLNUM_MASK): Delete this macro. (XLFD_LARGENUM_MASK): Delete XLFD_ENCODING_MASK from it. - (font_expand_wildcards): Fix handling ENCODING field. Avoid - unnecessary checks for weight, slant, and swidth. + (font_expand_wildcards): Fix handling ENCODING field. + Avoid unnecessary checks for weight, slant, and swidth. (font_parse_fcname): New function. (font_unparse_fcname): New function. (font_parse_name): New function. @@ -21302,8 +22234,8 @@ * xfns.c [USE_FONT_BACKEND]: Include "font.h". (x_default_font_parameter) [USE_FONT_BACKEND]: New function. (Fx_create_frame) [USE_FONT_BACKEND]: If enable_font_backend is - nonzero, register all available font drivers. Call - x_default_font_parameter for deciding a font. + nonzero, register all available font drivers. + Call x_default_font_parameter for deciding a font. (x_create_tip_frame) [USE_FONT_BACKEND]: Likewise. * xterm.c [USE_FONT_BACKEND]: Include "font.h". @@ -21347,8 +22279,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * coding.c (DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION): Fix - condition to terminate the loop. + * coding.c (DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION): + Fix condition to terminate the loop. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -21381,8 +22313,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * xterm.c (x_set_glyph_string_clipping_exactly): Set - src->clip_head and src->clip_tail temporarily instead of src->hl. + * xterm.c (x_set_glyph_string_clipping_exactly): + Set src->clip_head and src->clip_tail temporarily instead of src->hl. * ccl.c (CCL_WRITE_STRING): Handle a flag bit for multibyte character sequence. @@ -21414,8 +22346,8 @@ (BUILD_COMPOSITE_GLYPH_STRING): If C is TAB, set s->face to NULL. (x_produce_glyphs): If CH is TAB, set cmp->offsets properly. - * xterm.c (x_draw_composite_glyph_string_foreground): Check - s->face is NULL or not. + * xterm.c (x_draw_composite_glyph_string_foreground): + Check s->face is NULL or not. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -21465,8 +22397,8 @@ Qnil. Use JIS_TO_SJIS instead of ENCODE_SJIS. (decode_mac_font_name): Use decode_coding_c_string instead of decode_coding. - (x_load_font): Initialize fontp->fontset to -1. Set - fontp->encoding_type. + (x_load_font): Initialize fontp->fontset to -1. + Set fontp->encoding_type. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -21513,8 +22445,8 @@ (emacs${EXEEXT}): Run $(RUN_TEMACS) unconditionally. (UNIDATA): New variable. (${lispsource}international/charprop.el): Depends on ${UNIDATA}. - (bootstrap-emacs${EXEEXT}): Depends on charprop.el. Run - $(RUN_TEMACS) unconditionally. + (bootstrap-emacs${EXEEXT}): Depends on charprop.el. + Run $(RUN_TEMACS) unconditionally. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -21531,10 +22463,10 @@ * w32select.c (validate_coding_system) (setup_windows_coding_system): New functions. - (convert_to_handle_as_coded, Fw32_get_clipboard_data): Use - setup_windows_coding_system. - (setup_config, Fw32_get_clipboard_data): Use - validate_coding_system. + (convert_to_handle_as_coded, Fw32_get_clipboard_data): + Use setup_windows_coding_system. + (setup_config, Fw32_get_clipboard_data): + Use validate_coding_system. (Fx_selection_exists): Move call to setup_config to a place where signals are allowed. @@ -21616,8 +22548,8 @@ * fontset.c (fs_load_font): Use fast_string_match_ignore_case instead of fast_c_string_match_ignore_case. - (find_font_encoding): Change argument to Lisp_Object. Use - fast_string_match_ignore_case instead of + (find_font_encoding): Change argument to Lisp_Object. + Use fast_string_match_ignore_case instead of fast_c_string_match_ignore_case. Change caller. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -21644,13 +22576,13 @@ Qundecided. (Fterminal_coding_system): Return nil if terminal coding system is `undecided'. - (syms_of_coding): Define coding-system `undecided' here. Setup - terminal_coding as `undecided'. + (syms_of_coding): Define coding-system `undecided' here. + Setup terminal_coding as `undecided'. 2008-02-01 Kenichi Handa <handa@m17n.org> - * xdisp.c (message_dolog, set_message_1): Call - unibyte_char_to_multibyte with arg type int. + * xdisp.c (message_dolog, set_message_1): + Call unibyte_char_to_multibyte with arg type int. * lread.c (read1): Fix reading of a char-table. @@ -21748,8 +22680,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * coding.c (Ffind_coding_systems_region_internal): Include - raw-text and no-conversion in the result. + * coding.c (Ffind_coding_systems_region_internal): + Include raw-text and no-conversion in the result. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -21805,16 +22737,16 @@ * fontset.c: Include "intervals.h". (fontset_face): Fix comparing of Lisp_Objects. - (free_face_fontset, new_fontset_from_font_name): Fix - Lisp_Object/int mixup. + (free_face_fontset, new_fontset_from_font_name): + Fix Lisp_Object/int mixup. * editfns.c (Ftranslate_region_internal): Fix Lisp_Object/int mixup. * coding.c: Add many prototypes for static functions. (get_translation_table): Allow max_lookup to be NULL. (decode_coding, Ffind_coding_systems_region_internal) - (Funencodable_char_position, Fcheck_coding_systems_region): Call - get_translation_table with max_lookup NULL. + (Funencodable_char_position, Fcheck_coding_systems_region): + Call get_translation_table with max_lookup NULL. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -21943,8 +22875,8 @@ (Fdefine_coding_system_internal): Accept list of translation tables as :encode-translation-table and :decode-translation-table. (Fcoding_system_put): New function. - (syms_of_coding): Declare new symbols. Defsubr - Scoding_system_put. + (syms_of_coding): Declare new symbols. + Defsubr Scoding_system_put. (decode_coding_sjis, encode_coding_sjis): Handle 4th charset, typically JISX0212. @@ -22065,8 +22997,8 @@ * chartab.c (map_sub_char_table_for_charset): Fix args to c_function with. - * coding.h (enum coding_result_code): Delete - CODING_RESULT_INSUFFICIENT_CMP, add CODING_RESULT_INVALID_SRC. + * coding.h (enum coding_result_code): + Delete CODING_RESULT_INSUFFICIENT_CMP, add CODING_RESULT_INVALID_SRC. * coding.c (Qinsufficient_source, Qinconsistent_eol) (Qinvalid_source, Qinterrupted, Qinsufficient_memory): New variables. @@ -22278,8 +23210,8 @@ * w32console.c: Include character.h. Use terminal_encode_buffer from term.c. - (write_glyphs): Use new version of encode_terminal_code. Use - encode_coding_object in place of encode_coding. + (write_glyphs): Use new version of encode_terminal_code. + Use encode_coding_object in place of encode_coding. * w32bdf.c (w32_load_bdf_font): Clear font_info before filling. encoding becomes encoding_type. @@ -22303,16 +23235,16 @@ * charset.h (charset_unicode): Extern it. * charset.c (string_xstring_p): Check by (C >= 0x100). - (find_charsets_in_text): Change format of the arc CHARSETS. New - arg MULTIBYTE. + (find_charsets_in_text): Change format of the arc CHARSETS. + New arg MULTIBYTE. (Ffind_charset_region, Ffind_charset_string): Adjust for the change of find_charsets_in_text. (Fsplit_char): Fix doc. Never return unknown. * chartab.c (char_table_translate): Use CHARACTERP, not INTEGERP. - * coding.c (Fdefine_coding_system_alias): Update - Vcoding_system_list. + * coding.c (Fdefine_coding_system_alias): + Update Vcoding_system_list. * fontset.c (load_font_get_repertory): Pay attention to the case that ENCODING of a font is specified by a char-table. @@ -22322,16 +23254,16 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * term.c (encode_terminal_code): Don't handle glyph-table. Check - if a character is encodable by the terminal coding system. If - not, produces proper number of `?'s. Update + * term.c (encode_terminal_code): Don't handle glyph-table. + Check if a character is encodable by the terminal coding system. + If not, produces proper number of `?'s. Update terminal_encode_buffer and terminal_encode_buf_size if necessary. (produce_glyphs): Check by CHAR_BYTE8_P, not SINGLE_BYTE_CHAR_P. 2008-02-01 Kenichi Handa <handa@m17n.org> - * term.c (terminal_encode_buffer, terminal_encode_buf_size): New - variables. + * term.c (terminal_encode_buffer, terminal_encode_buf_size): + New variables. (encode_terminal_code): Change argument. Encode multiple characters at once. Store the result of encoding in terminal_encode_buffer. @@ -22409,8 +23341,8 @@ * casetab.c (set_case_table): Remove unused var. - * window.c (Fdisplay_buffer, Fframe_selected_window): Remove - unused vars. + * window.c (Fdisplay_buffer, Fframe_selected_window): + Remove unused vars. 2008-02-01 Dave Love <fx@gnu.org> @@ -22438,8 +23370,8 @@ (update_compositions, Ffind_composition_internal): Make buffer positions EMACS_INT. - * composite.h (find_composition, update_compositions): Make - position args EMACS_INT. + * composite.h (find_composition, update_compositions): + Make position args EMACS_INT. * keyboard.c (adjust_point_for_property): Make beg and end EMACS_INT. @@ -22463,8 +23395,8 @@ 2008-02-01 Andreas Schwab <schwab@suse.de> - * chartab.c (map_char_table, map_char_table_for_charset): Protect - `range' from GC. + * chartab.c (map_char_table, map_char_table_for_charset): + Protect `range' from GC. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -22526,8 +23458,8 @@ (re_match_2_internal): Don't check RE_TARGET_MULTIBYTE_P (bufp). It is the same as RE_MULTIBYTE_P (bufp) now. <exactn>: Translate via multibyte. - <anychar>: Fetch a character by RE_STRING_CHAR_AND_LENGTH. Don't - translate it. + <anychar>: Fetch a character by RE_STRING_CHAR_AND_LENGTH. + Don't translate it. <charset, charset_not>: Fetch a character by RE_STRING_CHAR_AND_LENGTH. Translate via multibyte. <duplicate>: Call bcmp_translate with the last arg `multibyte'. @@ -22748,8 +23680,8 @@ FONT_SPEC_INDEX. If font_spec is a string, extract the registry name by using split_font_name_into_vector. (Fnew_fontset): If no ASCII font is specified in FONTLIST, - generate a proper font name from the fontset name. Update - Vfontset_alias_alist. + generate a proper font name from the fontset name. + Update Vfontset_alias_alist. (n_auto_fontsets): New variable. (new_fontset_from_font_name): New function. (Ffont_info): Store the information about fonts generated from the @@ -22814,8 +23746,8 @@ sequence is valid in this coding system. Change callers. (MAX_ANNOTATION_LENGTH): New macro. (ADD_ANNOTATION_DATA): New macro. - (ADD_COMPOSITION_DATA): Change argument. Change callers. Call - ADD_ANNOTATION_DATA. Change the format of annotation data. + (ADD_COMPOSITION_DATA): Change argument. Change callers. + Call ADD_ANNOTATION_DATA. Change the format of annotation data. (ADD_CHARSET_DATA): New macro. (emacs_mule_char): New argument ID. Change callers. (decode_coding_emacs_mule, decode_coding_iso_2022) @@ -22829,8 +23761,8 @@ (produce_composition): Adjust for the new annotation data format. (produce_charset): New function. (produce_annotation): Handle charset annotation. - (handle_composition_annotation, handle_charset_annotation): New - functions. + (handle_composition_annotation, handle_charset_annotation): + New functions. (consume_chars): Handle charset annotation. Utilize the above two functions. (encode_coding_object): If SRC_OBJECT and DST_OBJECT are the same @@ -22960,8 +23892,8 @@ * coding.c (detect_coding_charset): If only ASCII bytes are found, return 0. - (Fdefine_coding_system_internal): Setup - CODING_ATTR_ASCII_COMPAT (attrs) correctly. + (Fdefine_coding_system_internal): + Setup CODING_ATTR_ASCII_COMPAT (attrs) correctly. 2008-02-01 Dave Love <fx@gnu.org> @@ -22971,8 +23903,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * coding.c (decode_coding): Fix args to translate_chars. Pay - attention to Vstandard_translation_table_for_decode. + * coding.c (decode_coding): Fix args to translate_chars. + Pay attention to Vstandard_translation_table_for_decode. (encode_coding): Fix args to translate_chars. Pay attention to Vstandard_translation_table_for_encode. @@ -23022,8 +23954,8 @@ * character.h (CHAR_STRING, CHAR_STRING_ADVANCE): Call char_string if C is greater than MAX_3_BYTE_CHAR. - (STRING_CHAR, STRING_CHAR_AND_LENGTH, STRING_CHAR_ADVANCE): Call - string_char instead of string_char_with_unification. + (STRING_CHAR, STRING_CHAR_AND_LENGTH, STRING_CHAR_ADVANCE): + Call string_char instead of string_char_with_unification. 2008-02-01 Dave Love <fx@gnu.org> @@ -23081,8 +24013,8 @@ * keyboard.c (read_key_sequence): Fix type error. - * buffer.c (Fset_buffer_multibyte, Fset_buffer_multibyte): Fix - type error. + * buffer.c (Fset_buffer_multibyte, Fset_buffer_multibyte): + Fix type error. * fontset.c (fontset_add): Return Lisp_Object. @@ -23134,8 +24066,8 @@ * regex.h (struct re_pattern_buffer): New member target_multibyte. * regex.c (RE_TARGET_MULTIBYTE_P): New macro. - (GET_CHAR_BEFORE_2): Check target_multibyte, not multibyte. If - that is zero, convert an eight-bit char to multibyte. + (GET_CHAR_BEFORE_2): Check target_multibyte, not multibyte. + If that is zero, convert an eight-bit char to multibyte. (MAKE_CHAR_MULTIBYTE, CHAR_LEADING_CODE): New dummy new macros for non-emacs case. (PATFETCH): Convert an eight-bit char to multibyte. @@ -23154,14 +24086,14 @@ multibyte always 1. (re_search_2): In emacs, set the locale variable multibyte to 1, otherwise to 0. New local variable target_multibyte. Check it - to decide the multibyteness of STR1 and STR2. If - target_multibyte is zero, convert unibyte chars to multibyte + to decide the multibyteness of STR1 and STR2. + If target_multibyte is zero, convert unibyte chars to multibyte before translating and checking fastmap. (TARGET_CHAR_AND_LENGTH): New macro. (re_match_2_internal): In emacs, set the locale variable multibyte - to 1, otherwise to 0. New local variable target_multibyte. Check - it to decide the multibyteness of STR1 and STR2. Use - TARGET_CHAR_AND_LENGTH to fetch a character from D. + to 1, otherwise to 0. New local variable target_multibyte. + Check it to decide the multibyteness of STR1 and STR2. + Use TARGET_CHAR_AND_LENGTH to fetch a character from D. <charset, charset_not>: If multibyte is nonzero, check fastmap only for ASCII chars. Call bcmp_translate with target_multibyte, not with multibyte. @@ -23369,8 +24301,8 @@ * lisp.h (Fset_buffer_multibyte): Adjust prototype. - * xdisp.c (setup_echo_area_for_printing, set_message_1): Adjust - for the change of Fset_buffer_multibyte. + * xdisp.c (setup_echo_area_for_printing, set_message_1): + Adjust for the change of Fset_buffer_multibyte. * fns.c (Fstring_to_multibyte): New function. (syms_of_fns): Declare Fstring_to_multibyte as Lisp subroutine. @@ -23465,11 +24397,11 @@ (find_font_encoding): New function. (list_fontsets): Use STRINGP, not ! NILP. (accumulate_script_ranges): New function. - (Fset_fontset_font, Fnew_fontset, Ffontset_info): Completely - re-written to handle new fontset structure. + (Fset_fontset_font, Fnew_fontset, Ffontset_info): + Completely re-written to handle new fontset structure. (Ffontset_font): Return a copy of element. - (syms_of_fontset): Define symbols Qprepend and Qappend. Fix - docstring of font-encoding-alist. + (syms_of_fontset): Define symbols Qprepend and Qappend. + Fix docstring of font-encoding-alist. * lisp.h (CHAR_TABLE_REF): Remove unnecessary check (IDX >= 0). (Fset_fotset_font): Fix arguments to 5. @@ -23559,8 +24491,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * xdisp.c (face_before_or_after_it_pos): Call - FETCH_MULTIBYTE_CHAR with byte postion, not char position. + * xdisp.c (face_before_or_after_it_pos): + Call FETCH_MULTIBYTE_CHAR with byte postion, not char position. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -23588,8 +24520,8 @@ deunify instead of unify a charset. (string_xstring_p): Add `const' to local variables. (find_charsets_in_text): Add `const' to arguments and local variables. - (encode_char): Adjust for the change of Funify_charset. Fix - detecting of invalid code. + (encode_char): Adjust for the change of Funify_charset. + Fix detecting of invalid code. (Fset_charset_priority): Increment charset_ordered_list_tick. (Fmap_charset_chars): Fix handling of default value for FROM_CODE and TO_CODE. @@ -23622,8 +24554,8 @@ 2008-02-01 Dave Love <fx@gnu.org> - * casetab.c (init_casetab_once, init_casetab_once): Fix - CHAR_TABLE_SET call. + * casetab.c (init_casetab_once, init_casetab_once): + Fix CHAR_TABLE_SET call. * category.c (Fmodify_category_entry): Fix CATEGORY_MEMBER call. @@ -23698,8 +24630,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> * category.c (Fmodify_category_entry): Don't modify the contents - of category_set for characters out of the range. Avoid - unnecessary modification. + of category_set for characters out of the range. + Avoid unnecessary modification. * character.h (MAYBE_UNIFY_CHAR): Adjust for the change of Vchar_unify_table. The default value of the table is now nil. @@ -23707,8 +24639,8 @@ * character.c (syms_of_character): Setup Vchar_width_table for eight-bit-control and raw-byte chars. - * charset.h (enum define_charset_arg_index): Delete - charset_arg_parents and add charset_arg_subset and + * charset.h (enum define_charset_arg_index): + Delete charset_arg_parents and add charset_arg_subset and charset_arg_superset. (enum charset_attr_index): Delete charset_parents and add charset_subset and charset_superset. @@ -23724,8 +24656,8 @@ * charset.c (load_charset_map): Set the default value of encoder and deunifier char-tables to nil. - (map_charset_chars): Change argument. Change callers. Use - map_char_table_for_charset instead of map_char_table. + (map_charset_chars): Change argument. Change callers. + Use map_char_table_for_charset instead of map_char_table. (Fmap_charset_chars): New optional args from_code and to_code. (Fdefine_charset_internal): Adjust for the change of `define-charset' (:parents -> :subset or :superset). @@ -23734,8 +24666,8 @@ Fdefine_charset_internal. (Ffind_charset_string): Setup the vector `charsets' correctly. - * chartab.c (sub_char_table_ref_and_range): New arg default. Fix - the previous change. + * chartab.c (sub_char_table_ref_and_range): New arg default. + Fix the previous change. (char_table_ref_and_range): Adjust for the above change. (map_sub_char_table_for_charset): New function. (map_char_table_for_charset): New function. @@ -23878,8 +24810,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> * coding.c (ONE_MORE_BYTE_NO_CHECK): Increment consumed_chars. - (emacs_mule_char): New arg src. Delete arg `composition'. Change - caller. Handle 2-byte and 3-byte charsets correctly. + (emacs_mule_char): New arg src. Delete arg `composition'. + Change caller. Handle 2-byte and 3-byte charsets correctly. (DECODE_EMACS_MULE_COMPOSITION_RULE_20): Rename from DECODE_EMACS_MULE_COMPOSITION_RULE. Change caller. (DECODE_EMACS_MULE_COMPOSITION_RULE_21): New macro. @@ -23924,8 +24856,8 @@ * character.h (string_escape_byte8): Declare. - * charset.c (load_charset_map, load_charset_map_from_file): Remove - unused vars. + * charset.c (load_charset_map, load_charset_map_from_file): + Remove unused vars. (Fdefine_charset_internal, Fsplit_char, syms_of_charset) (Fmap_charset_chars): Doc fix. @@ -23996,8 +24928,8 @@ * coding.c (coding_set_source): Delete the local variable beg_byte. (encode_coding_charset, Fdefine_coding_system_internal): Delete the local variable charset. - (Fdefine_coding_system_internal): Setup - attrs[coding_attr_charset_valids] correctly. + (Fdefine_coding_system_internal): + Setup attrs[coding_attr_charset_valids] correctly. * charset.c (CODE_POINT_TO_INDEX): Utilize `code_space_mask' member to check if CODE is valid or not. @@ -24019,8 +24951,8 @@ 2008-02-01 Kenichi Handa <handa@m17n.org> - * coding.c (decode_coding_charset, encode_coding_charset): Handle - multiple charsets correctly. + * coding.c (decode_coding_charset, encode_coding_charset): + Handle multiple charsets correctly. 2008-02-01 Kenichi Handa <handa@m17n.org> @@ -28193,10 +29125,10 @@ See ChangeLog.10 for earlier changes. ;; Local Variables: ;; coding: utf-8 -;; add-log-time-zone-rule: t ;; End: - Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -28213,4 +29145,3 @@ See ChangeLog.10 for earlier changes. 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: dfb6ad96-1550-4905-9e53-d2059ee84c40 diff --git a/src/Makefile.in b/src/Makefile.in index 0d496aea73a..61b42f17030 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -1,5 +1,5 @@ +# src/Makefile for GNU Emacs. -# Makefile for GNU Emacs. # Copyright (C) 1985, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 # Free Software Foundation, Inc. @@ -54,8 +54,8 @@ lwlibdir = ../lwlib lispdir = ../lisp # Configuration files for .o files to depend on. -M_FILE = $(srcdir)/@machfile@ -S_FILE = $(srcdir)/@opsysfile@ +M_FILE = @M_FILE@ +S_FILE = @S_FILE@ config_h = config.h $(M_FILE) $(S_FILE) bootstrap_exe = $(abs_builddir)/bootstrap-emacs$(EXEEXT) @@ -177,7 +177,7 @@ OLDXMENU_TARGET=@OLDXMENU_TARGET@ ## If !HAVE_X11 || USE_GTK, empty. ## Else if USE_X_TOOLKIT, $(lwlibdir)/liblw.a. -## Else $(oldxmenudir)/libXMenu11.a. +## Else $(oldXMenudir)/libXMenu11.a. ## (Actually, rather than being empty, it is set to "nothing". ## It is never actually used for anything in this case. ## This is done because there is a rule with target $(OLDXMENU) below, @@ -575,23 +575,22 @@ shortlisp= \ ## Like $shortlisp, but includes only those files from $lisp that are loaded ## conditionally (i.e., only on some platforms). +## Confusingly, term/internal is not in loadup, but is unconditionally +## loaded by pc-win, which is. SOME_MACHINE_LISP = ../lisp/mouse.elc \ ../lisp/select.elc ../lisp/scroll-bar.elc \ ../lisp/ls-lisp.elc ../lisp/dos-fns.elc \ ../lisp/w32-fns.elc ../lisp/dos-w32.elc \ - ../lisp/disp-table.elc ../lisp/dos-vars.elc \ + ../lisp/disp-table.elc ../lisp/dos-vars.elc ../lisp/w32-vars.elc \ ../lisp/tooltip.elc ../lisp/image.elc \ ../lisp/fringe.elc ../lisp/dnd.elc \ ../lisp/mwheel.elc ../lisp/tool-bar.elc \ ../lisp/x-dnd.elc ../lisp/dynamic-setting.elc \ - ../lisp/international/ccl.elc \ ../lisp/international/fontset.elc \ - ../lisp/mouse.elc \ ../lisp/term/common-win.elc \ ../lisp/term/x-win.elc \ ../lisp/term/pc-win.elc ../lisp/term/internal.elc \ - ../lisp/term/ns-win.elc ../lisp/term/w32-win.elc \ - ../lisp/emacs-lisp/easymenu.elc + ../lisp/term/ns-win.elc ../lisp/term/w32-win.elc ## Construct full set of libraries to be linked. ## Note that SunOS needs -lm to come before -lc; otherwise, you get diff --git a/src/alloc.c b/src/alloc.c index 0f83f375d40..b18fd6feb3d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -351,7 +351,6 @@ enum mem_type static POINTER_TYPE *lisp_align_malloc (size_t, enum mem_type); static POINTER_TYPE *lisp_malloc (size_t, enum mem_type); -void refill_memory_reserve (void); #if GC_MARK_STACK || defined GC_MALLOC_CHECK @@ -4043,8 +4042,14 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", static INLINE void mark_maybe_object (Lisp_Object obj) { - void *po = (void *) XPNTR (obj); - struct mem_node *m = mem_find (po); + void *po; + struct mem_node *m; + + if (INTEGERP (obj)) + return; + + po = (void *) XPNTR (obj); + m = mem_find (po); if (m != MEM_NIL) { @@ -5694,13 +5699,14 @@ mark_terminals (void) for (t = terminal_list; t; t = t->next_terminal) { eassert (t->name != NULL); - if (!VECTOR_MARKED_P (t)) - { #ifdef HAVE_WINDOW_SYSTEM - mark_image_cache (t->image_cache); + /* If a terminal object is reachable from a stacpro'ed object, + it might have been marked already. Make sure the image cache + gets marked. */ + mark_image_cache (t->image_cache); #endif /* HAVE_WINDOW_SYSTEM */ - mark_vectorlike ((struct Lisp_Vector *)t); - } + if (!VECTOR_MARKED_P (t)) + mark_vectorlike ((struct Lisp_Vector *)t); } } diff --git a/src/atimer.c b/src/atimer.c index 9fd9dee835e..6258908e0b2 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -171,9 +171,9 @@ cancel_atimer (struct atimer *timer) for (t = *list, prev = NULL; t && t != timer; prev = t, t = t->next) ; - /* If it is, take it off the its list, and put in on the - free-list. We don't bother to arrange for setting a - different alarm time, since a too early one doesn't hurt. */ + /* If it is, take it off its list, and put in on the free-list. + We don't bother to arrange for setting a different alarm time, + since a too early one doesn't hurt. */ if (t) { if (prev) diff --git a/src/buffer.c b/src/buffer.c index 3eb96beeb0f..8f8bfb54a21 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1,8 +1,8 @@ /* Buffer manipulation primitives for GNU Emacs. - Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, - 1995, 1997, 1998, 1999, 2000, 2001, 2002, - 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, + 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, + 2009, 2010 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -5601,7 +5601,8 @@ Format with `format-mode-line' to produce a string value. */); doc: /* Local (mode-specific) abbrev table of current buffer. */); DEFVAR_PER_BUFFER ("abbrev-mode", ¤t_buffer->abbrev_mode, Qnil, - doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */); + doc: /* Non-nil if Abbrev mode is enabled. +Use the command `abbrev-mode' to change this variable. */); DEFVAR_PER_BUFFER ("case-fold-search", ¤t_buffer->case_fold_search, Qnil, @@ -6099,11 +6100,23 @@ to the value obtained by calling `current-time'. If the buffer has never been shown in a window, the value is nil. */); DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode, - doc: /* */); + doc: /* Non-nil if Transient Mark mode is enabled. +See the command `transient-mark-mode' for a description of this minor mode. + +Non-nil also enables highlighting of the region whenever the mark is active. +The variable `highlight-nonselected-windows' controls whether to highlight +all windows or just the selected window. + +If the value is `lambda', that enables Transient Mark mode temporarily. +After any subsequent action that would normally deactivate the mark +\(such as buffer modification), Transient Mark mode is turned off. + +If the value is (only . OLDVAL), that enables Transient Mark mode +temporarily. After any subsequent point motion command that is not +shift-translated, or any other action that would normally deactivate +the mark (such as buffer modification), the value of +`transient-mark-mode' is set to OLDVAL. */); Vtransient_mark_mode = Qnil; - /* The docstring is in simple.el. If we put it here, it would be - overwritten when transient-mark-mode is defined using - define-minor-mode. */ DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only, doc: /* *Non-nil means disregard read-only status of buffers or characters. @@ -6141,8 +6154,12 @@ to the default frame line height. A value of nil means add no extra space. */) DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows", ¤t_buffer->cursor_in_non_selected_windows, Qnil, - doc: /* *Cursor type to display in non-selected windows. -The value t means to use hollow box cursor. See `cursor-type' for other values. */); + doc: /* *Non-nil means show a cursor in non-selected windows. +If nil, only shows a cursor in the selected window. +If t, displays a cursor related to the usual cursor type +\(a solid box becomes hollow, a bar becomes a narrower bar). +You can also specify the cursor type as in the `cursor-type' variable. +Use Custom to set this variable and update the display." */); DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions, doc: /* List of functions called with no args to query before killing a buffer. @@ -6219,5 +6236,3 @@ keys_of_buffer (void) Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt); } -/* arch-tag: e48569bf-69a9-4b65-a23b-8e68769436e1 - (do not change this comment) */ diff --git a/src/buffer.h b/src/buffer.h index 3a4dd106360..79acd16b6fd 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1,7 +1,8 @@ /* Header file for the buffer manipulation primitives. - Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, - 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, + 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -226,10 +227,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ (temp_set_point ((buffer), (position))) extern void set_point (EMACS_INT); -extern INLINE void temp_set_point (struct buffer *, EMACS_INT); +extern void temp_set_point (struct buffer *, EMACS_INT); extern void set_point_both (EMACS_INT, EMACS_INT); -extern INLINE void temp_set_point_both (struct buffer *, - EMACS_INT, EMACS_INT); +extern void temp_set_point_both (struct buffer *, + EMACS_INT, EMACS_INT); extern void enlarge_buffer_text (struct buffer *, EMACS_INT); @@ -459,7 +460,7 @@ struct buffer_text struct Lisp_Marker *markers; /* Usually 0. Temporarily set to 1 in decode_coding_gap to - prevent Fgarbage_collect from shrinking the gap and loosing + prevent Fgarbage_collect from shrinking the gap and losing not-yet-decoded bytes. */ int inhibit_shrinking; }; @@ -1019,5 +1020,3 @@ extern int last_per_buffer_idx; #define PER_BUFFER_VALUE(BUFFER, OFFSET) \ (*(Lisp_Object *)((OFFSET) + (char *) (BUFFER))) -/* arch-tag: 679305dd-d41c-4a50-b170-3caf5c97b2d1 - (do not change this comment) */ diff --git a/src/callproc.c b/src/callproc.c index ee0872b5562..59067040fd9 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1154,6 +1154,14 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L #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 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L 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 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L 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 @@ -1519,7 +1516,7 @@ void syms_of_callproc (void) { #ifdef DOS_NT - Qbuffer_file_type = intern ("buffer-file-type"); + Qbuffer_file_type = intern_c_string ("buffer-file-type"); staticpro (&Qbuffer_file_type); #endif /* DOS_NT */ @@ -1609,5 +1606,3 @@ See `setenv' and `getenv'. */); defsubr (&Scall_process_region); } -/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95 - (do not change this comment) */ diff --git a/src/charset.c b/src/charset.c index 0ab776b6914..39a376a947f 100644 --- a/src/charset.c +++ b/src/charset.c @@ -114,7 +114,7 @@ Lisp_Object Viso_2022_charset_list; /* List of emacs-mule charsets. */ Lisp_Object Vemacs_mule_charset_list; -struct charset *emacs_mule_charset[256]; +int emacs_mule_charset[256]; /* Mapping table from ISO2022's charset (specified by DIMENSION, CHARS, and FINAL-CHAR) to Emacs' charset. */ @@ -1210,7 +1210,7 @@ usage: (define-charset-internal ...) */) if (charset.emacs_mule_id >= 0) { - emacs_mule_charset[charset.emacs_mule_id] = CHARSET_FROM_ID (id); + emacs_mule_charset[charset.emacs_mule_id] = id; if (charset.emacs_mule_id < 0xA0) emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 1; else @@ -2330,7 +2330,7 @@ init_charset_once (void) iso_charset_table[i][j][k] = -1; for (i = 0; i < 256; i++) - emacs_mule_charset[i] = NULL; + emacs_mule_charset[i] = -1; charset_jisx0201_roman = -1; charset_jisx0208_1978 = -1; diff --git a/src/charset.h b/src/charset.h index dbe9c776a0d..6e6422f3c73 100644 --- a/src/charset.h +++ b/src/charset.h @@ -255,7 +255,7 @@ extern Lisp_Object Vcharset_list; extern Lisp_Object Viso_2022_charset_list; extern Lisp_Object Vemacs_mule_charset_list; -extern struct charset *emacs_mule_charset[256]; +extern int emacs_mule_charset[256]; extern Lisp_Object Vcurrent_iso639_language; diff --git a/src/cmds.c b/src/cmds.c index e12d7c370d9..b2f454199f5 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -230,7 +230,7 @@ Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). Interactively, N is the prefix arg, and KILLFLAG is set if N was explicitly specified. -The command `delete-forward' is preferable for interactive use. */) +The command `delete-forward-char' is preferable for interactive use. */) (Lisp_Object n, Lisp_Object killflag) { EMACS_INT pos; @@ -276,7 +276,7 @@ After insertion, the value of `auto-fill-function' is called if the (Lisp_Object n) { int remove_boundary = 1; - CHECK_NUMBER (n); + CHECK_NATNUM (n); if (!EQ (Vthis_command, current_kboard->Vlast_command)) nonundocount = 0; @@ -453,7 +453,7 @@ internal_self_insert (int c, EMACS_INT n) && SINGLE_BYTE_CHAR_P (c)) ? UNIBYTE_TO_CHAR (c) : c); Lisp_Object string = Fmake_string (make_number (n), make_number (mc)); - + if (spaces_to_insert) { tem = Fmake_string (make_number (spaces_to_insert), @@ -474,7 +474,7 @@ internal_self_insert (int c, EMACS_INT n) insert_and_inherit (strn, p - strn); SAFE_FREE (); } - else + else if (n > 0) insert_and_inherit (str, len); if ((CHAR_TABLE_P (Vauto_fill_chars) diff --git a/src/coding.c b/src/coding.c index 7a3bc40b9c7..a7b7c7d6b23 100644 --- a/src/coding.c +++ b/src/coding.c @@ -2053,7 +2053,7 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src, const unsigned char *src_end = coding->source + coding->src_bytes; const unsigned char *src_base = src; int multibytep = coding->src_multibyte; - struct charset *charset; + int charset_id; unsigned code; int c; int consumed_chars = 0; @@ -2063,7 +2063,7 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src, if (c < 0) { c = -c; - charset = emacs_mule_charset[0]; + charset_id = emacs_mule_charset[0]; } else { @@ -2099,7 +2099,7 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src, switch (emacs_mule_bytes[c]) { case 2: - if (! (charset = emacs_mule_charset[c])) + if ((charset_id = emacs_mule_charset[c]) < 0) goto invalid_code; ONE_MORE_BYTE (c); if (c < 0xA0) @@ -2112,7 +2112,7 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src, || c == EMACS_MULE_LEADING_CODE_PRIVATE_12) { ONE_MORE_BYTE (c); - if (c < 0xA0 || ! (charset = emacs_mule_charset[c])) + if (c < 0xA0 || (charset_id = emacs_mule_charset[c]) < 0) goto invalid_code; ONE_MORE_BYTE (c); if (c < 0xA0) @@ -2121,7 +2121,7 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src, } else { - if (! (charset = emacs_mule_charset[c])) + if ((charset_id = emacs_mule_charset[c]) < 0) goto invalid_code; ONE_MORE_BYTE (c); if (c < 0xA0) @@ -2136,7 +2136,7 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src, case 4: ONE_MORE_BYTE (c); - if (c < 0 || ! (charset = emacs_mule_charset[c])) + if (c < 0 || (charset_id = emacs_mule_charset[c]) < 0) goto invalid_code; ONE_MORE_BYTE (c); if (c < 0xA0) @@ -2150,21 +2150,21 @@ emacs_mule_char (struct coding_system *coding, const unsigned char *src, case 1: code = c; - charset = CHARSET_FROM_ID (ASCII_BYTE_P (code) - ? charset_ascii : charset_eight_bit); + charset_id = ASCII_BYTE_P (code) ? charset_ascii : charset_eight_bit; break; default: abort (); } - CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, code, c); + CODING_DECODE_CHAR (coding, src, src_base, src_end, + CHARSET_FROM_ID (charset_id), code, c); if (c < 0) goto invalid_code; } *nbytes = src - src_base; *nchars = consumed_chars; if (id) - *id = charset->id; + *id = charset_id; return (mseq_found ? -c : c); no_more_source: @@ -9297,7 +9297,8 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern doc: /* Internal use only. */) (Lisp_Object coding_system, Lisp_Object terminal) { - struct coding_system *terminal_coding = TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1)); + struct terminal *term = get_terminal (terminal, 1); + struct coding_system *terminal_coding = TERMINAL_TERMINAL_CODING (term); CHECK_SYMBOL (coding_system); setup_coding_system (Fcheck_coding_system (coding_system), terminal_coding); /* We had better not send unsafe characters to terminal. */ @@ -9306,6 +9307,10 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK; terminal_coding->src_multibyte = 1; terminal_coding->dst_multibyte = 0; + if (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK) + term->charset_list = coding_charset_list (terminal_coding); + else + term->charset_list = Fcons (make_number (charset_ascii), Qnil); return Qnil; } @@ -10554,7 +10559,7 @@ associated with each coding-category one by one in this order. When one algorithm agrees with a byte sequence of source text, the coding system bound to the corresponding coding-category is selected. -Don't modify this variable directly, but use `set-coding-priority'. */); +Don't modify this variable directly, but use `set-coding-system-priority'. */); { int i; diff --git a/src/config.in b/src/config.in index add2ac73d55..105f343870c 100644 --- a/src/config.in +++ b/src/config.in @@ -294,6 +294,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the `gtk_widget_set_has_window' function. */ #undef HAVE_GTK_WIDGET_SET_HAS_WINDOW +/* Define to 1 if you have the `g_type_init' function. */ +#undef HAVE_G_TYPE_INIT + /* Define to 1 if netdb.h declares h_errno. */ #undef HAVE_H_ERRNO @@ -660,9 +663,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the `sysinfo' function. */ #undef HAVE_SYSINFO -/* Define to 1 if you have the <sys/ioctl.h> header file. */ -#undef HAVE_SYS_IOCTL_H - /* Define to 1 if you have the <sys/mman.h> header file. */ #undef HAVE_SYS_MMAN_H @@ -687,9 +687,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* 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 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* 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,6 +1053,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* 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 @@ -1079,7 +1076,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Don't try to switch on inline handling as detected by AC_C_INLINE generally, because even if non-gcc compilers accept `inline', they may reject `extern inline'. */ -#if defined (__GNUC__) && defined (OPTIMIZE) +#if defined (__GNUC__) #define INLINE __inline__ #else #define INLINE @@ -1095,19 +1092,18 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Include the os and machine dependent files. */ #include config_opsysfile -#include config_machfile - -/* Set up some defines, C and LD flags for NeXTstep interface on GNUstep. - (There is probably a better place to do this, but right now the Cocoa - side does this in s/darwin.h and we cannot - parallel this exactly since GNUstep is multi-OS. */ -#ifdef HAVE_NS -# ifdef NS_IMPL_GNUSTEP +#ifdef config_machfile +# include config_machfile +#endif + /* GNUstep needs a bit more pure memory. Of the existing knobs, -SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */ + SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. + (There is probably a better place to do this, but right now the + Cocoa side does this in s/darwin.h and we cannot parallel this + exactly since GNUstep is multi-OS. */ +#if defined HAVE_NS && defined NS_IMPL_GNUSTEP # define SYSTEM_PURESIZE_EXTRA 30000 -# endif /* NS_IMPL_GNUSTEP */ -#endif /* HAVE_NS */ +#endif /* SIGTYPE is the macro we actually use. */ #ifndef SIGTYPE @@ -1206,6 +1202,12 @@ typedef unsigned size_t; #define NO_INLINE #endif +#if (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1)) +#define EXTERNALLY_VISIBLE __attribute__((externally_visible)) +#else +#define EXTERNALLY_VISIBLE +#endif + /* Some versions of GNU/Linux define noinline in their headers. */ #ifdef noinline #undef noinline diff --git a/src/data.c b/src/data.c index 78ccb75ca89..924a717cf3d 100644 --- a/src/data.c +++ b/src/data.c @@ -135,21 +135,6 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) 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 */ diff --git a/src/dbusbind.c b/src/dbusbind.c index 683b7cb583b..6ab976b58da 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -57,6 +57,9 @@ Lisp_Object QCdbus_type_int32, QCdbus_type_uint32; 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 @@ int xd_in_read_queued_messages = 0; #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 @@ int xd_in_read_queued_messages = 0; || (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 @@ xd_symbol_to_dbus_type (Lisp_Object object) : (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 @@ xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lis 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 @@ xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter) } 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 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter) } 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 @@ input arguments. It follows the mapping rules: 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 @@ syms_of_dbusbind (void) 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); diff --git a/src/dispextern.h b/src/dispextern.h index 20e074d2393..7426c03b5ec 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -69,6 +69,11 @@ typedef Pixmap XImagePtr; typedef XImagePtr XImagePtr_or_DC; #endif +#ifndef HAVE_WINDOW_SYSTEM +typedef int Cursor; +#define No_Cursor (0) +#endif + #ifndef NativeRectangle #define NativeRectangle int #endif @@ -279,6 +284,9 @@ enum glyph_type /* Glyph describes a static composition. */ COMPOSITE_GLYPH, + /* Glyph describes a glyphless character. */ + GLYPHLESS_GLYPH, + /* Glyph describes an image. */ IMAGE_GLYPH, @@ -333,7 +341,7 @@ struct glyph /* Which kind of glyph this is---character, image etc. Value should be an enumerator of type enum glyph_type. */ - unsigned type : 2; + unsigned type : 3; /* 1 means this glyph was produced from multibyte text. Zero means it was produced from unibyte text, i.e. charsets aren't @@ -363,12 +371,11 @@ struct glyph 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; @@ -402,6 +409,11 @@ struct glyph /* Start and end indices of glyphs of a graphme cluster of a composition (type == COMPOSITE_GLYPH). */ struct { int from, to; } cmp; + /* Pixel offsets for upper and lower part of the acronym. */ + struct { + short upper_xoff, upper_yoff; + short lower_xoff, lower_yoff; + } glyphless; } slice; /* A union of sub-structures for different glyph types. */ @@ -433,6 +445,19 @@ struct glyph } stretch; + /* Sub-stretch for type == GLYPHLESS_GLYPH. */ + struct + { + /* Value is an enum of the type glyphless_display_method. */ + unsigned method : 2; + /* 1 iff this glyph is for a character of no font. */ + unsigned for_no_font : 1; + /* Length of acronym or hexadecimal code string (at most 8). */ + unsigned len : 4; + /* Character to display. Actually we need only 22 bits. */ + unsigned ch : 26; + } glyphless; + /* Used to compare all bit-fields above in one step. */ unsigned val; } u; @@ -1918,6 +1943,9 @@ enum display_element_type /* A composition (static and automatic). */ IT_COMPOSITION, + /* A glyphless character (e.g. ZWNJ, LRE). */ + IT_GLYPHLESS, + /* An image. */ IT_IMAGE, @@ -1964,6 +1992,21 @@ enum line_wrap_method WINDOW_WRAP }; +/* An enumerator for the method of displaying glyphless characters. */ + +enum glyphless_display_method + { + /* 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 the hexadecimal code of the character in a box. */ + GLYPHLESS_DISPLAY_HEX_CODE + }; + struct it_slice { Lisp_Object x; @@ -2295,6 +2338,10 @@ struct it PRODUCE_GLYPHS, this should be set beforehand too. */ int char_to_display; + /* If what == IT_GLYPHLESS, the method to display such a + character. */ + enum glyphless_display_method glyphless_method; + /* If what == IT_IMAGE, the id of the image to display. */ int image_id; @@ -2840,6 +2887,9 @@ enum tool_bar_item_idx /* Label to show when text labels are enabled. */ TOOL_BAR_ITEM_LABEL, + /* If we shall show the label only below the icon and not beside it. */ + TOOL_BAR_ITEM_VERT_ONLY, + /* Sentinel = number of slots in tool_bar_items occupied by one tool-bar item. */ TOOL_BAR_ITEM_NSLOTS @@ -2976,9 +3026,10 @@ extern int last_tool_bar_item; extern Lisp_Object Vmouse_autoselect_window; extern int unibyte_display_via_language_environment; extern EMACS_INT underline_minimum_offset; +extern Lisp_Object Vglyphless_char_display; extern void reseat_at_previous_visible_line_start (struct it *); - +extern Lisp_Object lookup_glyphless_char_display (int, struct it *); extern int calc_pixel_width_or_height (double *, struct it *, Lisp_Object, struct font *, int, int *); @@ -3017,28 +3068,31 @@ extern void x_update_cursor (struct frame *, int); extern void x_clear_cursor (struct window *); extern void x_draw_vertical_border (struct window *w); -extern void frame_to_window_pixel_xy (struct window *, int *, int *); extern int get_glyph_string_clip_rects (struct glyph_string *, NativeRectangle *, int); extern void get_glyph_string_clip_rect (struct glyph_string *, NativeRectangle *nr); extern Lisp_Object find_hot_spot (Lisp_Object, int, int); -extern void note_mouse_highlight (struct frame *, int, int); -extern void x_clear_window_mouse_face (struct window *); -extern void cancel_mouse_face (struct frame *); extern void handle_tool_bar_click (struct frame *, int, int, int, unsigned int); -/* msdos.c defines its own versions of these functions. */ -extern int clear_mouse_face (Display_Info *); -extern void show_mouse_face (Display_Info *, enum draw_glyphs_face); -extern int cursor_in_mouse_face_p (struct window *w); - extern void expose_frame (struct frame *, int, int, int, int); extern int x_intersect_rectangles (XRectangle *, XRectangle *, XRectangle *); -#endif +#endif /* HAVE_WINDOW_SYSTEM */ + +extern void frame_to_window_pixel_xy (struct window *, int *, int *); +extern void note_mouse_highlight (struct frame *, int, int); +extern void x_clear_window_mouse_face (struct window *); +extern void cancel_mouse_face (struct frame *); +extern int clear_mouse_face (Mouse_HLInfo *); +extern void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face); +extern int cursor_in_mouse_face_p (struct window *w); +extern void draw_row_with_mouse_face (struct window *, int, struct glyph_row *, + int, int, enum draw_glyphs_face); +extern void tty_draw_row_with_mouse_face (struct window *, struct glyph_row *, + int, int, enum draw_glyphs_face); /* Flags passed to try_window. */ #define TRY_WINDOW_CHECK_MARGINS (1 << 0) @@ -3124,7 +3178,6 @@ char *choose_face_font (struct frame *, Lisp_Object *, Lisp_Object, int ascii_face_of_lisp_face (struct frame *, int); void prepare_face_for_display (struct frame *, struct face *); int xstrcasecmp (const unsigned char *, const unsigned char *); -int lookup_face (struct frame *, Lisp_Object *); int lookup_named_face (struct frame *, Lisp_Object, int); int lookup_basic_face (struct frame *, int); int smaller_face (struct frame *, int, int); diff --git a/src/dispnew.c b/src/dispnew.c index f9729fc28cb..5d4ce012530 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -1180,7 +1180,7 @@ swap_glyph_pointers (struct glyph_row *a, struct glyph_row *b) /* Copy glyph row structure FROM to glyph row structure TO, except that glyph pointers in the structures are left unchanged. */ -INLINE void +static INLINE void copy_row_except_pointers (struct glyph_row *to, struct glyph_row *from) { struct glyph *pointers[1 + LAST_AREA]; @@ -2893,6 +2893,14 @@ mirror_make_current (struct window *w, int frame_row) else swap_glyph_pointers (desired_row, current_row); current_row->enabled_p = 1; + + /* Set the Y coordinate of the mode/header line's row. + It is needed in draw_row_with_mouse_face to find the + screen coordinates. (Window-based redisplay sets + this in update_window, but no one seems to do that + for frame-based redisplay.) */ + if (current_row->mode_line_p) + current_row->y = row; } } @@ -5385,7 +5393,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p 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 @@ -6416,6 +6424,12 @@ init_display (void) f->terminal = t; t->reference_count++; +#ifdef MSDOS + f->output_data.tty->display_info = &the_only_display_info; +#else + if (f->output_method == output_termcap) + create_tty_output (f); +#endif t->display_info.tty->top_frame = selected_frame; change_frame_size (XFRAME (selected_frame), FrameRows (t->display_info.tty), @@ -6583,13 +6597,29 @@ It is up to you to set this variable if your terminal can do that. */); DEFVAR_LISP ("initial-window-system", &Vinitial_window_system, doc: /* Name of the window system that Emacs uses for the first frame. -The value is a symbol--for instance, `x' for X windows. -The value is nil if Emacs is using a text-only terminal. */); +The value is a symbol: + nil for a termcap frame (a character-only terminal), + 'x' for an Emacs frame that is really an X window, + 'w32' for an Emacs frame that is a window on MS-Windows display, + 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, + 'pc' for a direct-write MS-DOS frame. + +Use of this variable as a boolean is deprecated. Instead, +use `display-graphic-p' or any of the other `display-*-p' +predicates which report frame's specific UI-related capabilities. */); DEFVAR_KBOARD ("window-system", Vwindow_system, doc: /* Name of window system through which the selected frame is displayed. -The value is a symbol--for instance, `x' for X windows. -The value is nil if the selected frame is on a text-only-terminal. */); +The value is a symbol: + nil for a termcap frame (a character-only terminal), + 'x' for an Emacs frame that is really an X window, + 'w32' for an Emacs frame that is a window on MS-Windows display, + 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, + 'pc' for a direct-write MS-DOS frame. + +Use of this variable as a boolean is deprecated. Instead, +use `display-graphic-p' or any of the other `display-*-p' +predicates which report frame's specific UI-related capabilities. */); DEFVAR_LISP ("window-system-version", &Vwindow_system_version, doc: /* The version number of the window system in use. diff --git a/src/editfns.c b/src/editfns.c index f76beb5e678..4a9e2314a84 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -218,11 +218,13 @@ usage: (char-to-string CHAR) */) } DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0, - doc: /* Convert arg BYTE to a string containing that byte. */) + doc: /* Convert arg BYTE to a unibyte string containing that byte. */) (Lisp_Object byte) { unsigned char b; CHECK_NUMBER (byte); + if (XINT (byte) < 0 || XINT (byte) > 255) + error ("Invalid byte"); b = XINT (byte); return make_string_from_bytes (&b, 1, 1); } diff --git a/src/emacs.c b/src/emacs.c index 70a0fae4ebf..49716c7eb4a 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -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. @@ -99,27 +100,27 @@ static const char emacs_version[] = "24.0.50"; /* Make these values available in GDB, which doesn't see macros. */ #ifdef USE_LSB_TAG -int gdb_use_lsb = 1; +int gdb_use_lsb EXTERNALLY_VISIBLE = 1; #else -int gdb_use_lsb = 0; +int gdb_use_lsb EXTERNALLY_VISIBLE = 0; #endif #ifndef USE_LISP_UNION_TYPE -int gdb_use_union = 0; +int gdb_use_union EXTERNALLY_VISIBLE = 0; #else -int gdb_use_union = 1; +int gdb_use_union EXTERNALLY_VISIBLE = 1; #endif -EMACS_INT gdb_valbits = VALBITS; -EMACS_INT gdb_gctypebits = GCTYPEBITS; +EMACS_INT gdb_valbits EXTERNALLY_VISIBLE = VALBITS; +EMACS_INT gdb_gctypebits EXTERNALLY_VISIBLE = GCTYPEBITS; #if defined (DATA_SEG_BITS) && ! defined (USE_LSB_TAG) -EMACS_INT gdb_data_seg_bits = DATA_SEG_BITS; +EMACS_INT gdb_data_seg_bits EXTERNALLY_VISIBLE = DATA_SEG_BITS; #else -EMACS_INT gdb_data_seg_bits = 0; +EMACS_INT gdb_data_seg_bits EXTERNALLY_VISIBLE = 0; #endif -EMACS_INT PVEC_FLAG = PSEUDOVECTOR_FLAG; -EMACS_INT gdb_array_mark_flag = ARRAY_MARK_FLAG; +EMACS_INT PVEC_FLAG EXTERNALLY_VISIBLE = PSEUDOVECTOR_FLAG; +EMACS_INT gdb_array_mark_flag EXTERNALLY_VISIBLE = ARRAY_MARK_FLAG; /* GDB might say "No enum type named pvec_type" if we don't have at least one symbol with that type, and then xbacktrace could fail. */ -enum pvec_type gdb_pvec_type = PVEC_TYPE_MASK; +enum pvec_type gdb_pvec_type EXTERNALLY_VISIBLE = PVEC_TYPE_MASK; /* Command line args from shell, as list of strings. */ Lisp_Object Vcommand_line_args; @@ -194,11 +195,6 @@ Lisp_Object Vdynamic_library_alist; but instead should use the virtual terminal under which it was started. */ int inhibit_window_system; -/* If nonzero, set Emacs to run at this priority. This is also used - in child_setup and sys_suspend to make sure subshells run at normal - priority; those functions have their own extern declaration. */ -EMACS_INT emacs_priority; - /* If non-zero, a filter or a sentinel is running. Tested to save the match data on the first attempt to change it inside asynchronous code. */ int running_asynch_code; @@ -829,13 +825,14 @@ main (int argc, char **argv) printf ("see the file named COPYING.\n"); exit (0); } - if (argmatch (argv, argc, "-chdir", "--chdir", 2, &ch_to_dir, &skip_args)) - if (chdir (ch_to_dir) == -1) - { - fprintf (stderr, "%s: Can't chdir to %s: %s\n", - argv[0], ch_to_dir, strerror (errno)); - exit (1); - } + + if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args)) + if (chdir (ch_to_dir) == -1) + { + fprintf (stderr, "%s: Can't chdir to %s: %s\n", + argv[0], ch_to_dir, strerror (errno)); + exit (1); + } #ifdef HAVE_PERSONALITY_LINUX32 @@ -1508,9 +1505,7 @@ main (int argc, char **argv) syms_of_doc (); syms_of_editfns (); syms_of_emacs (); -#ifdef CLASH_DETECTION syms_of_filelock (); -#endif /* CLASH_DETECTION */ syms_of_indent (); syms_of_insdel (); /* syms_of_keymap (); */ @@ -2053,10 +2048,8 @@ shut_down_emacs (int sig, int no_x, Lisp_Object stuff) #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) @@ -2412,9 +2405,10 @@ Special values: `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. @@ -2440,15 +2434,6 @@ Before Emacs 24.1, the hook was not run in batch mode, i.e., if `noninteractive' was non-nil. */); Vkill_emacs_hook = Qnil; - DEFVAR_INT ("emacs-priority", &emacs_priority, - doc: /* Priority for Emacs to run at. -This value is effective only if set before Emacs is dumped, -and only if the Emacs executable is installed with setuid to permit -it to change priority. (Emacs sets its uid back to the real uid.) -Currently, you need to define SET_EMACS_PRIORITY in `config.h' -before you compile Emacs, to enable the code for this feature. */); - emacs_priority = 0; - DEFVAR_LISP ("path-separator", &Vpath_separator, doc: /* String containing the character that separates directories in search paths, such as PATH and other similar environment variables. */); @@ -2532,5 +2517,3 @@ libraries; only those already known by Emacs will be loaded. */); daemon_pipe[1] = 0; } -/* arch-tag: 7bfd356a-c720-4612-8ab6-aa4222931c2e - (do not change this comment) */ diff --git a/src/eval.c b/src/eval.c index c07e7a37323..574c4ebf361 100644 --- a/src/eval.c +++ b/src/eval.c @@ -187,7 +187,7 @@ init_eval_once (void) specpdl_ptr = specpdl; /* Don't forget to update docs (lispref node "Local Variables"). */ max_specpdl_size = 1200; /* 1000 is not enough for CEDET's c-by.el. */ - max_lisp_eval_depth = 500; + max_lisp_eval_depth = 600; Vrun_hooks = Qnil; } diff --git a/src/fileio.c b/src/fileio.c index 36b6cc3ca8b..886e5ebc411 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5044,9 +5044,10 @@ e_write (int desc, Lisp_Object string, int start, int end, struct coding_system } DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, - Sverify_visited_file_modtime, 1, 1, 0, + Sverify_visited_file_modtime, 0, 1, 0, doc: /* Return t if last mod time of BUF's visited file matches what BUF records. This means that the file has not been changed since it was visited or saved. +If BUF is omitted or nil, it defaults to the current buffer. See Info node `(elisp)Modification Time' for more details. */) (Lisp_Object buf) { @@ -5055,8 +5056,13 @@ See Info node `(elisp)Modification Time' for more details. */) Lisp_Object handler; Lisp_Object filename; - CHECK_BUFFER (buf); - b = XBUFFER (buf); + if (NILP (buf)) + b = current_buffer; + else + { + CHECK_BUFFER (buf); + b = XBUFFER (buf); + } if (!STRINGP (b->filename)) return Qt; if (b->modtime == 0) return Qt; @@ -5863,5 +5869,3 @@ This includes interactive calls to `delete-file' and #endif } -/* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c - (do not change this comment) */ diff --git a/src/filelock.c b/src/filelock.c index acca7234419..ae0584c447a 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -730,6 +730,8 @@ init_filelock (void) boot_time_initialized = 0; } +#endif /* CLASH_DETECTION */ + void syms_of_filelock (void) { @@ -737,12 +739,12 @@ syms_of_filelock (void) doc: /* The directory for writing temporary files. */); Vtemporary_file_directory = Qnil; +#ifdef CLASH_DETECTION defsubr (&Sunlock_buffer); defsubr (&Slock_buffer); defsubr (&Sfile_locked_p); +#endif } -#endif /* CLASH_DETECTION */ - /* arch-tag: e062676d-50b2-4be0-ab96-197c81b181a1 (do not change this comment) */ diff --git a/src/font.c b/src/font.c index aee6b483353..ae933df75c8 100644 --- a/src/font.c +++ b/src/font.c @@ -1,8 +1,9 @@ /* font.c -- "Font" primitives. - Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - Copyright (C) 2006, 2007, 2008, 2009, 2010 - National Institute of Advanced Industrial Science and Technology (AIST) - Registration Number H13PRO009 + +Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +Copyright (C) 2006, 2007, 2008, 2009, 2010 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -3443,7 +3444,7 @@ font_load_for_lface (FRAME_PTR f, Lisp_Object *attrs, Lisp_Object spec) if (NILP (entity)) return Qnil; } - /* Don't loose the original name that was put in initially. We need + /* Don't lose the original name that was put in initially. We need it to re-apply the font when font parameters (like hinting or dpi) have changed. */ entity = font_open_for_lface (f, entity, attrs, spec); @@ -3514,7 +3515,7 @@ font_open_by_name (FRAME_PTR f, const char *name) args[1] = make_unibyte_string (name, strlen (name)); spec = Ffont_spec (2, args); ret = font_open_by_spec (f, spec); - /* Do not loose name originally put in. */ + /* Do not lose name originally put in. */ if (!NILP (ret)) font_put_extra (ret, QCuser_spec, args[1]); @@ -3731,8 +3732,8 @@ font_get_frame_data (FRAME_PTR f, struct font_driver *driver) 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; @@ -5399,5 +5400,3 @@ init_font (void) Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt; } -/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846 - (do not change this comment) */ diff --git a/src/font.h b/src/font.h index b2d7e49fa29..940eb3d001d 100644 --- a/src/font.h +++ b/src/font.h @@ -823,8 +823,8 @@ extern void *font_get_frame_data (FRAME_PTR f, 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; diff --git a/src/frame.c b/src/frame.c index 04cc1ca07da..6cf46f1a0ba 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1,6 +1,8 @@ /* Generic frame functions. - Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003, - 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003, + 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -201,11 +203,12 @@ Lisp_Object Vframe_list; DEFUN ("framep", Fframep, Sframep, 1, 1, 0, doc: /* Return non-nil if OBJECT is a frame. -Value is t for a termcap frame (a character-only terminal), -`x' for an Emacs frame that is really an X window, -`w32' for an Emacs frame that is a window on MS-Windows display, -`ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, -`pc' for a direct-write MS-DOS frame. +Value is: + t for a termcap frame (a character-only terminal), + 'x' for an Emacs frame that is really an X window, + 'w32' for an Emacs frame that is a window on MS-Windows display, + 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, + 'pc' for a direct-write MS-DOS frame. See also `frame-live-p'. */) (Lisp_Object object) { @@ -247,10 +250,18 @@ return values. */) DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0, doc: /* The name of the window system that FRAME is displaying through. -The value is a symbol---for instance, 'x' for X windows. -The value is nil if Emacs is using a text-only terminal. - -FRAME defaults to the currently selected frame. */) +The value is a symbol: + nil for a termcap frame (a character-only terminal), + 'x' for an Emacs frame that is really an X window, + 'w32' for an Emacs frame that is a window on MS-Windows display, + 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, + 'pc' for a direct-write MS-DOS frame. + +FRAME defaults to the currently selected frame. + +Use of this function as a predicate is deprecated. Instead, +use `display-graphic-p' or any of the other `display-*-p' +predicates which report frame's specific UI-related capabilities. */) (Lisp_Object frame) { Lisp_Object type; @@ -3300,7 +3311,7 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu void x_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - Lisp_Object frame, font_object, font_param = Qnil; + Lisp_Object font_object, font_param = Qnil; int fontset = -1; /* Set the frame parameter back to the old value because we may @@ -4314,6 +4325,20 @@ frame_make_pointer_visible (void) } } +DEFUN ("frame-pointer-visible-p", Fframe_pointer_visible_p, + Sframe_pointer_visible_p, 0, 1, 0, + doc: /* Return t if the mouse pointer displayed on FRAME is visible. +Otherwise it returns nil. FRAME omitted or nil means the +selected frame. This is useful when `make-pointer-invisible' is set. */) + (Lisp_Object frame) +{ + if (NILP (frame)) + frame = selected_frame; + + CHECK_FRAME (frame); + + return (XFRAME (frame)->pointer_invisible ? Qnil : Qt); +} /*********************************************************************** @@ -4538,12 +4563,24 @@ recursively). */); staticpro (&Qdelete_frame_functions); DEFVAR_LISP ("menu-bar-mode", &Vmenu_bar_mode, - doc: /* Non-nil if Menu-Bar mode is enabled. */); + doc: /* Non-nil if Menu-Bar mode is enabled. +See the command `menu-bar-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `menu-bar-mode'. */); Vmenu_bar_mode = Qt; DEFVAR_LISP ("tool-bar-mode", &Vtool_bar_mode, - doc: /* Non-nil if Tool-Bar mode is enabled. */); + doc: /* Non-nil if Tool-Bar mode is enabled. +See the command `tool-bar-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `tool-bar-mode'. */); +#ifdef HAVE_WINDOW_SYSTEM Vtool_bar_mode = Qt; +#else + Vtool_bar_mode = Qnil; +#endif DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame, doc: /* Minibufferless frames use this frame's minibuffer. @@ -4623,6 +4660,7 @@ automatically. See also `mouse-autoselect-window'. */); defsubr (&Sset_frame_width); defsubr (&Sset_frame_size); defsubr (&Sset_frame_position); + defsubr (&Sframe_pointer_visible_p); #ifdef HAVE_WINDOW_SYSTEM defsubr (&Sx_get_resource); @@ -4631,5 +4669,3 @@ automatically. See also `mouse-autoselect-window'. */); } -/* arch-tag: 7dbf2c69-9aad-45f8-8296-db893d6dd039 - (do not change this comment) */ diff --git a/src/frame.h b/src/frame.h index e66fd9341c7..31f601737c8 100644 --- a/src/frame.h +++ b/src/frame.h @@ -544,6 +544,20 @@ typedef struct frame *FRAME_PTR; #define FRAME_WINDOW_P(f) (0) #endif +/* Return a pointer to the structure holding information about the + region of text, if any, that is currently shown in mouse-face on + frame F. We need to define two versions because a TTY-only build + does not have FRAME_X_DISPLAY_INFO. */ +#ifdef HAVE_WINDOW_SYSTEM +# define MOUSE_HL_INFO(F) \ + (FRAME_WINDOW_P(F) \ + ? &(FRAME_X_DISPLAY_INFO(F)->mouse_highlight) \ + : &(((F)->output_data.tty->display_info)->mouse_highlight)) +#else +# define MOUSE_HL_INFO(F) \ + (&(((F)->output_data.tty->display_info)->mouse_highlight)) +#endif + /* Nonzero if frame F is still alive (not deleted). */ #define FRAME_LIVE_P(f) ((f)->terminal != 0) diff --git a/src/ftfont.c b/src/ftfont.c index b0d10791379..d9ae9be0905 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -2598,7 +2598,7 @@ ftfont_font_format (FcPattern *pattern, Lisp_Object filename) return intern ("unknown"); } -static const char *ftfont_booleans [] = { +static const char *const ftfont_booleans [] = { ":antialias", ":hinting", ":verticallayout", @@ -2611,7 +2611,7 @@ static const char *ftfont_booleans [] = { NULL, }; -static const char *ftfont_non_booleans [] = { +static const char *const ftfont_non_booleans [] = { ":family", ":familylang", ":style", diff --git a/src/gnutls.c b/src/gnutls.c index 577cca247ee..1cc258a5096 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -125,8 +125,13 @@ emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf, rtnval = gnutls_read (state, buf, nbyte); if (rtnval >= 0) return rtnval; - else - return -1; + else { + if (rtnval == GNUTLS_E_AGAIN || + rtnval == GNUTLS_E_INTERRUPTED) + return -1; + else + return 0; + } } /* convert an integer error to a Lisp_Object; it will be either a diff --git a/src/gtkutil.c b/src/gtkutil.c index 3b7e6888753..6fd4b969819 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -559,7 +559,7 @@ hierarchy_ch_cb (GtkWidget *widget, FRAME_PTR f = (FRAME_PTR) user_data; struct x_output *x = f->output_data.x; GtkWidget *top = gtk_widget_get_toplevel (x->ttip_lbl); - + if (! top || ! GTK_IS_WINDOW (top)) gtk_widget_hide (previous_toplevel); } @@ -580,7 +580,7 @@ qttip_cb (GtkWidget *widget, { FRAME_PTR f = (FRAME_PTR) user_data; struct x_output *x = f->output_data.x; - if (x->ttip_widget == NULL) + if (x->ttip_widget == NULL) { g_object_set (G_OBJECT (widget), "has-tooltip", FALSE, NULL); x->ttip_widget = tooltip; @@ -589,6 +589,8 @@ qttip_cb (GtkWidget *widget, g_object_ref (G_OBJECT (x->ttip_lbl)); gtk_tooltip_set_custom (tooltip, x->ttip_lbl); x->ttip_window = GTK_WINDOW (gtk_widget_get_toplevel (x->ttip_lbl)); + /* ATK needs an empty title for some reason. */ + gtk_window_set_title (x->ttip_window, ""); /* Realize so we can safely get screen later on. */ gtk_widget_realize (GTK_WIDGET (x->ttip_window)); gtk_widget_realize (x->ttip_lbl); @@ -631,14 +633,14 @@ xg_prepare_tooltip (FRAME_PTR f, screen = gdk_drawable_get_screen (gwin); settings = gtk_settings_get_for_screen (screen); g_object_get (settings, "gtk-enable-tooltips", &tt_enabled, NULL); - if (tt_enabled) + if (tt_enabled) { g_object_set (settings, "gtk-enable-tooltips", FALSE, NULL); /* Record that we disabled it so it can be enabled again. */ g_object_set_data (G_OBJECT (x->ttip_window), "restore-tt", (gpointer)f); } - + /* Prevent Gtk+ from hiding tooltip on mouse move and such. */ g_object_set_data (G_OBJECT (gtk_widget_get_display (GTK_WIDGET (x->ttip_window))), @@ -652,7 +654,7 @@ xg_prepare_tooltip (FRAME_PTR f, gtk_widget_size_request (GTK_WIDGET (x->ttip_window), &req); if (width) *width = req.width; if (height) *height = req.height; - + UNBLOCK_INPUT; return 1; @@ -799,7 +801,7 @@ xg_frame_resized (FRAME_PTR f, int pixelwidth, int pixelheight) &pixelwidth, &pixelheight, 0); else return; } - + rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, pixelheight); columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pixelwidth); @@ -1073,7 +1075,7 @@ xg_create_frame_widgets (FRAME_PTR f) f->output_data.x->ttip_widget = 0; f->output_data.x->ttip_lbl = 0; f->output_data.x->ttip_window = 0; - gtk_widget_set_tooltip_text (wtop, "Dummy text"); + gtk_widget_set_tooltip_text (wtop, "Dummy text"); g_signal_connect (wtop, "query-tooltip", G_CALLBACK (qttip_cb), f); #endif @@ -1452,7 +1454,7 @@ pop_down_dialog (Lisp_Object arg) g_main_loop_quit (dd->loop); g_main_loop_unref (dd->loop); - + UNBLOCK_INPUT; return Qnil; @@ -1480,7 +1482,7 @@ xg_maybe_add_timer (gpointer data) return FALSE; } - + /* Pops up a modal dialog W and waits for response. We don't use gtk_dialog_run because we want to process emacs timers. The dialog W is not destroyed when this function returns. */ @@ -1514,7 +1516,7 @@ xg_dialog_run (FRAME_PTR f, GtkWidget *w) (void) xg_maybe_add_timer (&dd); g_main_loop_run (dd.loop); - + dd.w = 0; unbind_to (count, Qnil); @@ -3072,6 +3074,23 @@ xg_modify_menubar_widgets (GtkWidget *menubar, FRAME_PTR f, widget_value *val, gtk_widget_show_all (menubar); } +/* Callback called when the menu bar W is mapped. + Used to find the height of the menu bar if we didn't get it + after showing the widget. */ + +static void +menubar_map_cb (GtkWidget *w, gpointer user_data) +{ + GtkRequisition req; + FRAME_PTR f = (FRAME_PTR) user_data; + gtk_widget_size_request (w, &req); + if (FRAME_MENUBAR_HEIGHT (f) != req.height) + { + FRAME_MENUBAR_HEIGHT (f) = req.height; + xg_height_or_width_changed (f); + } +} + /* Recompute all the widgets of frame F, when the menu bar has been changed. Value is non-zero if widgets were updated. */ @@ -3093,10 +3112,20 @@ xg_update_frame_menubar (FRAME_PTR f) FALSE, FALSE, 0); gtk_box_reorder_child (GTK_BOX (x->vbox_widget), x->menubar_widget, 0); + g_signal_connect (x->menubar_widget, "map", G_CALLBACK (menubar_map_cb), f); gtk_widget_show_all (x->menubar_widget); gtk_widget_size_request (x->menubar_widget, &req); - FRAME_MENUBAR_HEIGHT (f) = req.height; - xg_height_or_width_changed (f); + + /* If menu bar doesn't know its height yet, cheat a little so the frame + doesn't jump so much when resized later in menubar_map_cb. */ + if (req.height == 0) + req.height = 23; + + if (FRAME_MENUBAR_HEIGHT (f) != req.height) + { + FRAME_MENUBAR_HEIGHT (f) = req.height; + xg_height_or_width_changed (f); + } UNBLOCK_INPUT; return 1; @@ -3339,7 +3368,7 @@ xg_create_scroll_bar (FRAME_PTR f, "button-release-event", end_callback, (gpointer) bar); - + /* The scroll bar widget does not draw on a window of its own. Instead it draws on the parent window, in this case the edit widget. So whenever the edit widget is cleared, the scroll bar needs to redraw @@ -3428,11 +3457,11 @@ xg_update_scrollbar_pos (FRAME_PTR f, FRAME_X_WINDOW (f), oldx, oldy, oldw, oldh, 0); } - + /* GTK does not redraw until the main loop is entered again, but if there are no X events pending we will not enter it. So we sync here to get some events. */ - + x_sync (f); SET_FRAME_GARBAGED (f); cancel_mouse_face (f); @@ -3547,7 +3576,7 @@ xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event) GtkWidget *w = gtk_grab_get_current (); retval = w != 0 && GTK_IS_SCROLLBAR (w); } - + return retval; } @@ -3635,7 +3664,7 @@ xg_tool_bar_callback (GtkWidget *w, gpointer client_data) this is written. */ event.modifiers = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f), mod); kbd_buffer_store_event (&event); - + /* Return focus to the frame after we have clicked on a detached tool bar button. */ Fx_focus_frame (frame); @@ -3672,7 +3701,7 @@ xg_tool_bar_proxy_help_callback (GtkWidget *w, { GtkWidget *wbutton = GTK_WIDGET (g_object_get_data (G_OBJECT (w), XG_TOOL_BAR_PROXY_BUTTON)); - + return xg_tool_bar_help_callback (wbutton, event, client_data); } @@ -3775,7 +3804,7 @@ xg_tool_bar_menu_proxy (GtkToolItem *toolitem, gpointer user_data) G_CALLBACK (xg_tool_bar_proxy_callback), user_data); - + g_object_set_data (G_OBJECT (wmenuitem), XG_TOOL_BAR_PROXY_BUTTON, (gpointer) wbutton); gtk_tool_item_set_proxy_menu_item (toolitem, "Emacs toolbar item", wmenuitem); @@ -3973,7 +4002,7 @@ xg_pack_tool_bar (FRAME_PTR f, Lisp_Object pos) x->toolbar_widget); } - if (into_hbox) + if (into_hbox) { gtk_handle_box_set_handle_position (GTK_HANDLE_BOX (x->handlebox_widget), GTK_POS_TOP); @@ -4057,18 +4086,23 @@ xg_make_tool_item (FRAME_PTR f, GtkWidget *wimage, GtkWidget **wbutton, const char *label, - int i) + int i, + int vert_only) { GtkToolItem *ti = gtk_tool_item_new (); Lisp_Object style = Ftool_bar_get_system_style (); int both_horiz = EQ (style, Qboth_horiz); int text_image = EQ (style, Qtext_image_horiz); - + GtkWidget *vb = both_horiz || text_image ? gtk_hbox_new (FALSE, 0) : gtk_vbox_new (FALSE, 0); GtkWidget *wb = gtk_button_new (); GtkWidget *weventbox = gtk_event_box_new (); + /* We are not letting Gtk+ alter display on this, we only keep it here + so we can get it later in xg_show_toolbar_item. */ + gtk_tool_item_set_is_important (ti, !vert_only); + if (wimage && ! text_image) gtk_box_pack_start (GTK_BOX (vb), wimage, TRUE, TRUE, 0); @@ -4113,7 +4147,7 @@ xg_make_tool_item (FRAME_PTR f, NULL); g_object_set_data (G_OBJECT (wb), XG_FRAME_DATA, (gpointer)f); - + /* Use enter/leave notify to show help. We use the events rather than the GtkButton specific signals "enter" and "leave", so we can have only one callback. The event @@ -4128,7 +4162,7 @@ xg_make_tool_item (FRAME_PTR f, G_CALLBACK (xg_tool_bar_help_callback), (gpointer) (EMACS_INT) i); } - + if (wbutton) *wbutton = wb; return ti; @@ -4142,7 +4176,8 @@ xg_show_toolbar_item (GtkToolItem *ti) int text_image = EQ (style, Qtext_image_horiz); int horiz = both_horiz || text_image; - int show_label = ! EQ (style, Qimage); + int vert_only = ! gtk_tool_item_get_is_important (ti); + int show_label = ! EQ (style, Qimage) && ! (vert_only && horiz); int show_image = ! EQ (style, Qtext); GtkWidget *weventbox = gtk_bin_get_child (GTK_BIN (ti)); @@ -4213,7 +4248,7 @@ xg_update_tool_bar_sizes (FRAME_PTR f) if (pos == 0 || (pos == 1 && x->menubar_widget)) nt = req.height; else nb = req.height; } - + if (nl != FRAME_TOOLBAR_LEFT_WIDTH (f) || nr != FRAME_TOOLBAR_RIGHT_WIDTH (f) || nt != FRAME_TOOLBAR_TOP_HEIGHT (f) @@ -4279,7 +4314,7 @@ update_frame_tool_bar (FRAME_PTR f) wtoolbar = GTK_TOOLBAR (x->toolbar_widget); dir = gtk_widget_get_direction (GTK_WIDGET (wtoolbar)); - + for (i = 0; i < f->n_tool_bar_items; ++i) { int enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P)); @@ -4299,7 +4334,8 @@ update_frame_tool_bar (FRAME_PTR f) Lisp_Object specified_file; const char *label = (STRINGP (PROP (TOOL_BAR_ITEM_LABEL)) ? SSDATA (PROP (TOOL_BAR_ITEM_LABEL)) : ""); - + int vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY)); + ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), i); if (ti) @@ -4389,7 +4425,7 @@ update_frame_tool_bar (FRAME_PTR f) else { /* Insert an empty (non-image) button */ - ti = xg_make_tool_item (f, NULL, NULL, "", i); + ti = xg_make_tool_item (f, NULL, NULL, "", i, 0); gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, -1); } continue; @@ -4423,7 +4459,7 @@ update_frame_tool_bar (FRAME_PTR f) } gtk_misc_set_padding (GTK_MISC (w), hmargin, vmargin); - ti = xg_make_tool_item (f, w, &wbutton, label, i); + ti = xg_make_tool_item (f, w, &wbutton, label, i, vert_only); gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, -1); gtk_widget_set_sensitive (wbutton, enabled_p); } @@ -4440,6 +4476,7 @@ update_frame_tool_bar (FRAME_PTR f) gpointer old_icon_name = g_object_get_data (G_OBJECT (wimage), XG_TOOL_BAR_ICON_NAME); gtk_label_set_text (GTK_LABEL (wlbl), label); + gtk_tool_item_set_is_important (ti, !vert_only); if (stock_name && (! old_stock_name || strcmp (old_stock_name, stock_name) != 0)) { @@ -4523,7 +4560,7 @@ free_frame_tool_bar (FRAME_PTR f) BLOCK_INPUT; /* We may have created the toolbar_widget in xg_create_tool_bar, but not the x->handlebox_widget which is created in xg_pack_tool_bar. */ - if (is_packed) + if (is_packed) { if (x->toolbar_in_hbox) gtk_container_remove (GTK_CONTAINER (x->hbox_widget), diff --git a/src/image.c b/src/image.c index 4cdd7f2bbab..e16b63ae0f4 100644 --- a/src/image.c +++ b/src/image.c @@ -1049,10 +1049,6 @@ free_image (struct frame *f, struct image *img) /* 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 @@ uncache_image (struct frame *f, Lisp_Object spec) { 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); + } } @@ -7096,12 +7097,15 @@ gif_read_from_memory (GifFileType *file, GifByteType *buf, int len) static const int interlace_start[] = {0, 4, 2, 1}; static const int interlace_increment[] = {8, 8, 4, 2}; +#define GIF_LOCAL_DESCRIPTOR_EXTENSION 249 + static int gif_load (struct frame *f, struct image *img) { Lisp_Object file, specified_file; Lisp_Object specified_data; int rc, width, height, x, y, i; + boolean transparent_p; XImagePtr ximg; ColorMapObject *gif_color_map; unsigned long pixel_colors[256]; @@ -7110,6 +7114,7 @@ gif_load (struct frame *f, struct image *img) int ino, image_height, image_width; gif_memory_source memsrc; unsigned char *raster; + unsigned int transparency_color_index; specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); @@ -7182,6 +7187,18 @@ gif_load (struct frame *f, struct image *img) return 0; } + for (i = 0; i < gif->SavedImages[ino].ExtensionBlockCount; i++) + if ((gif->SavedImages[ino].ExtensionBlocks[i].Function + == GIF_LOCAL_DESCRIPTOR_EXTENSION) + && gif->SavedImages[ino].ExtensionBlocks[i].ByteCount == 4 + /* Transparency enabled? */ + && gif->SavedImages[ino].ExtensionBlocks[i].Bytes[0] & 1) + { + transparent_p = 1; + transparency_color_index + = (unsigned char) gif->SavedImages[ino].ExtensionBlocks[i].Bytes[3]; + } + img->corners[TOP_CORNER] = gif->SavedImages[ino].ImageDesc.Top; img->corners[LEFT_CORNER] = gif->SavedImages[ino].ImageDesc.Left; image_height = gif->SavedImages[ino].ImageDesc.Height; @@ -7220,10 +7237,22 @@ gif_load (struct frame *f, struct image *img) if (gif_color_map) for (i = 0; i < gif_color_map->ColorCount; ++i) { - int r = gif_color_map->Colors[i].Red << 8; - int g = gif_color_map->Colors[i].Green << 8; - int b = gif_color_map->Colors[i].Blue << 8; - pixel_colors[i] = lookup_rgb_color (f, r, g, b); + if (transparent_p && transparency_color_index == i) + { + Lisp_Object specified_bg + = image_spec_value (img->spec, QCbackground, NULL); + pixel_colors[i] = STRINGP (specified_bg) + ? x_alloc_image_color (f, img, specified_bg, + FRAME_BACKGROUND_PIXEL (f)) + : FRAME_BACKGROUND_PIXEL (f); + } + else + { + int r = gif_color_map->Colors[i].Red << 8; + int g = gif_color_map->Colors[i].Green << 8; + int b = gif_color_map->Colors[i].Blue << 8; + pixel_colors[i] = lookup_rgb_color (f, r, g, b); + } } #ifdef COLOR_TABLE_SUPPORT diff --git a/src/insdel.c b/src/insdel.c index abe6f350585..b62889082fd 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -73,9 +73,6 @@ Lisp_Object combine_after_change_list; Lisp_Object combine_after_change_buffer; Lisp_Object Qinhibit_modification_hooks; - -extern Lisp_Object Vselect_active_regions, Vsaved_region_selection, Qonly; - /* Check all markers in the current buffer, looking for something invalid. */ @@ -2051,6 +2048,7 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, /* If `select-active-regions' is non-nil, save the region text. */ if (!NILP (current_buffer->mark_active) + && !inhibit_modification_hooks && XMARKER (current_buffer->mark)->buffer && NILP (Vsaved_region_selection) && (EQ (Vselect_active_regions, Qonly) @@ -2394,5 +2392,3 @@ as well as hooks attached to text properties and overlays. */); defsubr (&Scombine_after_change_execute); } -/* arch-tag: 9b34b886-47d7-465e-a234-299af411b23d - (do not change this comment) */ diff --git a/src/intervals.c b/src/intervals.c index 5e08e13d23b..def63c43cc4 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1875,15 +1875,6 @@ lookup_char_property (Lisp_Object plist, register Lisp_Object prop, int textprop } -/* Set point "temporarily", without checking any text properties. */ - -INLINE void -temp_set_point (struct buffer *buffer, EMACS_INT charpos) -{ - temp_set_point_both (buffer, charpos, - buf_charpos_to_bytepos (buffer, charpos)); -} - /* Set point in BUFFER "temporarily" to CHARPOS, which corresponds to byte position BYTEPOS. */ @@ -1906,6 +1897,15 @@ temp_set_point_both (struct buffer *buffer, BUF_PT (buffer) = charpos; } +/* Set point "temporarily", without checking any text properties. */ + +INLINE void +temp_set_point (struct buffer *buffer, EMACS_INT charpos) +{ + temp_set_point_both (buffer, charpos, + buf_charpos_to_bytepos (buffer, charpos)); +} + /* Set point in BUFFER to CHARPOS. If the target position is before an intangible character, move to an ok place. */ diff --git a/src/intervals.h b/src/intervals.h index b39fbd6899d..47eb8d4bcb1 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -264,12 +264,12 @@ extern INTERVAL previous_interval (INTERVAL); extern INTERVAL merge_interval_left (INTERVAL); extern INTERVAL merge_interval_right (INTERVAL); extern void delete_interval (INTERVAL); -extern INLINE void offset_intervals (struct buffer *, EMACS_INT, EMACS_INT); +extern void offset_intervals (struct buffer *, EMACS_INT, EMACS_INT); extern void graft_intervals_into_buffer (INTERVAL, EMACS_INT, EMACS_INT, struct buffer *, int); extern void verify_interval_modification (struct buffer *, int, int); extern INTERVAL balance_intervals (INTERVAL); -extern INLINE void copy_intervals_to_string (Lisp_Object, struct buffer *, +extern void copy_intervals_to_string (Lisp_Object, struct buffer *, EMACS_INT, EMACS_INT); extern INTERVAL copy_intervals (INTERVAL, EMACS_INT, EMACS_INT); extern int compare_string_intervals (Lisp_Object, Lisp_Object); diff --git a/src/keyboard.c b/src/keyboard.c index 7f770ae4df1..17819170640 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -144,10 +144,6 @@ int this_single_command_key_start; static int before_command_key_count; static int before_command_echo_length; -extern int minbuf_level; - -extern int message_enable_multibyte; - /* If non-nil, the function that implements the display of help. It's called with one argument, the help string to display. */ @@ -431,8 +427,6 @@ FILE *dribble; /* Nonzero if input is available. */ int input_pending; -extern char *pending_malloc_warning; - /* Circular buffer for pre-read keyboard input. */ static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; @@ -495,10 +489,10 @@ Lisp_Object Qconfig_changed_event; Lisp_Object Qevent_kind; Lisp_Object Qevent_symbol_elements; -/* menu item parts */ +/* menu and tool bar item parts */ Lisp_Object Qmenu_enable; Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence; -Lisp_Object QCbutton, QCtoggle, QCradio, QClabel; +Lisp_Object QCbutton, QCtoggle, QCradio, QClabel, QCvert_only; /* An event header symbol HEAD may have a property named Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS); @@ -620,7 +614,7 @@ static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object, 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); @@ -3601,6 +3595,7 @@ event_to_kboard (struct input_event *event) return FRAME_KBOARD (XFRAME (frame)); } +#ifdef subprocesses /* Return the number of slots occupied in kbd_buffer. */ static int @@ -3613,6 +3608,7 @@ kbd_buffer_nr_stored (void) : ((kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr + (kbd_store_ptr - kbd_buffer))); } +#endif /* subprocesses */ Lisp_Object Vthrow_on_input; @@ -3734,6 +3730,7 @@ kbd_buffer_store_event_hold (register struct input_event *event, { *kbd_store_ptr = *event; ++kbd_store_ptr; +#ifdef subprocesses if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE/2 && ! kbd_on_hold_p ()) { /* Don't read keyboard input until we have processed kbd_buffer. @@ -3745,6 +3742,7 @@ kbd_buffer_store_event_hold (register struct input_event *event, #endif stop_polling (); } +#endif /* subprocesses */ } /* If we're inside while-no-input, and this event qualifies @@ -3905,6 +3903,7 @@ kbd_buffer_get_event (KBOARD **kbp, register int c; Lisp_Object obj; +#ifdef subprocesses if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE/4) { /* Start reading input again, we have processed enough so we can @@ -3916,6 +3915,7 @@ kbd_buffer_get_event (KBOARD **kbp, #endif /* SIGIO */ start_polling (); } +#endif /* subprocesses */ if (noninteractive /* In case we are running as a daemon, only do this before @@ -4752,7 +4752,7 @@ static const int lispy_accent_codes[] = /* 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 @@ static const char *lispy_accent_keys[] = #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 @@ char const *lispy_function_keys[] = /* 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 @@ static const char *lispy_multimedia_keys[] = 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 @@ static const char *lispy_kana_keys[] = /* 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 @@ static const char *lispy_function_keys[] = /* 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 @@ static const char *iso_lispy_function_keys[] = 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 Qup, Qdown, Qbottom, Qend_scroll; 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 @@ EMACS_INT double_click_fuzz; 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,114 @@ make_lispy_position (struct frame *f, Lisp_Object *x, Lisp_Object *y, 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, Y relative to + the left window edge. 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; + yret = wy; } + /* 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; + 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 + else if (part == ON_VERTICAL_BORDER) { - /* Note: We have no special posn for part == ON_SCROLL_BAR. */ - wx = max (WINDOW_LEFT_MARGIN_WIDTH (w), wx); + 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 +5404,27 @@ make_lispy_position (struct frame *f, Lisp_Object *x, Lisp_Object *y, #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 +5613,6 @@ make_lispy_event (struct input_event *event) 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 +5644,7 @@ make_lispy_event (struct input_event *event) } #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 +5744,21 @@ make_lispy_event (struct input_event *event) 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 +5841,7 @@ make_lispy_event (struct input_event *event) 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 +5861,8 @@ make_lispy_event (struct input_event *event) 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 +6000,7 @@ make_lispy_event (struct input_event *event) 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 +6083,8 @@ make_lispy_event (struct input_event *event) 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 +6143,19 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa 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 +6336,7 @@ apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_ } -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 +6556,7 @@ reorder_modifiers (Lisp_Object symbol) 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; @@ -7074,10 +7059,12 @@ tty_read_avail_input (struct terminal *terminal, int n_to_read, i; struct tty_display_info *tty = terminal->display_info.tty; int nread = 0; +#ifdef subprocesses int buffer_free = KBD_BUFFER_SIZE - kbd_buffer_nr_stored () - 1; if (kbd_on_hold_p () || buffer_free <= 0) return 0; +#endif /* subprocesses */ if (!terminal->name) /* Don't read from a dead terminal. */ return 0; @@ -7159,9 +7146,11 @@ tty_read_avail_input (struct terminal *terminal, #endif #endif +#ifdef subprocesses /* Don't read more than we can store. */ if (n_to_read > buffer_free) n_to_read = buffer_free; +#endif /* subprocesses */ /* Now read; for one reason or another, this will not block. NREAD is set to the number of chars read. */ @@ -8281,9 +8270,12 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) if (NILP (menu_item_eval_property (value))) return 0; } - else if (EQ (key, QChelp)) + else if (EQ (key, QChelp)) /* `:help HELP-STRING'. */ PROP (TOOL_BAR_ITEM_HELP) = value; + else if (EQ (key, QCvert_only)) + /* `:vert-only t/nil'. */ + PROP (TOOL_BAR_ITEM_VERT_ONLY) = value; else if (EQ (key, QClabel)) { const char *bad_label = "!!?GARBLED ITEM?!!"; @@ -11100,10 +11092,10 @@ See also `current-input-mode'. */) #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 +11319,7 @@ The `posn-' functions access elements of such lists. */) 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, @@ -11641,6 +11633,8 @@ syms_of_keyboard (void) staticpro (&QCradio); QClabel = intern_c_string (":label"); staticpro (&QClabel); + QCvert_only = intern_c_string (":vert-only"); + staticpro (&QCvert_only); Qmode_line = intern_c_string ("mode-line"); staticpro (&Qmode_line); @@ -12440,5 +12434,3 @@ mark_kboards (void) } } -/* arch-tag: 774e34d7-6d31-42f3-8397-e079a4e4c9ca - (do not change this comment) */ diff --git a/src/keyboard.h b/src/keyboard.h index 9fd3b48eba9..7f36691a5a3 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -490,6 +490,8 @@ extern unsigned long last_event_timestamp; extern int quit_char; +extern int timers_run; + extern int parse_menu_item (Lisp_Object, int); extern void echo_now (void); @@ -534,5 +536,3 @@ extern int tty_read_avail_input (struct terminal *, int, struct input_event *); extern EMACS_TIME timer_check (int); -/* arch-tag: 769cbade-1ba9-4950-b886-db265b061aa3 - (do not change this comment) */ diff --git a/src/lisp.h b/src/lisp.h index 89d01ec6872..36653e91e4e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -267,7 +267,9 @@ union Lisp_Object struct { - EMACS_INT val : VALBITS; + /* Use explict signed, the signedness of a bit-field of type + int is implementation defined. */ + signed EMACS_INT val : VALBITS; enum Lisp_Type type : GCTYPEBITS; } s; struct @@ -290,7 +292,9 @@ union Lisp_Object struct { enum Lisp_Type type : GCTYPEBITS; - EMACS_INT val : VALBITS; + /* Use explict signed, the signedness of a bit-field of type + int is implementation defined. */ + signed EMACS_INT val : VALBITS; } s; struct { @@ -447,20 +451,8 @@ enum pvec_type #endif #define XHASH(a) ((a).i) - #define XTYPE(a) ((enum Lisp_Type) (a).u.type) - -#ifdef EXPLICIT_SIGN_EXTEND -/* Make sure we sign-extend; compilers have been known to fail to do so. - We additionally cast to EMACS_INT since it seems that some compilers - have been known to fail to do so, even though the bitfield is declared - as EMACS_INT already. */ -#define XINT(a) ((((EMACS_INT) (a).s.val) << (BITS_PER_EMACS_INT - VALBITS)) \ - >> (BITS_PER_EMACS_INT - VALBITS)) -#else #define XINT(a) ((a).s.val) -#endif /* EXPLICIT_SIGN_EXTEND */ - #define XUINT(a) ((a).u.val) #ifdef USE_LSB_TAG @@ -1589,6 +1581,41 @@ typedef struct { /* The ID of the mode line highlighting face. */ #define GLYPH_MODE_LINE_FACE 1 +/* Structure to hold mouse highlight data. This is here because other + header files need it for defining struct x_output etc. */ +typedef struct { + /* These variables describe the range of text currently shown in its + mouse-face, together with the window they apply to. As long as + the mouse stays within this range, we need not redraw anything on + its account. Rows and columns are glyph matrix positions in + MOUSE_FACE_WINDOW. */ + int mouse_face_beg_row, mouse_face_beg_col; + int mouse_face_beg_x, mouse_face_beg_y; + int mouse_face_end_row, mouse_face_end_col; + int mouse_face_end_x, mouse_face_end_y; + int mouse_face_past_end; + Lisp_Object mouse_face_window; + int mouse_face_face_id; + Lisp_Object mouse_face_overlay; + + /* 1 if a mouse motion event came and we didn't handle it right away because + gc was in progress. */ + int mouse_face_deferred_gc; + + /* FRAME and X, Y position of mouse when last checked for + highlighting. X and Y can be negative or out of range for the frame. */ + struct frame *mouse_face_mouse_frame; + int mouse_face_mouse_x, mouse_face_mouse_y; + + /* Nonzero means defer mouse-motion highlighting. */ + int mouse_face_defer; + + /* Nonzero means that the mouse highlight should not be shown. */ + int mouse_face_hidden; + + int mouse_face_image_state; +} Mouse_HLInfo; + /* Data type checking */ #define NILP(x) EQ (x, Qnil) @@ -2665,11 +2692,15 @@ extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz, Qtext_image_horiz; extern Lisp_Object Qspace, Qcenter, QCalign_to; extern Lisp_Object Qbar, Qhbar, Qbox, Qhollow; extern Lisp_Object Qleft_margin, Qright_margin; +extern Lisp_Object Qglyphless_char; extern Lisp_Object Vmessage_log_max; extern Lisp_Object QCdata, QCfile; extern Lisp_Object QCmap; extern Lisp_Object Qrisky_local_variable; extern Lisp_Object Vinhibit_redisplay; +extern struct frame *last_glyphless_glyph_frame; +extern unsigned last_glyphless_glyph_face_id; +extern int last_glyphless_glyph_merged_face_id; extern int message_enable_multibyte; extern int noninteractive_need_newline; extern EMACS_INT scroll_margin; @@ -2727,6 +2758,8 @@ extern void memory_full (void) NO_RETURN; extern void buffer_memory_full (void) NO_RETURN; extern int survives_gc_p (Lisp_Object); extern void mark_object (Lisp_Object); +extern void refill_memory_reserve (void); +extern const char *pending_malloc_warning; extern Lisp_Object Vpurify_flag; extern Lisp_Object Vmemory_full; extern Lisp_Object *stack_base; @@ -2823,7 +2856,8 @@ extern void syms_of_chartab (void); /* Defined in print.c */ extern Lisp_Object Vprin1_to_string_buffer; extern Lisp_Object Vprint_level, Vprint_length; -extern void debug_print (Lisp_Object); +extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE; +extern void safe_debug_print (Lisp_Object) EXTERNALLY_VISIBLE; EXFUN (Fprin1, 2); EXFUN (Fprin1_to_string, 2); EXFUN (Fprinc, 2); @@ -3226,6 +3260,8 @@ extern Lisp_Object Qdisabled, QCfilter; extern Lisp_Object Qabove_handle, Qhandle, Qbelow_handle; extern Lisp_Object Qup, Qdown, Qbottom, Qend_scroll; extern Lisp_Object Qtop, Qratio; +extern Lisp_Object Vsaved_region_selection; +extern Lisp_Object Vselect_active_regions; extern Lisp_Object Vtty_erase_char, Vhelp_form, Vtop_level; extern Lisp_Object Vthrow_on_input; extern int input_pending; @@ -3595,7 +3631,6 @@ extern void syms_of_xfns (void); 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 */ diff --git a/src/lread.c b/src/lread.c index e150078f6e2..83c94b02e23 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,7 +1,8 @@ /* Lisp parsing and input streams. - Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, - 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, + 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, + 2009, 2010 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -557,8 +558,6 @@ readbyte_from_string (int c, Lisp_Object readcharfun) encoded in `emacs-mule' and the first byte is already read in C. */ -extern char emacs_mule_bytes[256]; - static int read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun) { @@ -589,7 +588,7 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea if (len == 2) { - charset = emacs_mule_charset[buf[0]]; + charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]); code = buf[1] & 0x7F; } else if (len == 3) @@ -597,18 +596,18 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12) { - charset = emacs_mule_charset[buf[1]]; + charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]); code = buf[2] & 0x7F; } else { - charset = emacs_mule_charset[buf[0]]; + charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]); code = ((buf[1] << 8) | buf[2]) & 0x7F7F; } } else { - charset = emacs_mule_charset[buf[1]]; + charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]); code = ((buf[2] << 8) | buf[3]) & 0x7F7F; } c = DECODE_CHAR (charset, code); @@ -1082,6 +1081,10 @@ Loading a file records its definitions, and its `provide' and `require' calls, in an element of `load-history' whose car is the file name loaded. See `load-history'. +While the file is in the process of being loaded, the variable +`load-in-progress' is non-nil and the variable `load-file-name' +is bound to the file's name. + Return t if the file exists and loads successfully. */) (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) { @@ -2770,7 +2773,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) old-style. For Emacs-25, we should completely remove this first_in_list exception (old-style can still be obtained via "(\`" anyway). */ - if (first_in_list && next_char == ' ') + if (!new_backquote_flag && first_in_list && next_char == ' ') { Vold_style_backquotes = Qt; goto default_label; @@ -2787,33 +2790,48 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) } } case ',': - if (new_backquote_flag) - { - Lisp_Object comma_type = Qnil; - Lisp_Object value; - int ch = READCHAR; - - if (ch == '@') - comma_type = Qcomma_at; - else if (ch == '.') - comma_type = Qcomma_dot; - else - { - if (ch >= 0) UNREAD (ch); - comma_type = Qcomma; - } + { + int next_char = READCHAR; + UNREAD (next_char); + /* Transition from old-style to new-style: + It used to be impossible to have a new-style , other than within + a new-style `. This is sufficient when ` and , are used in the + normal way, but ` and , can also appear in args to macros that + will not interpret them in the usual way, in which case , may be + used without any ` anywhere near. + So we now use the same heuristic as for backquote: old-style + unquotes are only recognized when first on a list, and when + followed by a space. + Because it's more difficult to peak 2 chars ahead, a new-style + ,@ can still not be used outside of a `, unless it's in the middle + of a list. */ + if (new_backquote_flag + || !first_in_list + || (next_char != ' ' && next_char != '@')) + { + Lisp_Object comma_type = Qnil; + Lisp_Object value; + int ch = READCHAR; - new_backquote_flag--; - value = read0 (readcharfun); - new_backquote_flag++; - return Fcons (comma_type, Fcons (value, Qnil)); - } - else - { - Vold_style_backquotes = Qt; - goto default_label; - } + if (ch == '@') + comma_type = Qcomma_at; + else if (ch == '.') + comma_type = Qcomma_dot; + else + { + if (ch >= 0) UNREAD (ch); + comma_type = Qcomma; + } + value = read0 (readcharfun); + return Fcons (comma_type, Fcons (value, Qnil)); + } + else + { + Vold_style_backquotes = Qt; + goto default_label; + } + } case '?': { int modifiers; @@ -2840,26 +2858,9 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) c |= modifiers; next_char = READCHAR; - if (next_char == '.') - { - /* Only a dotted-pair dot is valid after a char constant. */ - int next_next_char = READCHAR; - UNREAD (next_next_char); - - ok = (next_next_char <= 040 - || (next_next_char < 0200 - && (strchr ("\"';([#?", next_next_char) - || (!first_in_list && next_next_char == '`') - || (new_backquote_flag && next_next_char == ',')))); - } - else - { - ok = (next_char <= 040 - || (next_char < 0200 - && (strchr ("\"';()[]#?", next_char) - || (!first_in_list && next_char == '`') - || (new_backquote_flag && next_char == ',')))); - } + ok = (next_char <= 040 + || (next_char < 0200 + && (strchr ("\"';()[]#?`,.", next_char)))); UNREAD (next_char); if (ok) return make_number (c); @@ -3001,9 +3002,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) if (next_char <= 040 || (next_char < 0200 - && (strchr ("\"';([#?", next_char) - || (!first_in_list && next_char == '`') - || (new_backquote_flag && next_char == ',')))) + && (strchr ("\"';([#?`,", next_char)))) { *pch = c; return Qnil; @@ -3028,9 +3027,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) while (c > 040 && c != 0x8a0 /* NBSP */ && (c >= 0200 - || (!strchr ("\"';()[]#", c) - && !(!first_in_list && c == '`') - && !(new_backquote_flag && c == ',')))) + || !(strchr ("\"';()[]#`,", c)))) { if (end - p < MAX_MULTIBYTE_LENGTH) { @@ -4046,9 +4043,9 @@ defalias (sname, string) } #endif /* NOTDEF */ -/* Define an "integer variable"; a symbol whose value is forwarded - to a C variable of type int. Sample call: - DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ +/* Define an "integer variable"; a symbol whose value is forwarded to a + C variable of type int. Sample call (munged w "xx" to fool make-docfile): + DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ void defvar_int (struct Lisp_Intfwd *i_fwd, const char *namestring, EMACS_INT *address) @@ -4550,8 +4547,7 @@ to load. See also `load-dangerous-libraries'. */); doc: /* If non-nil, use lexical binding when evaluating code. This only applies to code evaluated by `eval-buffer' and `eval-region'. This variable is automatically set from the file variables of an interpreted - lisp file read using `load'. -This variable automatically becomes buffer-local when set. */); + lisp file read using `load'. */); Fmake_variable_buffer_local (Qlexical_binding); DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list, @@ -4646,5 +4642,3 @@ This variable automatically becomes buffer-local when set. */); staticpro (&Qrehash_threshold); } -/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d - (do not change this comment) */ diff --git a/src/m/alpha.h b/src/m/alpha.h index 3b6d7da92df..0e7d182fee7 100644 --- a/src/m/alpha.h +++ b/src/m/alpha.h @@ -30,13 +30,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* __alpha defined automatically */ -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long diff --git a/src/m/amdx86-64.h b/src/m/amdx86-64.h index 30aa2678717..867d65f6606 100644 --- a/src/m/amdx86-64.h +++ b/src/m/amdx86-64.h @@ -31,13 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define EMACS_INT long #define EMACS_UINT unsigned long -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long diff --git a/src/m/arm.h b/src/m/arm.h deleted file mode 100644 index 8b659bb5bd0..00000000000 --- a/src/m/arm.h +++ /dev/null @@ -1,22 +0,0 @@ -/* Machine description file for ARM-based non-RISCiX machines. - -Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, - 2009, 2010 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 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/>. */ - -/* arch-tag: 07856f0c-f0c8-4bd8-99af-0b7fa1e5ee42 - (do not change this comment) */ diff --git a/src/m/hp800.h b/src/m/hp800.h deleted file mode 100644 index 9998f701a6b..00000000000 --- a/src/m/hp800.h +++ /dev/null @@ -1,29 +0,0 @@ -/* machine description file for hp9000 series 800 machines. - -Copyright (C) 1987, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, - 2009, 2010 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 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/>. */ - -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - -/* arch-tag: 809436e6-1645-4b92-b40d-2de5d6e7227c - (do not change this comment) */ diff --git a/src/m/ia64.h b/src/m/ia64.h index bbf09ac878b..e9cf07b6789 100644 --- a/src/m/ia64.h +++ b/src/m/ia64.h @@ -31,13 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define EMACS_INT long #define EMACS_UINT unsigned long -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long diff --git a/src/m/ibms390.h b/src/m/ibms390.h index 0acc826a1ea..1a19f7233a0 100644 --- a/src/m/ibms390.h +++ b/src/m/ibms390.h @@ -19,13 +19,6 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long diff --git a/src/m/ibms390x.h b/src/m/ibms390x.h index 6cbfbbcdbd4..2ef14a22945 100644 --- a/src/m/ibms390x.h +++ b/src/m/ibms390x.h @@ -27,13 +27,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define EMACS_INT long #define EMACS_UINT unsigned long -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#undef EXPLICIT_SIGN_EXTEND - /* On the 64 bit architecture, we can use 60 bits for addresses */ #define VALBITS 60 diff --git a/src/m/iris4d.h b/src/m/iris4d.h index 31f08d05cfc..9e80324ee92 100644 --- a/src/m/iris4d.h +++ b/src/m/iris4d.h @@ -19,13 +19,6 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for the value field of a LISP_OBJECT). */ diff --git a/src/m/m68k.h b/src/m/m68k.h index 8d53424ccec..df930d511f7 100644 --- a/src/m/m68k.h +++ b/src/m/m68k.h @@ -24,13 +24,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define m68k #endif -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - #ifdef GNU_LINUX #ifdef __ELF__ #define DATA_SEG_BITS 0x80000000 diff --git a/src/m/mips.h b/src/m/mips.h deleted file mode 100644 index b3a754c2b61..00000000000 --- a/src/m/mips.h +++ /dev/null @@ -1,29 +0,0 @@ -/* m- file for Mips machines. - -Copyright (C) 1987, 1992, 1999, 2001, 2002, 2003, 2004, 2005, 2006, - 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 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/>. */ - -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - -/* arch-tag: 8fd020ee-78a7-4d87-96ce-6129f52f7bee - (do not change this comment) */ diff --git a/src/m/sh3.h b/src/m/sh3.h deleted file mode 100644 index ebfdb5b2d64..00000000000 --- a/src/m/sh3.h +++ /dev/null @@ -1,4 +0,0 @@ -/* Machine description file for SuperH. */ - -/* arch-tag: 1b01b84f-f044-4afa-aa4b-caa54ec38966 - (do not change this comment) */ diff --git a/src/m/sparc.h b/src/m/sparc.h index 26ca3caaebe..fc5ea95c0eb 100644 --- a/src/m/sparc.h +++ b/src/m/sparc.h @@ -20,10 +20,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* __sparc__ is defined by the compiler by default. */ -/* XINT must explicitly sign-extend - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long diff --git a/src/m/template.h b/src/m/template.h index 4efc9158a45..0d8e78622a6 100644 --- a/src/m/template.h +++ b/src/m/template.h @@ -22,13 +22,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ does not define it automatically. Ones defined so far include m68k and many others */ -/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend - the 24-bit bit field into an int. In other words, if bit fields - are always unsigned. - - This flag only matters if you use USE_LISP_UNION_TYPE. */ -#define EXPLICIT_SIGN_EXTEND - /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long diff --git a/src/m/xtensa.h b/src/m/xtensa.h deleted file mode 100644 index 8e1da54b25b..00000000000 --- a/src/m/xtensa.h +++ /dev/null @@ -1,6 +0,0 @@ -/* Machine description file for Tensilica Xtensa. - -Add a license notice if this grows to > 10 lines of code. */ - -/* arch-tag: fe5872de-d565-4d81-8fe0-ea19865b3e6a - (do not change this comment) */ diff --git a/src/minibuf.c b/src/minibuf.c index f3a24afc199..0f3def614f2 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -36,8 +36,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "keymap.h" #include "termhooks.h" -extern int quit_char; - /* List of buffers for use as minibuffers. The first element of the list is used for the outermost minibuffer invocation, the next element is used for a recursive minibuffer @@ -2242,5 +2240,3 @@ properties. */); defsubr (&Scompleting_read); } -/* arch-tag: 8f69b601-fba3-484c-a6dd-ceaee54a7a73 - (do not change this comment) */ diff --git a/src/mktime.c b/src/mktime.c index 3570cecd451..ede151981f4 100644 --- a/src/mktime.c +++ b/src/mktime.c @@ -110,9 +110,7 @@ const unsigned short int __mon_yday[2][13] = 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 @@ my_mktime_localtime_r (t, tp) 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 @@ ydhms_tm_diff (year, yday, hour, min, sec, tp) 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 @@ ranged_convert (convert, t, tp) 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 @@ compile-command: "gcc -DDEBUG -DHAVE_LIMITS_H -DSTDC_HEADERS -Wall -W -O -g mkti End: */ -/* arch-tag: 9456752f-7ddd-47cb-8286-fa807b1355ae - (do not change this comment) */ diff --git a/src/msdos.c b/src/msdos.c index 0957221f597..0f9a2ff29e5 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -584,14 +584,14 @@ dos_set_window_size (int *rows, int *cols) if (current_rows != *rows || current_cols != *cols) { struct frame *f = SELECTED_FRAME(); - struct tty_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - Lisp_Object window = dpyinfo->mouse_face_window; + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + Lisp_Object window = hlinfo->mouse_face_window; if (! NILP (window) && XFRAME (XWINDOW (window)->frame) == f) { - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; } } @@ -941,551 +941,79 @@ static Lisp_Object last_mouse_window; static int mouse_preempted = 0; /* non-zero when XMenu gobbles mouse events */ -/* Set the mouse pointer shape according to whether it is in the - area where the mouse highlight is in effect. */ -static void -IT_set_mouse_pointer (int mode) +int +popup_activated (void) { - /* A no-op for now. DOS text-mode mouse pointer doesn't offer too - many possibilities to change its shape, and the available - functionality pretty much sucks (e.g., almost every reasonable - shape will conceal the character it is on). Since the color of - the pointer changes in the highlighted area, it is not clear to - me whether anything else is required, anyway. */ + return mouse_preempted; } -/* Display the active region described by mouse_face_* - in its mouse-face if HL > 0, in its normal face if HL = 0. */ -static void -show_mouse_face (struct tty_display_info *dpyinfo, int hl) +/* Draw TEXT_AREA glyphs between START and END of glyph row ROW on + window W. X is relative to TEXT_AREA in W. HL is a face override + for drawing the glyphs. */ +void +tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, + int start_hpos, int end_hpos, + enum draw_glyphs_face hl) { - struct window *w = XWINDOW (dpyinfo->mouse_face_window); struct frame *f = XFRAME (WINDOW_FRAME (w)); - int i; - struct face *fp; struct tty_display_info *tty = FRAME_TTY (f); + Mouse_HLInfo *hlinfo = &tty->mouse_highlight; - - /* If window is in the process of being destroyed, don't bother - doing anything. */ - if (w->current_matrix == NULL) - goto set_cursor_shape; - - /* Recognize when we are called to operate on rows that don't exist - anymore. This can happen when a window is split. */ - if (dpyinfo->mouse_face_end_row >= w->current_matrix->nrows) - goto set_cursor_shape; - - /* There's no sense to do anything if the mouse face isn't realized. */ - if (hl > 0) - { - if (dpyinfo->mouse_face_hidden) - goto set_cursor_shape; - - fp = FACE_FROM_ID (SELECTED_FRAME(), dpyinfo->mouse_face_face_id); - if (!fp) - goto set_cursor_shape; - } - - /* Note that mouse_face_beg_row etc. are window relative. */ - for (i = dpyinfo->mouse_face_beg_row; - i <= dpyinfo->mouse_face_end_row; - i++) - { - int start_hpos, end_hpos; - struct glyph_row *row = MATRIX_ROW (w->current_matrix, i); - - /* Don't do anything if row doesn't have valid contents. */ - if (!row->enabled_p) - continue; - - /* For all but the first row, the highlight starts at column 0. */ - if (i == dpyinfo->mouse_face_beg_row) - start_hpos = dpyinfo->mouse_face_beg_col; - else - start_hpos = 0; - - if (i == dpyinfo->mouse_face_end_row) - end_hpos = dpyinfo->mouse_face_end_col; - else - end_hpos = row->used[TEXT_AREA]; - - if (end_hpos <= start_hpos) - continue; - /* Record that some glyphs of this row are displayed in - mouse-face. */ - row->mouse_face_p = hl > 0; - if (hl > 0) - { - int vpos = row->y + WINDOW_TOP_EDGE_Y (w); - int kstart = start_hpos + WINDOW_LEFT_EDGE_X (w); - int nglyphs = end_hpos - start_hpos; - int offset = ScreenPrimary + 2*(vpos*screen_size_X + kstart) + 1; - int start_offset = offset; - - if (tty->termscript) - fprintf (tty->termscript, "\n<MH+ %d-%d:%d>", - kstart, kstart + nglyphs - 1, vpos); - - mouse_off (); - IT_set_face (dpyinfo->mouse_face_face_id); - /* Since we are going to change only the _colors_ of the - displayed text, there's no need to go through all the - pain of generating and encoding the text from the glyphs. - Instead, we simply poke the attribute byte of each - affected position in video memory with the colors - computed by IT_set_face! */ - _farsetsel (_dos_ds); - while (nglyphs--) - { - _farnspokeb (offset, ScreenAttrib); - offset += 2; - } - if (screen_virtual_segment) - dosv_refresh_virtual_screen (start_offset, end_hpos - start_hpos); - mouse_on (); - } - else - { - /* We are removing a previously-drawn mouse highlight. The - safest way to do so is to redraw the glyphs anew, since - all kinds of faces and display tables could have changed - behind our back. */ - int nglyphs = end_hpos - start_hpos; - int save_x = new_pos_X, save_y = new_pos_Y; - - if (end_hpos >= row->used[TEXT_AREA]) - nglyphs = row->used[TEXT_AREA] - start_hpos; - - /* IT_write_glyphs writes at cursor position, so we need to - temporarily move cursor coordinates to the beginning of - the highlight region. */ - new_pos_X = start_hpos + WINDOW_LEFT_EDGE_X (w); - new_pos_Y = row->y + WINDOW_TOP_EDGE_Y (w); - - if (tty->termscript) - fprintf (tty->termscript, "<MH- %d-%d:%d>", - new_pos_X, new_pos_X + nglyphs - 1, new_pos_Y); - IT_write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); - if (tty->termscript) - fputs ("\n", tty->termscript); - new_pos_X = save_x; - new_pos_Y = save_y; - } - } - - set_cursor_shape: - /* Change the mouse pointer shape. */ - IT_set_mouse_pointer (hl); -} - -/* Clear out the mouse-highlighted active region. - Redraw it un-highlighted first. */ -static void -clear_mouse_face (struct tty_display_info *dpyinfo) -{ - if (!dpyinfo->mouse_face_hidden && ! NILP (dpyinfo->mouse_face_window)) - show_mouse_face (dpyinfo, 0); - - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; -} - -/* Find the glyph matrix position of buffer position POS in window W. - *HPOS and *VPOS are set to the positions found. W's current glyphs - must be up to date. If POS is above window start return (0, 0). - If POS is after end of W, return end of last line in W. */ -static int -fast_find_position (struct window *w, int pos, int *hpos, int *vpos) -{ - int i, lastcol, line_start_position, maybe_next_line_p = 0; - int yb = window_text_bottom_y (w); - struct glyph_row *row = MATRIX_ROW (w->current_matrix, 0), *best_row = row; - - while (row->y < yb) - { - if (row->used[TEXT_AREA]) - line_start_position = row->glyphs[TEXT_AREA]->charpos; - else - line_start_position = 0; - - if (line_start_position > pos) - break; - /* If the position sought is the end of the buffer, - don't include the blank lines at the bottom of the window. */ - else if (line_start_position == pos - && pos == BUF_ZV (XBUFFER (w->buffer))) - { - maybe_next_line_p = 1; - break; - } - else if (line_start_position > 0) - best_row = row; - - /* Don't overstep the last matrix row, lest we get into the - never-never land... */ - if (row->y + 1 >= yb) - break; - - ++row; - } - - /* Find the right column within BEST_ROW. */ - lastcol = 0; - row = best_row; - for (i = 0; i < row->used[TEXT_AREA]; i++) + if (hl == DRAW_MOUSE_FACE) { - struct glyph *glyph = row->glyphs[TEXT_AREA] + i; - int charpos; + int vpos = row->y + WINDOW_TOP_EDGE_Y (w); + int kstart = start_hpos + WINDOW_LEFT_EDGE_X (w); + int nglyphs = end_hpos - start_hpos; + int offset = ScreenPrimary + 2*(vpos*screen_size_X + kstart) + 1; + int start_offset = offset; - charpos = glyph->charpos; - if (charpos == pos) - { - *hpos = i; - *vpos = row->y; - return 1; - } - else if (charpos > pos) - break; - else if (charpos > 0) - lastcol = i; - } - - /* If we're looking for the end of the buffer, - and we didn't find it in the line we scanned, - use the start of the following line. */ - if (maybe_next_line_p) - { - ++row; - lastcol = 0; - } - - *vpos = row->y; - *hpos = lastcol + 1; - return 0; -} - -/* Take proper action when mouse has moved to the mode or top line of - window W, x-position X. MODE_LINE_P non-zero means mouse is on the - mode line. X is relative to the start of the text display area of - W, so the width of fringes and scroll bars must be subtracted - to get a position relative to the start of the mode line. */ -static void -IT_note_mode_line_highlight (struct window *w, int x, int mode_line_p) -{ - struct glyph_row *row; - - if (mode_line_p) - row = MATRIX_MODE_LINE_ROW (w->current_matrix); - else - row = MATRIX_HEADER_LINE_ROW (w->current_matrix); + if (tty->termscript) + fprintf (tty->termscript, "\n<MH+ %d-%d:%d>", + kstart, kstart + nglyphs - 1, vpos); - if (row->enabled_p) - { - struct glyph *glyph, *end; - Lisp_Object help; - - /* Find the glyph under X. */ - glyph = (row->glyphs[TEXT_AREA] - + x - /* in case someone implements scroll bars some day... */ - - WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w)); - end = glyph + row->used[TEXT_AREA]; - if (glyph < end - && STRINGP (glyph->object) - && STRING_INTERVALS (glyph->object) - && glyph->charpos >= 0 - && glyph->charpos < SCHARS (glyph->object)) + mouse_off (); + IT_set_face (hlinfo->mouse_face_face_id); + /* Since we are going to change only the _colors_ of already + displayed text, there's no need to go through all the pain of + generating and encoding the text from the glyphs. Instead, + we simply poke the attribute byte of each affected position + in video memory with the colors computed by IT_set_face! */ + _farsetsel (_dos_ds); + while (nglyphs--) { - /* If we're on a string with `help-echo' text property, - arrange for the help to be displayed. This is done by - setting the global variable help_echo to the help string. */ - help = Fget_text_property (make_number (glyph->charpos), - Qhelp_echo, glyph->object); - if (!NILP (help)) - { - help_echo_string = help; - XSETWINDOW (help_echo_window, w); - help_echo_object = glyph->object; - help_echo_pos = glyph->charpos; - } + _farnspokeb (offset, ScreenAttrib); + offset += 2; } + if (screen_virtual_segment) + dosv_refresh_virtual_screen (start_offset, end_hpos - start_hpos); + mouse_on (); } -} - -/* Take proper action when the mouse has moved to position X, Y on - frame F as regards highlighting characters that have mouse-face - properties. Also de-highlighting chars where the mouse was before. - X and Y can be negative or out of range. */ -static void -IT_note_mouse_highlight (struct frame *f, int x, int y) -{ - struct tty_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - enum window_part part = ON_NOTHING; - Lisp_Object window; - struct window *w; - - /* When a menu is active, don't highlight because this looks odd. */ - if (mouse_preempted) - return; - - if (NILP (Vmouse_highlight) - || !f->glyphs_initialized_p) - return; - - dpyinfo->mouse_face_mouse_x = x; - dpyinfo->mouse_face_mouse_y = y; - dpyinfo->mouse_face_mouse_frame = f; - - if (dpyinfo->mouse_face_defer) - return; - - if (gc_in_progress) - { - dpyinfo->mouse_face_deferred_gc = 1; - return; - } - - /* Which window is that in? */ - window = window_from_coordinates (f, x, y, &part, &x, &y, 0); - - /* If we were displaying active text in another window, clear that. */ - if (! EQ (window, dpyinfo->mouse_face_window)) - clear_mouse_face (dpyinfo); - - /* Not on a window -> return. */ - if (!WINDOWP (window)) - return; - - /* Convert to window-relative coordinates. */ - w = XWINDOW (window); - - if (part == ON_MODE_LINE || part == ON_HEADER_LINE) - { - /* Mouse is on the mode or top line. */ - IT_note_mode_line_highlight (w, x, part == ON_MODE_LINE); - return; - } - - IT_set_mouse_pointer (0); - - /* Are we in a window whose display is up to date? - And verify the buffer's text has not changed. */ - if (part == ON_TEXT - && EQ (w->window_end_valid, w->buffer) - && XFASTINT (w->last_modified) == BUF_MODIFF (XBUFFER (w->buffer)) - && (XFASTINT (w->last_overlay_modified) - == BUF_OVERLAY_MODIFF (XBUFFER (w->buffer)))) + else if (hl == DRAW_NORMAL_TEXT) { - int pos, i, nrows = w->current_matrix->nrows; - struct glyph_row *row; - struct glyph *glyph; - - /* Find the glyph under X/Y. */ - glyph = NULL; - if (y >= 0 && y < nrows) - { - row = MATRIX_ROW (w->current_matrix, y); - /* Give up if some row before the one we are looking for is - not enabled. */ - for (i = 0; i <= y; i++) - if (!MATRIX_ROW (w->current_matrix, i)->enabled_p) - break; - if (i > y /* all rows upto and including the one at Y are enabled */ - && row->displays_text_p - && x < window_box_width (w, TEXT_AREA)) - { - glyph = row->glyphs[TEXT_AREA]; - if (x >= row->used[TEXT_AREA]) - glyph = NULL; - else - { - glyph += x; - if (!BUFFERP (glyph->object)) - glyph = NULL; - } - } - } + /* We are removing a previously-drawn mouse highlight. The + safest way to do so is to redraw the glyphs anew, since all + kinds of faces and display tables could have changed behind + our back. */ + int nglyphs = end_hpos - start_hpos; + int save_x = new_pos_X, save_y = new_pos_Y; + + if (end_hpos >= row->used[TEXT_AREA]) + nglyphs = row->used[TEXT_AREA] - start_hpos; + + /* IT_write_glyphs writes at cursor position, so we need to + temporarily move cursor coordinates to the beginning of + the highlight region. */ + new_pos_X = start_hpos + WINDOW_LEFT_EDGE_X (w); + new_pos_Y = row->y + WINDOW_TOP_EDGE_Y (w); - /* Clear mouse face if X/Y not over text. */ - if (glyph == NULL) - { - clear_mouse_face (dpyinfo); - return; - } - - if (!BUFFERP (glyph->object)) - abort (); - pos = glyph->charpos; - - /* Check for mouse-face and help-echo. */ - { - Lisp_Object mouse_face, overlay, position, *overlay_vec; - int noverlays, obegv, ozv; - struct buffer *obuf; - - /* If we get an out-of-range value, return now; avoid an error. */ - if (pos > BUF_Z (XBUFFER (w->buffer))) - return; - - /* Make the window's buffer temporarily current for - overlays_at and compute_char_face. */ - obuf = current_buffer; - current_buffer = XBUFFER (w->buffer); - obegv = BEGV; - ozv = ZV; - BEGV = BEG; - ZV = Z; - - /* Is this char mouse-active or does it have help-echo? */ - XSETINT (position, pos); - - /* Put all the overlays we want in a vector in overlay_vec. */ - GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, 0); - /* Sort overlays into increasing priority order. */ - noverlays = sort_overlays (overlay_vec, noverlays, w); - - /* Check mouse-face highlighting. */ - if (! (EQ (window, dpyinfo->mouse_face_window) - && y >= dpyinfo->mouse_face_beg_row - && y <= dpyinfo->mouse_face_end_row - && (y > dpyinfo->mouse_face_beg_row - || x >= dpyinfo->mouse_face_beg_col) - && (y < dpyinfo->mouse_face_end_row - || x < dpyinfo->mouse_face_end_col - || dpyinfo->mouse_face_past_end))) - { - /* Clear the display of the old active region, if any. */ - clear_mouse_face (dpyinfo); - - /* Find highest priority overlay that has a mouse-face prop. */ - overlay = Qnil; - for (i = noverlays - 1; i >= 0; --i) - { - mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face); - if (!NILP (mouse_face)) - { - overlay = overlay_vec[i]; - break; - } - } - - /* If no overlay applies, get a text property. */ - if (NILP (overlay)) - mouse_face = Fget_text_property (position, Qmouse_face, - w->buffer); - - /* Handle the overlay case. */ - if (! NILP (overlay)) - { - /* Find the range of text around this char that - should be active. */ - Lisp_Object before, after; - EMACS_INT ignore; - - before = Foverlay_start (overlay); - after = Foverlay_end (overlay); - /* Record this as the current active region. */ - fast_find_position (w, XFASTINT (before), - &dpyinfo->mouse_face_beg_col, - &dpyinfo->mouse_face_beg_row); - dpyinfo->mouse_face_past_end - = !fast_find_position (w, XFASTINT (after), - &dpyinfo->mouse_face_end_col, - &dpyinfo->mouse_face_end_row); - dpyinfo->mouse_face_window = window; - dpyinfo->mouse_face_face_id - = face_at_buffer_position (w, pos, 0, 0, - &ignore, pos + 1, - !dpyinfo->mouse_face_hidden, - -1); - - /* Display it as active. */ - show_mouse_face (dpyinfo, 1); - } - /* Handle the text property case. */ - else if (! NILP (mouse_face)) - { - /* Find the range of text around this char that - should be active. */ - Lisp_Object before, after, beginning, end; - EMACS_INT ignore; - - beginning = Fmarker_position (w->start); - XSETINT (end, (BUF_Z (XBUFFER (w->buffer)) - - XFASTINT (w->window_end_pos))); - before - = Fprevious_single_property_change (make_number (pos + 1), - Qmouse_face, - w->buffer, beginning); - after - = Fnext_single_property_change (position, Qmouse_face, - w->buffer, end); - /* Record this as the current active region. */ - fast_find_position (w, XFASTINT (before), - &dpyinfo->mouse_face_beg_col, - &dpyinfo->mouse_face_beg_row); - dpyinfo->mouse_face_past_end - = !fast_find_position (w, XFASTINT (after), - &dpyinfo->mouse_face_end_col, - &dpyinfo->mouse_face_end_row); - dpyinfo->mouse_face_window = window; - dpyinfo->mouse_face_face_id - = face_at_buffer_position (w, pos, 0, 0, - &ignore, pos + 1, - !dpyinfo->mouse_face_hidden, - -1); - - /* Display it as active. */ - show_mouse_face (dpyinfo, 1); - } - } - - /* Look for a `help-echo' property. */ - { - Lisp_Object help; - - /* Check overlays first. */ - help = Qnil; - for (i = noverlays - 1; i >= 0 && NILP (help); --i) - { - overlay = overlay_vec[i]; - help = Foverlay_get (overlay, Qhelp_echo); - } - - if (!NILP (help)) - { - help_echo_string = help; - help_echo_window = window; - help_echo_object = overlay; - help_echo_pos = pos; - } - /* Try text properties. */ - else if (NILP (help) - && ((STRINGP (glyph->object) - && glyph->charpos >= 0 - && glyph->charpos < SCHARS (glyph->object)) - || (BUFFERP (glyph->object) - && glyph->charpos >= BEGV - && glyph->charpos < ZV))) - { - help = Fget_text_property (make_number (glyph->charpos), - Qhelp_echo, glyph->object); - if (!NILP (help)) - { - help_echo_string = help; - help_echo_window = window; - help_echo_object = glyph->object; - help_echo_pos = glyph->charpos; - } - } - } - - BEGV = obegv; - ZV = ozv; - current_buffer = obuf; - } + if (tty->termscript) + fprintf (tty->termscript, "<MH- %d-%d:%d>", + new_pos_X, new_pos_X + nglyphs - 1, new_pos_Y); + IT_write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); + if (tty->termscript) + fputs ("\n", tty->termscript); + new_pos_X = save_x; + new_pos_Y = save_y; } } @@ -1689,7 +1217,8 @@ static void IT_update_begin (struct frame *f) { struct tty_display_info *display_info = FRAME_X_DISPLAY_INFO (f); - struct frame *mouse_face_frame = display_info->mouse_face_mouse_frame; + Mouse_HLInfo *hlinfo = &display_info->mouse_highlight; + struct frame *mouse_face_frame = hlinfo->mouse_face_mouse_frame; if (display_info->termscript) fprintf (display_info->termscript, "\n\n<UPDATE_BEGIN"); @@ -1699,28 +1228,28 @@ IT_update_begin (struct frame *f) if (f && f == mouse_face_frame) { /* Don't do highlighting for mouse motion during the update. */ - display_info->mouse_face_defer = 1; + hlinfo->mouse_face_defer = 1; /* If F needs to be redrawn, simply forget about any prior mouse highlighting. */ if (FRAME_GARBAGED_P (f)) - display_info->mouse_face_window = Qnil; + hlinfo->mouse_face_window = Qnil; /* Can we tell that this update does not affect the window where the mouse highlight is? If so, no need to turn off. Likewise, don't do anything if none of the enabled rows contains glyphs highlighted in mouse face. */ - if (!NILP (display_info->mouse_face_window) - && WINDOWP (display_info->mouse_face_window)) + if (!NILP (hlinfo->mouse_face_window) + && WINDOWP (hlinfo->mouse_face_window)) { - struct window *w = XWINDOW (display_info->mouse_face_window); + struct window *w = XWINDOW (hlinfo->mouse_face_window); int i; /* If the mouse highlight is in the window that was deleted (e.g., if it was popped by completion), clear highlight unconditionally. */ if (NILP (w->buffer)) - display_info->mouse_face_window = Qnil; + hlinfo->mouse_face_window = Qnil; else { for (i = 0; i < w->desired_matrix->nrows; ++i) @@ -1730,18 +1259,18 @@ IT_update_begin (struct frame *f) } if (NILP (w->buffer) || i < w->desired_matrix->nrows) - clear_mouse_face (display_info); + clear_mouse_face (hlinfo); } } else if (mouse_face_frame && !FRAME_LIVE_P (mouse_face_frame)) { /* If the frame with mouse highlight was deleted, invalidate the highlight info. */ - display_info->mouse_face_beg_row = display_info->mouse_face_beg_col = -1; - display_info->mouse_face_end_row = display_info->mouse_face_end_col = -1; - display_info->mouse_face_window = Qnil; - display_info->mouse_face_deferred_gc = 0; - display_info->mouse_face_mouse_frame = NULL; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_deferred_gc = 0; + hlinfo->mouse_face_mouse_frame = NULL; } UNBLOCK_INPUT; @@ -1754,25 +1283,25 @@ IT_update_end (struct frame *f) if (dpyinfo->termscript) fprintf (dpyinfo->termscript, "\n<UPDATE_END\n"); - dpyinfo->mouse_face_defer = 0; + dpyinfo->mouse_highlight.mouse_face_defer = 0; } static void IT_frame_up_to_date (struct frame *f) { - struct tty_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); Lisp_Object new_cursor, frame_desired_cursor; struct window *sw; - if (dpyinfo->mouse_face_deferred_gc - || (f && f == dpyinfo->mouse_face_mouse_frame)) + if (hlinfo->mouse_face_deferred_gc + || (f && f == hlinfo->mouse_face_mouse_frame)) { BLOCK_INPUT; - if (dpyinfo->mouse_face_mouse_frame) - IT_note_mouse_highlight (dpyinfo->mouse_face_mouse_frame, - dpyinfo->mouse_face_mouse_x, - dpyinfo->mouse_face_mouse_y); - dpyinfo->mouse_face_deferred_gc = 0; + if (hlinfo->mouse_face_mouse_frame) + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, + hlinfo->mouse_face_mouse_x, + hlinfo->mouse_face_mouse_y); + hlinfo->mouse_face_deferred_gc = 0; UNBLOCK_INPUT; } @@ -2317,18 +1846,18 @@ internal_terminal_init (void) if (colors[1] >= 0 && colors[1] < 16) FRAME_BACKGROUND_PIXEL (SELECTED_FRAME ()) = colors[1]; } - the_only_display_info.mouse_face_mouse_frame = NULL; - the_only_display_info.mouse_face_deferred_gc = 0; - the_only_display_info.mouse_face_beg_row = - the_only_display_info.mouse_face_beg_col = -1; - the_only_display_info.mouse_face_end_row = - the_only_display_info.mouse_face_end_col = -1; - the_only_display_info.mouse_face_face_id = DEFAULT_FACE_ID; - the_only_display_info.mouse_face_window = Qnil; - the_only_display_info.mouse_face_mouse_x = - the_only_display_info.mouse_face_mouse_y = 0; - the_only_display_info.mouse_face_defer = 0; - the_only_display_info.mouse_face_hidden = 0; + the_only_display_info.mouse_highlight.mouse_face_mouse_frame = NULL; + the_only_display_info.mouse_highlight.mouse_face_deferred_gc = 0; + the_only_display_info.mouse_highlight.mouse_face_beg_row = + the_only_display_info.mouse_highlight.mouse_face_beg_col = -1; + the_only_display_info.mouse_highlight.mouse_face_end_row = + the_only_display_info.mouse_highlight.mouse_face_end_col = -1; + the_only_display_info.mouse_highlight.mouse_face_face_id = DEFAULT_FACE_ID; + the_only_display_info.mouse_highlight.mouse_face_window = Qnil; + the_only_display_info.mouse_highlight.mouse_face_mouse_x = + the_only_display_info.mouse_highlight.mouse_face_mouse_y = 0; + the_only_display_info.mouse_highlight.mouse_face_defer = 0; + the_only_display_info.mouse_highlight.mouse_face_hidden = 0; if (have_mouse) /* detected in dos_ttraw, which see */ { @@ -2916,7 +2445,7 @@ dos_rawgetc (void) { struct input_event event; union REGS regs; - struct tty_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (SELECTED_FRAME()); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (SELECTED_FRAME()); EVENT_INIT (event); #ifndef HAVE_X_WINDOWS @@ -3126,10 +2655,10 @@ dos_rawgetc (void) if (code == 0) continue; - if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight)) + if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight)) { - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_hidden = 1; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = 1; } if (code >= 0x100) @@ -3157,10 +2686,10 @@ dos_rawgetc (void) might need to update mouse highlight. */ if (mouse_last_x != mouse_prev_x || mouse_last_y != mouse_prev_y) { - if (dpyinfo->mouse_face_hidden) + if (hlinfo->mouse_face_hidden) { - dpyinfo->mouse_face_hidden = 0; - clear_mouse_face (dpyinfo); + hlinfo->mouse_face_hidden = 0; + clear_mouse_face (hlinfo); } /* Generate SELECT_WINDOW_EVENTs when needed. */ @@ -3169,7 +2698,7 @@ dos_rawgetc (void) 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 @@ -3192,22 +2721,12 @@ dos_rawgetc (void) previous_help_echo_string = help_echo_string; help_echo_string = help_echo_object = help_echo_window = Qnil; help_echo_pos = -1; - IT_note_mouse_highlight (SELECTED_FRAME(), - mouse_last_x, mouse_last_y); + note_mouse_highlight (SELECTED_FRAME(), mouse_last_x, mouse_last_y); /* If the contents of the global variable help_echo has changed, generate a HELP_EVENT. */ if (!NILP (help_echo_string) || !NILP (previous_help_echo_string)) - { - event.kind = HELP_EVENT; - event.frame_or_window = selected_frame; - event.arg = help_echo_object; - event.x = WINDOWP (help_echo_window) - ? help_echo_window : selected_frame; - event.y = help_echo_string; - event.timestamp = event_timestamp (); - event.code = help_echo_pos; - kbd_buffer_store_event (&event); - } + gen_help_event (help_echo_string, selected_frame, help_echo_window, + help_echo_object, help_echo_pos); } for (but = 0; but < NUM_MOUSE_BUTTONS; but++) diff --git a/src/msdos.h b/src/msdos.h index fe9964af25e..d07c28d410e 100644 --- a/src/msdos.h +++ b/src/msdos.h @@ -34,6 +34,7 @@ void dostounix_filename (char *); char *rootrelativepath (char *); void init_environment (int, char **, int); void internal_terminal_init (void); +void initialize_msdos_display (struct terminal *); extern int have_mouse; void mouse_init (void); diff --git a/src/nsfns.m b/src/nsfns.m index db8bbeb5f76..0b105ab6ff1 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1,6 +1,7 @@ /* Functions for the NeXT/Open/GNUstep and MacOSX window system. - Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -1223,8 +1224,6 @@ be shared by the new frame. */) "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); @@ -1697,7 +1696,7 @@ If omitted or nil, the selected frame's display is used. */) DEFUN ("x-display-save-under", Fx_display_save_under, Sx_display_save_under, 0, 1, 0, - doc: /* Non-nil if the Nextstep display server supports the save-under feature. + doc: /* Return t if DISPLAY supports the save-under feature. The optional argument DISPLAY specifies which display to ask about. DISPLAY should be a frame, the display name as a string, or a terminal ID. If omitted or nil, the selected frame's display is used. */) @@ -1722,9 +1721,12 @@ If omitted or nil, the selected frame's display is used. */) DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, - doc: /* Open a connection to a Nextstep display server. + doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. -Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored. */) +Optional second arg XRM-STRING is a string of resources in xrdb format. +If the optional third arg MUST-SUCCEED is non-nil, +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) { struct ns_display_info *dpyinfo; @@ -2201,8 +2203,8 @@ x_sync (struct frame *f) DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Return t if the current Nextstep display supports the color COLOR. -The optional argument FRAME is currently ignored. */) + doc: /* Internal function called by `color-defined-p', which see. +\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { NSColor * col; @@ -2233,10 +2235,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, - doc: /* Return t if the Nextstep display supports color. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame, a display name (a string), or terminal ID. -If omitted or nil, that stands for the selected frame's display. */) + doc: /* Internal function called by `display-color-p', which see. */) (Lisp_Object display) { NSWindowDepth depth; @@ -2430,6 +2429,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, doc: /* Show STRING in a \"tooltip\" window on frame FRAME. A tooltip window is a small window displaying a string. +This is an internal function; Lisp code should call `tooltip-show'. + FRAME nil or omitted means use the selected frame. PARMS is an optional list of frame parameters which can be used to @@ -2675,4 +2676,3 @@ be used as the image of the icon representing the frame. */); } -// arch-tag: dc2a3f74-1123-4daa-8eed-fb78db6a5642 diff --git a/src/nsfont.m b/src/nsfont.m index 115986774d8..b3898758869 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -37,6 +37,7 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu) #include "frame.h" #include "character.h" #include "font.h" +#include "termchar.h" /* TODO: Drop once we can assume gnustep-gui 0.17.1. */ #ifdef NS_IMPL_GNUSTEP @@ -1040,8 +1041,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, face = s->face; break; case NS_DUMPGLYPH_MOUSEFACE: - face = FACE_FROM_ID (s->f, - FRAME_NS_DISPLAY_INFO (s->f)->mouse_face_face_id); + face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id); if (!face) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); break; @@ -1211,7 +1211,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, DPSstroke (context); DPSgrestore (context); - return to-from; } #else /* NS_IMPL_COCOA */ @@ -1280,10 +1279,9 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, } CGContextRestoreGState (gcontext); - return; } #endif /* NS_IMPL_COCOA */ - + return to-from; } diff --git a/src/nsimage.m b/src/nsimage.m index a42950d1f52..81198be0862 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -336,7 +336,7 @@ static EmacsImage *ImageList = nil; NSColor *rgbColor; if (bmRep == nil || color == nil) - return; + return self; if ([color colorSpaceName] != NSCalibratedRGBColorSpace) rgbColor = [color colorUsingColorSpaceName: NSCalibratedRGBColorSpace]; @@ -361,6 +361,8 @@ static EmacsImage *ImageList = nil; planes[2][i] = bb; } } + + return self; } diff --git a/src/nsmenu.m b/src/nsmenu.m index d0276c50bf7..973f2c15e2f 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -23,7 +23,7 @@ Carbon version by Yamamoto Mitsuharu. */ /* This should be the first include, as it may set up #defines affecting interpretation of even the system includes. */ -#include "config.h" +#include <config.h> #include <setjmp.h> #include "lisp.h" @@ -1049,10 +1049,15 @@ update_frame_tool_bar (FRAME_PTR f) { idx = -1; } + helpObj = TOOLPROP (TOOL_BAR_ITEM_HELP); + if (NILP (helpObj)) + helpObj = TOOLPROP (TOOL_BAR_ITEM_CAPTION); + helpText = NILP (helpObj) ? "" : (char *)SDATA (helpObj); + /* Ignore invalid image specifications. */ if (!valid_image_p (image)) { - NSLog (@"Invalid image for toolbar item"); + /* Don't log anything, GNUS makes invalid images all the time. */ continue; } @@ -1066,11 +1071,6 @@ update_frame_tool_bar (FRAME_PTR f) continue; } - helpObj = TOOLPROP (TOOL_BAR_ITEM_HELP); - if (NILP (helpObj)) - helpObj = TOOLPROP (TOOL_BAR_ITEM_CAPTION); - helpText = NILP (helpObj) ? "" : (char *)SDATA (helpObj); - [toolbar addDisplayItemWithImage: img->pixmap idx: i helpText: helpText enabled: enabled_p]; #undef TOOLPROP diff --git a/src/nsterm.h b/src/nsterm.h index 21b18f15cae..7ee960bd7a6 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -492,21 +492,9 @@ struct ns_display_info /* The cursor to use for vertical scroll bars. */ Cursor vertical_scroll_bar_cursor; - /* most mouse face stuff moved in here as of 21+ (and reasonably so) */ - int mouse_face_beg_row, mouse_face_beg_col; - int mouse_face_end_row, mouse_face_end_col; - int mouse_face_beg_x, mouse_face_beg_y; - int mouse_face_end_x, mouse_face_end_y; - int mouse_face_past_end; - Lisp_Object mouse_face_window; - int mouse_face_face_id; - int mouse_face_deferred_gc; - Lisp_Object mouse_face_overlay; - FRAME_PTR mouse_face_mouse_frame; - int mouse_face_mouse_x, mouse_face_mouse_y; - int mouse_face_defer; - int mouse_face_hidden; - int mouse_face_image_state; + /* Information about the range of text currently shown in + mouse-face. */ + Mouse_HLInfo mouse_highlight; struct frame *x_highlight_frame; struct frame *x_focus_frame; diff --git a/src/nsterm.m b/src/nsterm.m index 247ef4dd40c..78d690c020d 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -158,10 +158,20 @@ Lisp_Object ns_right_alternate_modifier; Lisp_Object ns_command_modifier; /* Specifies which emacs modifier should be generated when NS receives + the right Command modifier. Has same values as ns_command_modifier plus + the value Qleft which means whatever value ns_command_modifier has. */ +Lisp_Object ns_right_command_modifier; + +/* Specifies which emacs modifier should be generated when NS receives the Control modifier. May be any of the modifier lisp symbols. */ Lisp_Object ns_control_modifier; /* Specifies which emacs modifier should be generated when NS receives + the right Control modifier. Has same values as ns_control_modifier plus + the value Qleft which means whatever value ns_control_modifier has. */ +Lisp_Object ns_right_control_modifier; + +/* Specifies which emacs modifier should be generated when NS receives the Function modifier (laptops). May be any of the modifier lisp symbols. */ Lisp_Object ns_function_modifier; @@ -223,6 +233,11 @@ static BOOL inNsSelect = 0; /* Convert modifiers in a NeXTSTEP event to emacs style modifiers. */ #define NS_FUNCTION_KEY_MASK 0x800000 +#define NSLeftControlKeyMask (0x000001 | NSControlKeyMask) +#define NSRightControlKeyMask (0x002000 | NSControlKeyMask) +#define NSLeftCommandKeyMask (0x000008 | NSCommandKeyMask) +#define NSRightCommandKeyMask (0x000010 | NSCommandKeyMask) +#define NSLeftAlternateKeyMask (0x000020 | NSAlternateKeyMask) #define NSRightAlternateKeyMask (0x000040 | NSAlternateKeyMask) #define EV_MODIFIERS(e) \ ((([e modifierFlags] & NSHelpKeyMask) ? \ @@ -235,10 +250,18 @@ static BOOL inNsSelect = 0; parse_solitary_modifier (ns_alternate_modifier) : 0) \ | (([e modifierFlags] & NSShiftKeyMask) ? \ shift_modifier : 0) \ + | (!EQ (ns_right_control_modifier, Qleft) && \ + (([e modifierFlags] & NSRightControlKeyMask) \ + == NSRightControlKeyMask) ? \ + parse_solitary_modifier (ns_right_control_modifier) : 0) \ | (([e modifierFlags] & NSControlKeyMask) ? \ parse_solitary_modifier (ns_control_modifier) : 0) \ | (([e modifierFlags] & NS_FUNCTION_KEY_MASK) ? \ parse_solitary_modifier (ns_function_modifier) : 0) \ + | (!EQ (ns_right_command_modifier, Qleft) && \ + (([e modifierFlags] & NSRightCommandKeyMask) \ + == NSRightCommandKeyMask) ? \ + parse_solitary_modifier (ns_right_command_modifier) : 0) \ | (([e modifierFlags] & NSCommandKeyMask) ? \ parse_solitary_modifier (ns_command_modifier):0)) @@ -553,7 +576,7 @@ ns_update_window_begin (struct window *w) -------------------------------------------------------------------------- */ { struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); NSTRACE (ns_update_window_begin); updated_window = w; @@ -561,15 +584,15 @@ ns_update_window_begin (struct window *w) BLOCK_INPUT; - if (f == dpyinfo->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { /* Don't do highlighting for mouse motion during the update. */ - dpyinfo->mouse_face_defer = 1; + hlinfo->mouse_face_defer = 1; /* If the frame needs to be redrawn, simply forget about any prior mouse highlighting. */ if (FRAME_GARBAGED_P (f)) - dpyinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_window = Qnil; /* (further code for mouse faces ifdef'd out in other terms elided) */ } @@ -586,7 +609,7 @@ ns_update_window_end (struct window *w, int cursor_on_p, external (RIF) call; for one window called before update_end -------------------------------------------------------------------------- */ { - struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (XFRAME (w->frame)); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); /* note: this fn is nearly identical in all terms */ if (!w->pseudo_window_p) @@ -608,9 +631,9 @@ ns_update_window_end (struct window *w, int cursor_on_p, frame_up_to_date to redisplay the mouse highlight. */ if (mouse_face_overwritten_p) { - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; } updated_window = NULL; @@ -627,8 +650,8 @@ ns_update_end (struct frame *f) { NSView *view = FRAME_NS_VIEW (f); -/* if (f == FRAME_NS_DISPLAY_INFO (f)->mouse_face_mouse_frame) */ - FRAME_NS_DISPLAY_INFO (f)->mouse_face_defer = 0; +/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ + MOUSE_HL_INFO (f)->mouse_face_defer = 0; BLOCK_INPUT; @@ -1032,6 +1055,7 @@ x_destroy_window (struct frame *f) { NSView *view = FRAME_NS_VIEW (f); struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); NSTRACE (x_destroy_window); check_ns (); @@ -1048,13 +1072,13 @@ x_destroy_window (struct frame *f) dpyinfo->x_focus_frame = 0; if (f == dpyinfo->x_highlight_frame) dpyinfo->x_highlight_frame = 0; - if (f == dpyinfo->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; - dpyinfo->mouse_face_deferred_gc = 0; - dpyinfo->mouse_face_mouse_frame = 0; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_deferred_gc = 0; + hlinfo->mouse_face_mouse_frame = 0; } xfree (f->output_data.ns); @@ -1772,18 +1796,18 @@ ns_frame_up_to_date (struct frame *f) if (FRAME_NS_P (f)) { - struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f); - if ((dpyinfo->mouse_face_deferred_gc||f ==dpyinfo->mouse_face_mouse_frame) - /*&& dpyinfo->mouse_face_mouse_frame*/) + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + if ((hlinfo->mouse_face_deferred_gc || f ==hlinfo->mouse_face_mouse_frame) + /*&& hlinfo->mouse_face_mouse_frame*/) { BLOCK_INPUT; - ns_update_begin(f); - if (dpyinfo->mouse_face_mouse_frame) - note_mouse_highlight (dpyinfo->mouse_face_mouse_frame, - dpyinfo->mouse_face_mouse_x, - dpyinfo->mouse_face_mouse_y); - dpyinfo->mouse_face_deferred_gc = 0; - ns_update_end(f); + ns_update_begin(f); + if (hlinfo->mouse_face_mouse_frame) + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, + hlinfo->mouse_face_mouse_x, + hlinfo->mouse_face_mouse_y); + hlinfo->mouse_face_deferred_gc = 0; + ns_update_end(f); UNBLOCK_INPUT; } } @@ -2595,8 +2619,7 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s) if (s->hl == DRAW_MOUSE_FACE) { - face = FACE_FROM_ID - (s->f, FRAME_NS_DISPLAY_INFO (s->f)->mouse_face_face_id); + face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id); if (!face) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); } @@ -2663,8 +2686,8 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p) struct face *face; if (s->hl == DRAW_MOUSE_FACE) { - face = FACE_FROM_ID - (s->f, FRAME_NS_DISPLAY_INFO (s->f)->mouse_face_face_id); + face = FACE_FROM_ID (s->f, + MOUSE_HL_INFO (s->f)->mouse_face_face_id); if (!face) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); } @@ -2749,15 +2772,17 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) with its background color), we must clear just the image area. */ if (s->hl == DRAW_MOUSE_FACE) { - face = FACE_FROM_ID - (s->f, FRAME_NS_DISPLAY_INFO (s->f)->mouse_face_face_id); + face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id); if (!face) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); } else face = FACE_FROM_ID (s->f, s->first_glyph->face_id); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) set]; + if (s->hl == DRAW_CURSOR) + [FRAME_CURSOR_COLOR (s->f) set]; + else + [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) set]; if (bg_height > s->slice.height || s->img->hmargin || s->img->vmargin || s->img->mask || s->img->pixmap == 0 || s->width != s->background_width) @@ -2820,6 +2845,16 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) s->slice.x == 0, s->slice.x + s->slice.width == s->img->width, s); } + + /* If there is no mask, the background won't be seen, + so draw a rectangle on the image for the cursor. + Do this for all images, getting trancparency right is not reliable. */ + if (s->hl == DRAW_CURSOR) + { + int thickness = abs (s->img->relief); + if (thickness == 0) thickness = 1; + ns_draw_box (br, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1); + } } @@ -2873,8 +2908,7 @@ ns_dumpglyphs_stretch (struct glyph_string *s) if (s->hl == DRAW_MOUSE_FACE) { - face = FACE_FROM_ID - (s->f, FRAME_NS_DISPLAY_INFO (s->f)->mouse_face_face_id); + face = FACE_FROM_ID (s->f, MOUSE_HL_INFO (s->f)->mouse_face_face_id); if (!face) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); } @@ -2975,11 +3009,41 @@ ns_draw_glyph_string (struct glyph_string *s) if (ns_tmp_font == NULL) ns_tmp_font = (struct nsfont_info *)FRAME_FONT (s->f); + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } + ns_tmp_font->font.driver->draw (s, 0, s->nchars, s->x, s->y, (ns_tmp_flags == NS_DUMPGLYPH_NORMAL && !s->background_filled_p) || ns_tmp_flags == NS_DUMPGLYPH_MOUSEFACE); + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } + + ns_unfocus (s->f); + break; + + case GLYPHLESS_GLYPH: + n = ns_get_glyph_string_clip_rect (s, r); + ns_focus (s->f, r, n); + + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); + /* ... */ + /* Not yet implemented. */ + /* ... */ ns_unfocus (s->f); break; @@ -3529,6 +3593,7 @@ ns_initialize_display_info (struct ns_display_info *dpyinfo) { NSScreen *screen = [NSScreen mainScreen]; NSWindowDepth depth = [screen depth]; + Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; dpyinfo->resx = 72.27; /* used 75.0, but this makes pt == pixel, expected */ dpyinfo->resy = 72.27; @@ -3543,16 +3608,16 @@ ns_initialize_display_info (struct ns_display_info *dpyinfo) dpyinfo->color_table->colors = NULL; dpyinfo->root_window = 42; /* a placeholder.. */ - dpyinfo->mouse_face_mouse_frame = NULL; - dpyinfo->mouse_face_deferred_gc = 0; - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_face_id = DEFAULT_FACE_ID; - dpyinfo->mouse_face_window = dpyinfo->mouse_face_overlay = Qnil; - dpyinfo->mouse_face_hidden = 0; + hlinfo->mouse_face_mouse_frame = NULL; + hlinfo->mouse_face_deferred_gc = 0; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; + hlinfo->mouse_face_window = hlinfo->mouse_face_overlay = Qnil; + hlinfo->mouse_face_hidden = 0; - dpyinfo->mouse_face_mouse_x = dpyinfo->mouse_face_mouse_y = 0; - dpyinfo->mouse_face_defer = 0; + hlinfo->mouse_face_mouse_x = hlinfo->mouse_face_mouse_y = 0; + hlinfo->mouse_face_defer = 0; dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame = NULL; @@ -4335,7 +4400,7 @@ ns_term_shutdown (int sig) - (void)keyDown: (NSEvent *)theEvent { - struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (emacsframe); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (emacsframe); int code; unsigned fnKeysym = 0; int flags; @@ -4373,10 +4438,10 @@ ns_term_shutdown (int sig) [NSCursor setHiddenUntilMouseMoves: YES]; - if (dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight)) + if (hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight)) { - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_hidden = 1; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = 1; } if (!processingCompose) @@ -4384,7 +4449,7 @@ ns_term_shutdown (int sig) code = ([[theEvent charactersIgnoringModifiers] length] == 0) ? 0 : [[theEvent charactersIgnoringModifiers] characterAtIndex: 0]; /* (Carbon way: [theEvent keyCode]) */ - + /* is it a "function key"? */ fnKeysym = ns_convert_key (code); if (fnKeysym) @@ -4407,9 +4472,17 @@ ns_term_shutdown (int sig) if (flags & NSShiftKeyMask) emacs_event->modifiers |= shift_modifier; - if (flags & NSCommandKeyMask) + if ((flags & NSRightCommandKeyMask) == NSRightCommandKeyMask) + emacs_event->modifiers |= parse_solitary_modifier + (EQ (ns_right_command_modifier, Qleft) + ? ns_command_modifier + : ns_right_command_modifier); + + if ((flags & NSLeftCommandKeyMask) == NSLeftCommandKeyMask) { - emacs_event->modifiers |= parse_solitary_modifier (ns_command_modifier); + emacs_event->modifiers |= parse_solitary_modifier + (ns_command_modifier); + /* if super (default), take input manager's word so things like dvorak / qwerty layout work */ if (EQ (ns_command_modifier, Qsuper) @@ -4442,23 +4515,43 @@ ns_term_shutdown (int sig) } } - if (flags & NSControlKeyMask) - emacs_event->modifiers |= - parse_solitary_modifier (ns_control_modifier); + if ((flags & NSRightControlKeyMask) == NSRightControlKeyMask) + emacs_event->modifiers |= parse_solitary_modifier + (EQ (ns_right_control_modifier, Qleft) + ? ns_control_modifier + : ns_right_control_modifier); + + if ((flags & NSLeftControlKeyMask) == NSLeftControlKeyMask) + emacs_event->modifiers |= parse_solitary_modifier + (ns_control_modifier); if (flags & NS_FUNCTION_KEY_MASK && !fnKeysym) emacs_event->modifiers |= parse_solitary_modifier (ns_function_modifier); - if (!EQ (ns_right_alternate_modifier, Qleft) - && ((flags & NSRightAlternateKeyMask) == NSRightAlternateKeyMask)) - { - emacs_event->modifiers |= parse_solitary_modifier - (ns_right_alternate_modifier); - } - else if (flags & NSAlternateKeyMask) /* default = meta */ + if ((flags & NSRightAlternateKeyMask) == NSRightAlternateKeyMask) { - if ((NILP (ns_alternate_modifier) || EQ (ns_alternate_modifier, Qnone)) + if ((NILP (ns_right_alternate_modifier) + || EQ (ns_right_alternate_modifier, Qnone)) + && !fnKeysym) + { /* accept pre-interp alt comb */ + if ([[theEvent characters] length] > 0) + code = [[theEvent characters] characterAtIndex: 0]; + /*HACK: clear lone shift modifier to stop next if from firing */ + if (emacs_event->modifiers == shift_modifier) + emacs_event->modifiers = 0; + } + else + emacs_event->modifiers |= parse_solitary_modifier + (EQ (ns_right_alternate_modifier, Qleft) + ? ns_alternate_modifier + : ns_right_alternate_modifier); + } + + if ((flags & NSLeftAlternateKeyMask) == NSLeftAlternateKeyMask) /* default = meta */ + { + if ((NILP (ns_alternate_modifier) + || EQ (ns_alternate_modifier, Qnone)) && !fnKeysym) { /* accept pre-interp alt comb */ if ([[theEvent characters] length] > 0) @@ -4813,7 +4906,7 @@ ns_term_shutdown (int sig) /* Tell emacs the mouse has moved. */ - (void)mouseMoved: (NSEvent *)e { - struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (emacsframe); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (emacsframe); Lisp_Object frame; // NSTRACE (mouseMoved); @@ -4823,10 +4916,10 @@ ns_term_shutdown (int sig) = [self convertPoint: [e locationInWindow] fromView: nil]; /* update any mouse face */ - if (dpyinfo->mouse_face_hidden) + if (hlinfo->mouse_face_hidden) { - dpyinfo->mouse_face_hidden = 0; - clear_mouse_face (dpyinfo); + hlinfo->mouse_face_hidden = 0; + clear_mouse_face (hlinfo); } /* tooltip handling */ @@ -5292,20 +5385,19 @@ ns_term_shutdown (int sig) { NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil]; NSRect r; - struct ns_display_info *dpyinfo - = emacsframe ? FRAME_NS_DISPLAY_INFO (emacsframe) : NULL; + Mouse_HLInfo *hlinfo = emacsframe ? MOUSE_HL_INFO (emacsframe) : NULL; NSTRACE (mouseExited); - if (dpyinfo || !emacsframe) + if (!hlinfo) return; last_mouse_movement_time = EV_TIMESTAMP (theEvent); - if (emacsframe == dpyinfo->mouse_face_mouse_frame) + if (emacsframe == hlinfo->mouse_face_mouse_frame) { - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_mouse_frame = 0; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; } } @@ -5420,7 +5512,7 @@ ns_term_shutdown (int sig) NSTRACE (performDragOperation); if (!emacs_event) - return; + return NO; position = [self convertPoint: [sender draggingLocation] fromView: nil]; x = lrint (position.x); y = lrint (position.y); @@ -6232,11 +6324,27 @@ at all, allowing it to be used at a lower level for accented character entry."); Set to control, meta, alt, super, or hyper means it is taken to be that key."); ns_command_modifier = Qsuper; + DEFVAR_LISP ("ns-right-command-modifier", &ns_right_command_modifier, + "This variable describes the behavior of the right command key.\n\ +Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\ +Set to left means be the same key as `ns-command-modifier'.\n\ +Set to none means that the command / option key is not interpreted by Emacs\n\ +at all, allowing it to be used at a lower level for accented character entry."); + ns_right_command_modifier = Qleft; + DEFVAR_LISP ("ns-control-modifier", &ns_control_modifier, "This variable describes the behavior of the control key.\n\ Set to control, meta, alt, super, or hyper means it is taken to be that key."); ns_control_modifier = Qcontrol; + DEFVAR_LISP ("ns-right-control-modifier", &ns_right_control_modifier, + "This variable describes the behavior of the right control key.\n\ +Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\ +Set to left means be the same key as `ns-control-modifier'.\n\ +Set to none means that the control / option key is not interpreted by Emacs\n\ +at all, allowing it to be used at a lower level for accented character entry."); + ns_right_control_modifier = Qleft; + DEFVAR_LISP ("ns-function-modifier", &ns_function_modifier, "This variable describes the behavior of the function key (on laptops).\n\ Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\ diff --git a/src/print.c b/src/print.c index 0f8718877d2..77cc2916952 100644 --- a/src/print.c +++ b/src/print.c @@ -163,7 +163,7 @@ Lisp_Object Vprint_number_table; void print_interval (INTERVAL interval, Lisp_Object printcharfun); /* GDB resets this to zero on W32 to disable OutputDebugString calls. */ -int print_output_debug_flag = 1; +int print_output_debug_flag EXTERNALLY_VISIBLE = 1; /* Low level output routines for characters and strings */ diff --git a/src/process.c b/src/process.c index e1515065957..6ffcc5b8099 100644 --- a/src/process.c +++ b/src/process.c @@ -56,12 +56,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #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> @@ -115,8 +113,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "nsterm.h" #endif -extern int timers_run; - Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid; Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime; Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs; @@ -3811,7 +3807,7 @@ usage: (make-network-process &rest ARGS) */) } -#if defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) +#if defined(HAVE_NET_IF_H) #ifdef SIOCGIFCONF DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0, @@ -4054,7 +4050,7 @@ FLAGS is the current flags of the interface. */) return any ? res : Qnil; } #endif -#endif /* defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) */ +#endif /* defined(HAVE_NET_IF_H) */ /* Turn off input and output for process PROC. */ @@ -7708,14 +7704,14 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sset_network_process_option); defsubr (&Smake_network_process); defsubr (&Sformat_network_address); -#if defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) +#if defined(HAVE_NET_IF_H) #ifdef SIOCGIFCONF defsubr (&Snetwork_interface_list); #endif #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS) defsubr (&Snetwork_interface_info); #endif -#endif /* defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) */ +#endif /* defined(HAVE_NET_IF_H) */ #ifdef DATAGRAM_SOCKETS defsubr (&Sprocess_datagram_address); defsubr (&Sset_process_datagram_address); @@ -7746,5 +7742,3 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sprocess_attributes); } -/* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4 - (do not change this comment) */ diff --git a/src/regex.c b/src/regex.c index 17158552a95..31f188efa99 100644 --- a/src/regex.c +++ b/src/regex.c @@ -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 @@ xmalloc (size) } 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 @@ extern char *re_syntax_table; 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 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, const re_char *p1, const r /* 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 @@ re_exec (s) 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 @@ WEAK_ALIAS (__regcomp, regcomp) 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 @@ WEAK_ALIAS (__regexec, regexec) 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 @@ WEAK_ALIAS (__regerror, regerror) /* 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 @@ WEAK_ALIAS (__regfree, regfree) #endif /* not emacs */ -/* arch-tag: 4ffd68ba-2a9e-435b-a21a-018990f9eeb2 - (do not change this comment) */ diff --git a/src/s/cygwin.h b/src/s/cygwin.h index 4d58542e660..157ef72f550 100644 --- a/src/s/cygwin.h +++ b/src/s/cygwin.h @@ -101,5 +101,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ returns ENOSYS. A workaround is to set G_SLICE=always-malloc. */ #define G_SLICE_ALWAYS_MALLOC +/* Send signals to subprocesses by "typing" special chars at them. */ +#define SIGNALS_VIA_CHARACTERS + /* arch-tag: 5ae7ba00-83b0-4ab3-806a-3e845779191b (do not change this comment) */ diff --git a/src/s/ms-w32.h b/src/s/ms-w32.h index 4ae5f32e873..826a02bc60f 100644 --- a/src/s/ms-w32.h +++ b/src/s/ms-w32.h @@ -112,7 +112,6 @@ struct sigaction { #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 diff --git a/src/sound.c b/src/sound.c index 3869f3a57ff..6fd23c9ad64 100644 --- a/src/sound.c +++ b/src/sound.c @@ -56,9 +56,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* BEGIN: Non Windows Includes */ #ifndef WINDOWSNT -#ifndef MSDOS #include <sys/ioctl.h> -#endif /* FreeBSD has machine/soundcard.h. Voxware sound driver docs mention sys/soundcard.h. So, let's try whatever's there. */ diff --git a/src/strftime.c b/src/strftime.c index a7617427793..5a0923e3723 100644 --- a/src/strftime.c +++ b/src/strftime.c @@ -179,11 +179,8 @@ extern char *tzname[]; Similarly for localtime_r. */ # if ! HAVE_TM_GMTOFF -static struct tm *my_strftime_gmtime_r (const time_t *, struct tm *); static struct tm * -my_strftime_gmtime_r (t, tp) - const time_t *t; - struct tm *tp; +my_strftime_gmtime_r (const time_t *t, struct tm *tp) { struct tm *l = gmtime (t); if (! l) @@ -192,11 +189,8 @@ my_strftime_gmtime_r (t, tp) return tp; } -static struct tm *my_strftime_localtime_r (const time_t *, struct tm *); static struct tm * -my_strftime_localtime_r (t, tp) - const time_t *t; - struct tm *tp; +my_strftime_localtime_r (const time_t *t, struct tm *tp) { struct tm *l = localtime (t); if (! l) @@ -318,14 +312,10 @@ static const CHAR_T zeroes[16] = /* "0000000000000000" */ # 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 +353,16 @@ static const CHAR_T zeroes[16] = /* "0000000000000000" */ 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); @@ -398,11 +374,8 @@ memcpy_uppcase (dest, src, len LOCALE_PARAM) /* Yield the difference between *A and *B, measured in seconds, ignoring leap seconds. */ # define tm_diff ftime_tm_diff -static int tm_diff (const struct tm *, const struct tm *); static int -tm_diff (a, b) - const struct tm *a; - const struct tm *b; +tm_diff (const struct tm *a, const struct tm *b) { /* Compute intervening leap days correctly even if year is negative. Take care to avoid int overflow in leap day calculations, @@ -437,9 +410,7 @@ static int iso_week_days (int, int); __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,8 +441,7 @@ static CHAR_T const month_name[][10] = #ifdef my_strftime # define extra_args , ut, ns -# define extra_args_spec int ut; int ns; -# define extra_args_spec_iso , int ut, int ns +# define extra_args_spec , int ut, int ns #else # ifdef COMPILE_WIDE # define my_strftime wcsftime @@ -482,7 +452,6 @@ static CHAR_T const month_name[][10] = # endif # define extra_args # define extra_args_spec -# define extra_args_spec_iso /* We don't have this information in general. */ # define ut 0 # define ns 0 @@ -491,15 +460,12 @@ static CHAR_T const month_name[][10] = #if !defined _LIBC && !defined(WINDOWSNT) && HAVE_TZNAME && HAVE_TZSET /* Solaris 2.5 tzset sometimes modifies the storage returned by localtime. Work around this bug by copying *tp before it might be munged. */ - size_t _strftime_copytm (char *, size_t, const char *, - const struct tm * extra_args_spec_iso); size_t - my_strftime (s, maxsize, format, tp extra_args) - CHAR_T *s; - size_t maxsize; - const CHAR_T *format; - const struct tm *tp; - extra_args_spec + _strftime_copytm (CHAR_T *s, size_t maxsize, const CHAR_T *format, + const struct tm *tp extra_args_spec LOCALE_PARAM_DECL); + size_t + my_strftime (CHAR_T *s, size_t maxsize, const CHAR_T *format, + const struct tm *tp extra_args_spec) { struct tm tmcopy; tmcopy = *tp; @@ -517,13 +483,8 @@ static CHAR_T const month_name[][10] = 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 +1435,10 @@ libc_hidden_def (my_strftime) /* 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) */ diff --git a/src/syntax.c b/src/syntax.c index 2f4f5236a40..567f01385d7 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -371,23 +371,10 @@ char_quoted (EMACS_INT charpos, EMACS_INT bytepos) return quoted; } -/* Return the bytepos one character after BYTEPOS. - We assume that BYTEPOS is not at the end of the buffer. */ - -INLINE EMACS_INT -inc_bytepos (EMACS_INT bytepos) -{ - if (NILP (current_buffer->enable_multibyte_characters)) - return bytepos + 1; - - INC_POS (bytepos); - return bytepos; -} - /* Return the bytepos one character before BYTEPOS. We assume that BYTEPOS is not at the start of the buffer. */ -INLINE EMACS_INT +static INLINE EMACS_INT dec_bytepos (EMACS_INT bytepos) { if (NILP (current_buffer->enable_multibyte_characters)) diff --git a/src/sysdep.c b/src/sysdep.c index f68d475d22c..ac766058d34 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -90,12 +90,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #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 @@ struct utimbuf { #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 @@ discard_tty_input (void) { 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 @@ child_setup_tty (int out) #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 @@ child_setup_tty (int out) 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 */ @@ -557,15 +554,6 @@ sys_subshell (void) close_process_descs (); /* Close Emacs's pipes/ptys */ -#ifdef SET_EMACS_PRIORITY - { - extern EMACS_INT emacs_priority; - - if (emacs_priority < 0) - nice (-emacs_priority); - } -#endif - #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ { char *epwd = getenv ("PWD"); @@ -859,7 +847,7 @@ init_sys_modes (struct tty_display_info *tty_out) 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 +993,7 @@ init_sys_modes (struct tty_display_info *tty_out) 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 +1085,16 @@ tabs_safe_p (int fd) { 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 +1256,7 @@ reset_sys_modes (struct tty_display_info *tty_out) #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 +3067,3 @@ system_process_attributes (Lisp_Object pid) #endif /* !defined (WINDOWSNT) */ - -/* arch-tag: edb43589-4e09-4544-b325-978b5b121dcf - (do not change this comment) */ diff --git a/src/systty.h b/src/systty.h index 8c46411cedb..59850e7c321 100644 --- a/src/systty.h +++ b/src/systty.h @@ -26,9 +26,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <fcntl.h> #endif /* not DOS_NT */ -#ifdef HAVE_SYS_IOCTL_H #include <sys/ioctl.h> -#endif #ifdef HPUX #include <sys/bsdtty.h> @@ -86,17 +84,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* 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 +99,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 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 +118,6 @@ struct emacs_tty { #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) */ diff --git a/src/term.c b/src/term.c index 4baea231de3..a684edc5a85 100644 --- a/src/term.c +++ b/src/term.c @@ -66,6 +66,10 @@ extern int tgetent (char *, const char *); extern int tgetflag (char *id); extern int tgetnum (char *id); +char *tparam (char *, char *, int, int, ...); + +extern char *tgetstr (char *, char **); + #include "cm.h" #ifdef HAVE_X_WINDOWS #include "xterm.h" @@ -176,32 +180,15 @@ static int no_controlling_tty; static int system_uses_terminfo; -char *tparam (char *, char *, int, int, ...); - -extern char *tgetstr (char *, char **); #ifdef HAVE_GPM #include <sys/fcntl.h> -static void term_clear_mouse_face (void); -static void term_mouse_highlight (struct frame *f, int x, int y); - /* The device for which we have enabled gpm support (or NULL). */ struct tty_display_info *gpm_tty = NULL; -/* These variables describe the range of text currently shown in its - mouse-face, together with the window they apply to. As long as - the mouse stays within this range, we need not redraw anything on - its account. Rows and columns are glyph matrix positions in - MOUSE_FACE_WINDOW. */ -static int mouse_face_beg_row, mouse_face_beg_col; -static int mouse_face_end_row, mouse_face_end_col; -static int mouse_face_past_end; -static Lisp_Object mouse_face_window; -static int mouse_face_face_id; - -static int pos_x, pos_y; +/* Last recorded mouse coordinates. */ static int last_mouse_x, last_mouse_y; #endif /* HAVE_GPM */ @@ -1501,6 +1488,8 @@ static void append_glyph (struct it *); static void produce_stretch_glyph (struct it *); static void append_composite_glyph (struct it *); static void produce_composite_glyph (struct it *); +static void append_glyphless_glyph (struct it *, int, char *); +static void produce_glyphless_glyph (struct it *, int, Lisp_Object); /* Append glyphs to IT's glyph_row. Called from produce_glyphs for terminal frames if IT->glyph_row != NULL. IT->char_to_display is @@ -1609,6 +1598,12 @@ produce_glyphs (struct it *it) goto done; } + if (it->what == IT_GLYPHLESS) + { + produce_glyphless_glyph (it, 0, Qnil); + goto done; + } + if (it->char_to_display >= 040 && it->char_to_display < 0177) { it->pixel_width = it->nglyphs = 1; @@ -1660,11 +1655,22 @@ produce_glyphs (struct it *it) } else { - it->pixel_width = CHAR_WIDTH (it->char_to_display); - it->nglyphs = it->pixel_width; + Lisp_Object charset_list = FRAME_TERMINAL (it->f)->charset_list; - if (it->glyph_row) - append_glyph (it); + if (char_charset (it->char_to_display, charset_list, NULL)) + { + it->pixel_width = CHAR_WIDTH (it->char_to_display); + it->nglyphs = it->pixel_width; + if (it->glyph_row) + append_glyph (it); + } + else + { + Lisp_Object acronym = lookup_glyphless_char_display (-1, it); + + xassert (it->what == IT_GLYPHLESS); + produce_glyphless_glyph (it, 1, acronym); + } } done: @@ -1844,6 +1850,152 @@ produce_composite_glyph (struct it *it) } +/* Append a glyph for a glyphless character to IT->glyph_row. FACE_ID + 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) +{ + struct glyph *glyph, *end; + int i; + + xassert (it->glyph_row); + glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area]; + end = it->glyph_row->glyphs[1 + it->area]; + + /* If the glyph row is reversed, we need to prepend the glyph rather + than append it. */ + if (it->glyph_row->reversed_p && it->area == TEXT_AREA) + { + struct glyph *g; + int move_by = it->pixel_width; + + /* Make room for the new glyphs. */ + if (move_by > end - glyph) /* don't overstep end of this area */ + move_by = end - glyph; + for (g = glyph - 1; g >= it->glyph_row->glyphs[it->area]; g--) + g[move_by] = *g; + glyph = it->glyph_row->glyphs[it->area]; + end = glyph + move_by; + } + + if (glyph >= end) + return; + glyph->type = CHAR_GLYPH; + glyph->pixel_width = 1; + glyph->face_id = face_id; + glyph->padding_p = 0; + glyph->charpos = CHARPOS (it->position); + glyph->object = it->object; + if (it->bidi_p) + { + glyph->resolved_level = it->bidi_it.resolved_level; + if ((it->bidi_it.type & 7) != it->bidi_it.type) + abort (); + glyph->bidi_type = it->bidi_it.type; + } + else + { + glyph->resolved_level = 0; + glyph->bidi_type = UNKNOWN_BT; + } + + /* BIDI Note: we put the glyphs of characters left to right, even in + the REVERSED_P case because we write to the terminal + left-to-right. */ + for (i = 0; i < it->nglyphs && glyph < end; ++i) + { + if (i > 0) + glyph[0] = glyph[-1]; + glyph->u.ch = str[i]; + ++it->glyph_row->used[it->area]; + ++glyph; + } +} + +/* 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 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 + non-nil, is an acronym string for the character. + + The glyphs actually produced are of type CHAR_GLYPH. */ + +static void +produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym) +{ + int face_id; + int len; + char buf[9], *str = " "; + + /* Get a face ID for the glyph by utilizing a cache (the same way as + done for `escape-glyph' in get_next_display_element). */ + if (it->f == last_glyphless_glyph_frame + && it->face_id == last_glyphless_glyph_face_id) + { + face_id = last_glyphless_glyph_merged_face_id; + } + else + { + /* Merge the `glyphless-char' face into the current face. */ + face_id = merge_faces (it->f, Qglyphless_char, 0, it->face_id); + last_glyphless_glyph_frame = it->f; + last_glyphless_glyph_face_id = it->face_id; + last_glyphless_glyph_merged_face_id = face_id; + } + + 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. */ + len = 1; + } + else if (it->glyphless_method == GLYPHLESS_DISPLAY_EMPTY_BOX) + { + len = CHAR_WIDTH (it->c); + if (len == 0) + len = 1; + else if (len > 4) + len = 4; + sprintf (buf, "[%.*s]", len, str); + len += 2; + str = buf; + } + else + { + if (it->glyphless_method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (! STRINGP (acronym) && CHAR_TABLE_P (Vglyphless_char_display)) + acronym = CHAR_TABLE_REF (Vglyphless_char_display, it->c); + buf[0] = '['; + str = STRINGP (acronym) ? (char *) SDATA (acronym) : ""; + for (len = 0; len < 6 && str[len] && ASCII_BYTE_P (str[len]); len++) + buf[1 + len] = str[len]; + buf[1 + len] = ']'; + len += 2; + } + else + { + xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE); + len = (it->c < 0x10000 ? sprintf (buf, "\\u%04X", it->c) + : it->c <= MAX_UNICODE_CHAR ? sprintf (buf, "\\U%06X", it->c) + : sprintf (buf, "\\x%06X", it->c)); + } + str = buf; + } + + it->pixel_width = len; + it->nglyphs = len; + if (len > 0 && it->glyph_row) + append_glyphless_glyph (it, face_id, str); +} + + /* Get information about special display element WHAT in an environment described by IT. WHAT is one of IT_TRUNCATION or IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a @@ -2517,416 +2669,36 @@ term_mouse_moveto (int x, int y) last_mouse_y = y; */ } -static void -term_show_mouse_face (enum draw_glyphs_face draw) +/* Implementation of draw_row_with_mouse_face for TTY/GPM. */ +void +tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, + int start_hpos, int end_hpos, + enum draw_glyphs_face draw) { - struct window *w = XWINDOW (mouse_face_window); - int save_x, save_y; - int i; - - struct frame *f = XFRAME (w->frame); + int nglyphs = end_hpos - start_hpos; + struct frame *f = XFRAME (WINDOW_FRAME (w)); struct tty_display_info *tty = FRAME_TTY (f); + int face_id = tty->mouse_highlight.mouse_face_face_id; + int save_x, save_y, pos_x, pos_y; - if (/* If window is in the process of being destroyed, don't bother - to do anything. */ - w->current_matrix != NULL - /* Recognize when we are called to operate on rows that don't exist - anymore. This can happen when a window is split. */ - && mouse_face_end_row < w->current_matrix->nrows) - { - /* write_glyphs writes at cursor position, so we need to - temporarily move cursor coordinates to the beginning of - the highlight region. */ - - /* Save current cursor co-ordinates */ - save_y = curY (tty); - save_x = curX (tty); + if (end_hpos >= row->used[TEXT_AREA]) + nglyphs = row->used[TEXT_AREA] - start_hpos; - /* Note that mouse_face_beg_row etc. are window relative. */ - for (i = mouse_face_beg_row; i <= mouse_face_end_row; i++) - { - int start_hpos, end_hpos, nglyphs; - struct glyph_row *row = MATRIX_ROW (w->current_matrix, i); - - /* Don't do anything if row doesn't have valid contents. */ - if (!row->enabled_p) - continue; + pos_y = row->y + WINDOW_TOP_EDGE_Y (w); + pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w); - /* For all but the first row, the highlight starts at column 0. */ - if (i == mouse_face_beg_row) - start_hpos = mouse_face_beg_col; - else - start_hpos = 0; + /* Save current cursor co-ordinates. */ + save_y = curY (tty); + save_x = curX (tty); + cursor_to (f, pos_y, pos_x); - if (i == mouse_face_end_row) - end_hpos = mouse_face_end_col; - else - { - end_hpos = row->used[TEXT_AREA]; - if (draw == DRAW_NORMAL_TEXT) - row->fill_line_p = 1; /* Clear to end of line */ - } + if (draw == DRAW_MOUSE_FACE) + tty_write_glyphs_with_face (f, row->glyphs[TEXT_AREA] + start_hpos, + nglyphs, face_id); + else if (draw == DRAW_NORMAL_TEXT) + write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); - if (end_hpos <= start_hpos) - continue; - /* Record that some glyphs of this row are displayed in - mouse-face. */ - row->mouse_face_p = draw > 0; - - nglyphs = end_hpos - start_hpos; - - if (end_hpos >= row->used[TEXT_AREA]) - nglyphs = row->used[TEXT_AREA] - start_hpos; - - pos_y = row->y + WINDOW_TOP_EDGE_Y (w); - pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos - + WINDOW_LEFT_EDGE_X (w); - - cursor_to (f, pos_y, pos_x); - - if (draw == DRAW_MOUSE_FACE) - { - tty_write_glyphs_with_face (f, row->glyphs[TEXT_AREA] + start_hpos, - nglyphs, mouse_face_face_id); - } - else /* draw == DRAW_NORMAL_TEXT */ - write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); - } - cursor_to (f, save_y, save_x); - } -} - -static void -term_clear_mouse_face (void) -{ - if (!NILP (mouse_face_window)) - term_show_mouse_face (DRAW_NORMAL_TEXT); - - mouse_face_beg_row = mouse_face_beg_col = -1; - mouse_face_end_row = mouse_face_end_col = -1; - mouse_face_window = Qnil; -} - -/* Find the glyph matrix position of buffer position POS in window W. - *HPOS and *VPOS are set to the positions found. W's current glyphs - must be up to date. If POS is above window start return (0, 0). - If POS is after end of W, return end of last line in W. - - taken from msdos.c */ -static int -fast_find_position (struct window *w, EMACS_INT pos, int *hpos, int *vpos) -{ - int i, lastcol, maybe_next_line_p = 0; - EMACS_INT line_start_position; - int yb = window_text_bottom_y (w); - struct glyph_row *row = MATRIX_ROW (w->current_matrix, 0), *best_row = row; - - while (row->y < yb) - { - if (row->used[TEXT_AREA]) - line_start_position = row->glyphs[TEXT_AREA]->charpos; - else - line_start_position = 0; - - if (line_start_position > pos) - break; - /* If the position sought is the end of the buffer, - don't include the blank lines at the bottom of the window. */ - else if (line_start_position == pos - && pos == BUF_ZV (XBUFFER (w->buffer))) - { - maybe_next_line_p = 1; - break; - } - else if (line_start_position > 0) - best_row = row; - - /* Don't overstep the last matrix row, lest we get into the - never-never land... */ - if (row->y + 1 >= yb) - break; - - ++row; - } - - /* Find the right column within BEST_ROW. */ - lastcol = 0; - row = best_row; - for (i = 0; i < row->used[TEXT_AREA]; i++) - { - struct glyph *glyph = row->glyphs[TEXT_AREA] + i; - EMACS_INT charpos; - - charpos = glyph->charpos; - if (charpos == pos) - { - *hpos = i; - *vpos = row->y; - return 1; - } - else if (charpos > pos) - break; - else if (charpos > 0) - lastcol = i; - } - - /* If we're looking for the end of the buffer, - and we didn't find it in the line we scanned, - use the start of the following line. */ - if (maybe_next_line_p) - { - ++row; - lastcol = 0; - } - - *vpos = row->y; - *hpos = lastcol + 1; - return 0; -} - -static void -term_mouse_highlight (struct frame *f, int x, int y) -{ - enum window_part part; - Lisp_Object window; - struct window *w; - struct buffer *b; - - if (NILP (Vmouse_highlight) - || !f->glyphs_initialized_p) - return; - - /* Which window is that in? */ - window = window_from_coordinates (f, x, y, &part, &x, &y, 0); - - /* Not on a window -> return. */ - if (!WINDOWP (window)) - return; - - if (!EQ (window, mouse_face_window)) - term_clear_mouse_face (); - - w = XWINDOW (window); - - /* Are we in a window whose display is up to date? - And verify the buffer's text has not changed. */ - b = XBUFFER (w->buffer); - if (part == ON_TEXT - && EQ (w->window_end_valid, w->buffer) - && XFASTINT (w->last_modified) == BUF_MODIFF (b) - && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b)) - { - int i, nrows = w->current_matrix->nrows; - EMACS_INT pos; - struct glyph_row *row; - struct glyph *glyph; - - /* Find the glyph under X/Y. */ - glyph = NULL; - if (y >= 0 && y < nrows) - { - row = MATRIX_ROW (w->current_matrix, y); - /* Give up if some row before the one we are looking for is - not enabled. */ - for (i = 0; i <= y; i++) - if (!MATRIX_ROW (w->current_matrix, i)->enabled_p) - break; - if (i > y /* all rows upto and including the one at Y are enabled */ - && row->displays_text_p - && x < window_box_width (w, TEXT_AREA)) - { - glyph = row->glyphs[TEXT_AREA]; - if (x >= row->used[TEXT_AREA]) - glyph = NULL; - else - { - glyph += x; - if (!BUFFERP (glyph->object)) - glyph = NULL; - } - } - } - - /* Clear mouse face if X/Y not over text. */ - if (glyph == NULL) - { - term_clear_mouse_face (); - return; - } - - if (!BUFFERP (glyph->object)) - abort (); - pos = glyph->charpos; - - /* Check for mouse-face. */ - { - Lisp_Object mouse_face, overlay, position, *overlay_vec; - int noverlays; - EMACS_INT obegv, ozv; - struct buffer *obuf; - - /* If we get an out-of-range value, return now; avoid an error. */ - if (pos > BUF_Z (b)) - return; - - /* Make the window's buffer temporarily current for - overlays_at and compute_char_face. */ - obuf = current_buffer; - current_buffer = b; - obegv = BEGV; - ozv = ZV; - BEGV = BEG; - ZV = Z; - - /* Is this char mouse-active? */ - XSETINT (position, pos); - - /* Put all the overlays we want in a vector in overlay_vec. */ - GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, 0); - /* Sort overlays into increasing priority order. */ - noverlays = sort_overlays (overlay_vec, noverlays, w); - - /* Check mouse-face highlighting. */ - if (!(EQ (window, mouse_face_window) - && y >= mouse_face_beg_row - && y <= mouse_face_end_row - && (y > mouse_face_beg_row - || x >= mouse_face_beg_col) - && (y < mouse_face_end_row - || x < mouse_face_end_col - || mouse_face_past_end))) - { - /* Clear the display of the old active region, if any. */ - term_clear_mouse_face (); - - /* Find the highest priority overlay that has a mouse-face - property. */ - overlay = Qnil; - for (i = noverlays - 1; i >= 0; --i) - { - mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face); - if (!NILP (mouse_face)) - { - overlay = overlay_vec[i]; - break; - } - } - - /* If no overlay applies, get a text property. */ - if (NILP (overlay)) - mouse_face = Fget_text_property (position, Qmouse_face, - w->buffer); - - /* Handle the overlay case. */ - if (!NILP (overlay)) - { - /* Find the range of text around this char that - should be active. */ - Lisp_Object before, after; - EMACS_INT ignore; - - - before = Foverlay_start (overlay); - after = Foverlay_end (overlay); - /* Record this as the current active region. */ - fast_find_position (w, XFASTINT (before), - &mouse_face_beg_col, - &mouse_face_beg_row); - - mouse_face_past_end - = !fast_find_position (w, XFASTINT (after), - &mouse_face_end_col, - &mouse_face_end_row); - mouse_face_window = window; - - mouse_face_face_id - = face_at_buffer_position (w, pos, 0, 0, - &ignore, pos + 1, 1, -1); - - /* Display it as active. */ - term_show_mouse_face (DRAW_MOUSE_FACE); - } - /* Handle the text property case. */ - else if (!NILP (mouse_face)) - { - /* Find the range of text around this char that - should be active. */ - Lisp_Object before, after, beginning, end; - EMACS_INT ignore; - - beginning = Fmarker_position (w->start); - XSETINT (end, (BUF_Z (b) - XFASTINT (w->window_end_pos))); - before - = Fprevious_single_property_change (make_number (pos + 1), - Qmouse_face, - w->buffer, beginning); - after - = Fnext_single_property_change (position, Qmouse_face, - w->buffer, end); - - /* Record this as the current active region. */ - fast_find_position (w, XFASTINT (before), - &mouse_face_beg_col, - &mouse_face_beg_row); - mouse_face_past_end - = !fast_find_position (w, XFASTINT (after), - &mouse_face_end_col, - &mouse_face_end_row); - mouse_face_window = window; - - mouse_face_face_id - = face_at_buffer_position (w, pos, 0, 0, - &ignore, pos + 1, 1, -1); - - /* Display it as active. */ - term_show_mouse_face (DRAW_MOUSE_FACE); - } - } - - /* Look for a `help-echo' property. */ - { - Lisp_Object help; - - /* Check overlays first. */ - help = Qnil; - for (i = noverlays - 1; i >= 0 && NILP (help); --i) - { - overlay = overlay_vec[i]; - help = Foverlay_get (overlay, Qhelp_echo); - } - - if (!NILP (help)) - { - help_echo_string = help; - help_echo_window = window; - help_echo_object = overlay; - help_echo_pos = pos; - } - /* Try text properties. */ - else if (NILP (help) - && ((STRINGP (glyph->object) - && glyph->charpos >= 0 - && glyph->charpos < SCHARS (glyph->object)) - || (BUFFERP (glyph->object) - && glyph->charpos >= BEGV - && glyph->charpos < ZV))) - { - help = Fget_text_property (make_number (glyph->charpos), - Qhelp_echo, glyph->object); - if (!NILP (help)) - { - help_echo_string = help; - help_echo_window = window; - help_echo_object = glyph->object; - help_echo_pos = glyph->charpos; - } - } - } - - BEGV = obegv; - ZV = ozv; - current_buffer = obuf; - } - } + cursor_to (f, save_y, save_x); } static int @@ -2936,7 +2708,7 @@ term_mouse_movement (FRAME_PTR frame, Gpm_Event *event) if (event->x != last_mouse_x || event->y != last_mouse_y) { frame->mouse_moved = 1; - term_mouse_highlight (frame, event->x, event->y); + note_mouse_highlight (frame, event->x, event->y); /* Remember which glyph we're now on. */ last_mouse_x = event->x; last_mouse_y = event->y; @@ -3309,8 +3081,7 @@ static void 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) @@ -3407,7 +3178,7 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) #ifdef HAVE_GPM terminal->mouse_position_hook = term_mouse_position; - mouse_face_window = Qnil; + tty->mouse_highlight.mouse_face_window = Qnil; #endif @@ -4042,8 +3813,6 @@ bigger, or it may make it blink, or it may do nothing at all. */); #ifdef HAVE_GPM defsubr (&Sgpm_mouse_start); defsubr (&Sgpm_mouse_stop); - - staticpro (&mouse_face_window); #endif /* HAVE_GPM */ #ifndef DOS_NT @@ -4056,7 +3825,3 @@ bigger, or it may make it blink, or it may do nothing at all. */); encode_terminal_dst = NULL; } - - -/* arch-tag: 498e7449-6f2e-45e2-91dd-b7d4ca488193 - (do not change this comment) */ diff --git a/src/termchar.h b/src/termchar.h index 8135ac723e5..ac652640b17 100644 --- a/src/termchar.h +++ b/src/termchar.h @@ -34,18 +34,18 @@ struct tty_output struct tty_display_info { struct tty_display_info *next; /* Chain of all tty devices. */ - + char *name; /* The name of the device file or 0 if stdin/stdout. */ char *type; /* The type of the tty. */ - + /* Input/output */ - + FILE *input; /* The stream to be used for terminal input. NULL if the terminal is suspended. */ FILE *output; /* The stream to be used for terminal output. NULL if the terminal is suspended. */ - + FILE *termscript; /* If nonzero, send all terminal output characters to this stream also. */ @@ -65,38 +65,14 @@ struct tty_display_info /* Redisplay. */ Lisp_Object top_frame; /* The topmost frame on this tty. */ - + /* The previous frame we displayed on this tty. */ struct frame *previous_frame; int previous_color_mode; -#ifdef MSDOS - /* These variables describe the range of text currently shown in its - mouse-face, together with the window they apply to. As long as - the mouse stays within this range, we need not redraw anything on - its account. Rows and columns are glyph matrix positions in - MOUSE_FACE_WINDOW. */ - int mouse_face_beg_row, mouse_face_beg_col; - int mouse_face_end_row, mouse_face_end_col; - int mouse_face_past_end; - Lisp_Object mouse_face_window; - int mouse_face_face_id; - - /* 1 if a mouse motion event came and we didn't handle it right away because - gc was in progress. */ - int mouse_face_deferred_gc; - - /* FRAME and X, Y position of mouse when last checked for - highlighting. X and Y can be negative or out of range for the frame. */ - struct frame *mouse_face_mouse_frame; - int mouse_face_mouse_x, mouse_face_mouse_y; - - /* Nonzero means defer mouse-motion highlighting. */ - int mouse_face_defer; - - /* Nonzero means that the mouse highlight should not be shown. */ - int mouse_face_hidden; -#endif /* !MSDOS */ + /* Information about the range of text currently shown in + mouse-face. */ + Mouse_HLInfo mouse_highlight; /* Buffer used internally by termcap (see tgetent in the Termcap manual). Only init_tty and delete_tty should change this. */ @@ -190,12 +166,12 @@ struct tty_display_info int RPov; /* # chars to start a TS_repeat */ int delete_in_insert_mode; /* delete mode == insert mode */ - + int se_is_so; /* 1 if same string both enters and leaves standout mode */ - + int costs_set; /* Nonzero if costs have been calculated. */ - + int insert_mode; /* Nonzero when in insert mode. */ int standout_mode; /* Nonzero when in standout mode. */ @@ -214,7 +190,7 @@ struct tty_display_info lines from those operations. */ int specified_window; - + /* Flag used in tty_show/hide_cursor. */ int cursor_hidden; diff --git a/src/termhooks.h b/src/termhooks.h index b9358896bae..e71c1159f0c 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -328,6 +328,11 @@ struct terminal /* Parameter alist of this terminal. */ Lisp_Object param_alist; + /* List of charsets supported by the terminal. It is set by + Fset_terminal_coding_system_internal along with + the member terminal_coding. */ + Lisp_Object charset_list; + /* All fields before `next_terminal' should be Lisp_Object and are traced by the GC. All fields afterwards are ignored by the GC. */ diff --git a/src/unexcoff.c b/src/unexcoff.c index 0c6af414d82..fb221dacda2 100644 --- a/src/unexcoff.c +++ b/src/unexcoff.c @@ -141,8 +141,7 @@ report_error_1 (int fd, const char *msg, int a1, int a2) error (msg, a1, a2); } -static int make_hdr (int, int, unsigned, unsigned, unsigned, - const char *, const char *); +static int make_hdr (int, int, const char *, const char *); static int copy_text_and_data (int, int); static int copy_sym (int, int, const char *, const char *); static void mark_x (const char *); diff --git a/src/w16select.c b/src/w16select.c index 4d471e97911..994ad9e543f 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -1,6 +1,7 @@ /* 16-bit Windows Selection processing for emacs on MS-Windows - 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. This file is part of GNU Emacs. @@ -693,18 +694,43 @@ syms_of_win16select (void) defsubr (&Sx_selection_exists_p); DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, - doc: /* Coding system for communicating with other X clients. -When sending or receiving text via cut_buffer, selection, and clipboard, -the text is encoded or decoded by this coding system. -The default value is `iso-latin-1-dos'. */); + doc: /* Coding system for communicating with other programs. + +For MS-Windows and MS-DOS: +When sending or receiving text via selection and clipboard, the text +is encoded or decoded by this coding system. The default value is +the current system default encoding on 9x/Me, `utf-16le-dos' +\(Unicode) on NT/W2K/XP, and `iso-latin-1-dos' on MS-DOS. + +For X Windows: +When sending text via selection and clipboard, if the target +data-type matches with the type of this coding system, it is used +for encoding the text. Otherwise (including the case that this +variable is nil), a proper coding system is used as below: + +data-type coding system +--------- ------------- +UTF8_STRING utf-8 +COMPOUND_TEXT compound-text-with-extensions +STRING iso-latin-1 +C_STRING no-conversion + +When receiving text, if this coding system is non-nil, it is used +for decoding regardless of the data-type. If this is nil, a +proper coding system is used according to the data-type as above. + +See also the documentation of the variable `x-select-request-type' how +to control which data-type to request for receiving text. + +The default value is nil. */); Vselection_coding_system = intern ("iso-latin-1-dos"); DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system, - doc: /* Coding system for the next communication with other X clients. + doc: /* Coding system for the next communication with other programs. Usually, `selection-coding-system' is used for communicating with -other X clients. But, if this variable is set, it is used for the -next communication only. After the communication, this variable is -set to nil. */); +other programs (X Windows clients or MS Windows programs). But, if this +variable is set, it is used for the next communication only. +After the communication, this variable is set to nil. */); Vnext_selection_coding_system = Qnil; QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY); @@ -713,5 +739,3 @@ set to nil. */); #endif /* MSDOS */ -/* arch-tag: 085a22c8-7324-436e-a6da-102464ce95d8 - (do not change this comment) */ diff --git a/src/w32.c b/src/w32.c index ae34ac6aadb..d8c85bf5108 100644 --- a/src/w32.c +++ b/src/w32.c @@ -38,9 +38,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* must include CRT headers *before* config.h */ -#ifdef HAVE_CONFIG_H #include <config.h> -#endif #undef access #undef chdir @@ -97,7 +95,7 @@ typedef struct _MEMORY_STATUS_EX { #include <w32api.h> #if !defined(__MINGW32__) || __W32API_MAJOR_VERSION < 3 || (__W32API_MAJOR_VERSION == 3 && __W32API_MINOR_VERSION < 15) /* This either is not in psapi.h or guarded by higher value of - _WIN32_WINNT than what we use. w32api suplied with MinGW 3.15 + _WIN32_WINNT than what we use. w32api supplied with MinGW 3.15 defines it in psapi.h */ typedef struct _PROCESS_MEMORY_COUNTERS_EX { DWORD cb; @@ -6086,5 +6084,3 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) /* end of w32.c */ -/* arch-tag: 90442dd3-37be-482b-b272-ac752e3049f1 - (do not change this comment) */ diff --git a/src/w32fns.c b/src/w32fns.c index 808503547f1..04358b77bf5 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1,7 +1,8 @@ /* Graphical user interface functions for the Microsoft W32 API. - Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, + 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -81,7 +82,7 @@ extern const char *map_w32_filename (const char *, const char **); 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; @@ -4344,8 +4345,6 @@ This function is an internal primitive--use `make-frame' instead. */) "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, @@ -4510,7 +4509,8 @@ DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0, DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Internal function called by `color-defined-p', which see. */) + doc: /* Internal function called by `color-defined-p', which see. +\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -4850,11 +4850,12 @@ x_display_info_for_name (Lisp_Object name) } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, - 1, 3, 0, doc: /* Open a connection to a server. + 1, 3, 0, doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. Optional second arg XRM-STRING is a string of resources in xrdb format. If the optional third arg MUST-SUCCEED is non-nil, -terminate Emacs if we can't open the connection. */) +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) { unsigned char *xrm_option; @@ -4974,7 +4975,17 @@ DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, } DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0, - doc: /* This is a noop on W32 systems. */) + doc: /* If ON is non-nil, report X errors as soon as the erring request is made. +This function only has an effect on X Windows. With MS Windows, it is +defined but does nothing. + +If ON is nil, allow buffering of requests. +Turning on synchronization prohibits the Xlib routines from buffering +requests and seriously degrades performance, but makes debugging much +easier. +The optional second argument TERMINAL specifies which display to act on. +TERMINAL should be a terminal object, a frame or a display name (a string). +If TERMINAL is omitted or nil, that stands for the selected frame's display. */) (Lisp_Object on, Lisp_Object display) { return Qnil; @@ -4989,11 +5000,12 @@ DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0, DEFUN ("x-change-window-property", Fx_change_window_property, Sx_change_window_property, 2, 6, 0, doc: /* Change window property PROP to VALUE on the X window of FRAME. -VALUE may be a string or a list of conses, numbers and/or strings. -If an element in the list is a string, it is converted to -an Atom and the value of the Atom is used. If an element is a cons, -it is converted to a 32 bit number where the car is the 16 top bits and the -cdr is the lower 16 bits. +PROP must be a string. VALUE may be a string or a list of conses, +numbers and/or strings. If an element in the list is a string, it is +converted to an atom and the value of the Atom is used. If an element +is a cons, it is converted to a 32 bit number where the car is the 16 +top bits and the cdr is the lower 16 bits. + FRAME nil or omitted means use the selected frame. If TYPE is given and non-nil, it is the name of the type of VALUE. If TYPE is not given or nil, the type is STRING. @@ -5001,9 +5013,7 @@ FORMAT gives the size in bits of each element if VALUE is a list. It must be one of 8, 16 or 32. If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8. If OUTER_P is non-nil, the property is changed for the outer X window of -FRAME. Default is to change on the edit X window. - -Value is VALUE. */) +FRAME. Default is to change on the edit X window. */) (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p) { #if 0 /* TODO : port window properties to W32 */ @@ -5057,9 +5067,20 @@ FRAME nil or omitted means use the selected frame. Value is PROP. */) DEFUN ("x-window-property", Fx_window_property, Sx_window_property, 1, 2, 0, doc: /* Value is the value of window property PROP on FRAME. -If FRAME is nil or omitted, use the selected frame. Value is nil -if FRAME hasn't a property with name PROP or if PROP has no string -value. */) +If FRAME is nil or omitted, use the selected frame. + +On MS Windows, this function only accepts the PROP and FRAME arguments. + +On X Windows, the following optional arguments are also accepted: +If TYPE is nil or omitted, get the property as a string. +Otherwise TYPE is the name of the atom that denotes the type expected. +If SOURCE is non-nil, get the property on that window instead of from +FRAME. The number 0 denotes the root window. +If DELETE_P is non-nil, delete the property after retreiving it. +If VECTOR_RET_P is non-nil, don't return a string but a vector of values. + +Value is nil if FRAME hasn't a property with name PROP or if PROP has +no value of TYPE (always string in the MS Windows case). */) (Lisp_Object prop, Lisp_Object frame) { #if 0 /* TODO : port window properties to W32 */ @@ -5634,7 +5655,7 @@ Text larger than the specified size is clipped. */) int root_x, root_y; struct buffer *old_buffer; struct text_pos pos; - int i, width, height; + int i, width, height, seen_reversed_p; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int old_windows_or_buffers_changed = windows_or_buffers_changed; int count = SPECPDL_INDEX (); @@ -5764,7 +5785,7 @@ Text larger than the specified size is clipped. */) try_window (FRAME_ROOT_WINDOW (f), pos, 0); /* Compute width and height of the tooltip. */ - width = height = 0; + width = height = seen_reversed_p = 0; for (i = 0; i < w->desired_matrix->nrows; ++i) { struct glyph_row *row = &w->desired_matrix->rows[i]; @@ -5778,24 +5799,83 @@ Text larger than the specified size is clipped. */) /* Let the row go over the full width of the frame. */ row->full_width_p = 1; -#ifdef TODO /* Investigate why some fonts need more width than is - calculated for some tooltips. */ - /* There's a glyph at the end of rows that is use to place - the cursor there. Don't include the width of this glyph. */ + row_width = row->pixel_width; if (row->used[TEXT_AREA]) { - last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; - row_width = row->pixel_width - last->pixel_width; - } - else + if (!row->reversed_p) + { +#ifdef TODO /* Investigate why some fonts need more width than is + calculated for some tooltips. */ + + /* There's a glyph at the end of rows that is used to + place the cursor there. Don't include the width of + this glyph. */ + last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; + if (INTEGERP (last->object)) + row_width -= last->pixel_width; #endif - row_width = row->pixel_width; + } + else + { + /* There could be a stretch glyph at the beginning of R2L + rows that is produced by extend_face_to_end_of_line. + Don't count that glyph. */ + struct glyph *g = row->glyphs[TEXT_AREA]; + + if (g->type == STRETCH_GLYPH && INTEGERP (g->object)) + { + row_width -= g->pixel_width; + seen_reversed_p = 1; + } + } + } /* TODO: find why tips do not draw along baseline as instructed. */ height += row->height; width = max (width, row_width); } + /* If we've seen partial-length R2L rows, we need to re-adjust the + tool-tip frame width and redisplay it again, to avoid over-wide + tips due to the stretch glyph that extends R2L lines to full + width of the frame. */ + if (seen_reversed_p) + { + /* w->total_cols and FRAME_TOTAL_COLS want the width in columns, + not in pixels. */ + width /= WINDOW_FRAME_COLUMN_WIDTH (w); + w->total_cols = make_number (width); + FRAME_TOTAL_COLS (f) = width; + adjust_glyphs (f); + clear_glyph_matrix (w->desired_matrix); + clear_glyph_matrix (w->current_matrix); + try_window (FRAME_ROOT_WINDOW (f), pos, 0); + width = height = 0; + /* Recompute width and height of the tooltip. */ + for (i = 0; i < w->desired_matrix->nrows; ++i) + { + struct glyph_row *row = &w->desired_matrix->rows[i]; + struct glyph *last; + int row_width; + + if (!row->enabled_p || !row->displays_text_p) + break; + row->full_width_p = 1; + row_width = row->pixel_width; +#ifdef TODO /* See above. */ + if (row->used[TEXT_AREA] && !row->reversed_p) + { + last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; + if (INTEGERP (last->object)) + row_width -= last->pixel_width; + } +#endif + + height += row->height; + width = max (width, row_width); + } + } + /* Add the frame's internal border to the width and height the X window should have. */ height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f); @@ -5948,10 +6028,13 @@ typedef struct DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. -Use a file selection dialog. -Select DEFAULT-FILENAME in the dialog's file selection box, if -specified. Ensure that file exists if MUSTMATCH is non-nil. -If ONLY-DIR-P is non-nil, the user can only select directories. */) +Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file +selection box, if specified. If MUSTMATCH is non-nil, the returned file +or directory must exist. + +This function is only defined on MS Windows, and X Windows with the +Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. +Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p) { struct frame *f = SELECTED_FRAME (); @@ -7243,5 +7326,3 @@ w32_last_error (void) return GetLastError (); } -/* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446 - (do not change this comment) */ diff --git a/src/w32font.c b/src/w32font.c index f489fe2d763..e7c34378e0d 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2377,11 +2377,11 @@ in the font selection dialog. */) 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", diff --git a/src/w32gui.h b/src/w32gui.h index 9cad4f21f21..079cd19a1f1 100644 --- a/src/w32gui.h +++ b/src/w32gui.h @@ -59,13 +59,13 @@ typedef HCURSOR Cursor; /* Dealing with bits of wchar_t as if they were an XChar2b. */ #define STORE_XCHAR2B(chp, byte1, byte2) \ - ((*chp) = ((XChar2b)((((byte1) & 0x00ff) << 8) | ((byte2) & 0x00ff)))) + ((*(chp)) = ((XChar2b)((((byte1) & 0x00ff) << 8) | ((byte2) & 0x00ff)))) #define XCHAR2B_BYTE1(chp) \ - (((*chp) & 0xff00) >> 8) + (((*(chp)) & 0xff00) >> 8) #define XCHAR2B_BYTE2(chp) \ - ((*chp) & 0x00ff) + ((*(chp)) & 0x00ff) /* Windows equivalent of XImage. */ diff --git a/src/w32heap.c b/src/w32heap.c index 285325e3f8b..39ff1017466 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -21,10 +21,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 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 @@ _heap_term (void) #endif -/* arch-tag: 9a6a9860-040d-422d-8905-450dd535cd9c - (do not change this comment) */ diff --git a/src/w32inevt.c b/src/w32inevt.c index 1111f8dfa44..65b57ffa1f7 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -23,10 +23,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ */ -#ifdef HAVE_CONFIG_H #include <config.h> -#endif - #include <stdio.h> #include <windows.h> #include <setjmp.h> @@ -282,7 +279,7 @@ w32_kbd_patch_key (KEY_EVENT_RECORD *event) } -extern char *lispy_function_keys[]; +extern const char *const lispy_function_keys[]; static int faked_key = 0; @@ -784,5 +781,3 @@ w32_console_read_socket (struct terminal *terminal, return ret; } -/* arch-tag: 0bcb39b7-d085-4b85-9070-6750e8c03047 - (do not change this comment) */ diff --git a/src/w32proc.c b/src/w32proc.c index 49687574472..ff6e22d2547 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -32,10 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #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 @@ where the performance impact may be noticeable even on modern hardware. */); 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) */ diff --git a/src/w32select.c b/src/w32select.c index f9bab384062..18694d2d334 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -1,6 +1,7 @@ /* Selection processing for Emacs on the Microsoft W32 API. - Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, + 2008, 2009, 2010 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -1069,10 +1070,34 @@ syms_of_w32select (void) DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, doc: /* Coding system for communicating with other programs. -When sending or receiving text via cut_buffer, selection, and -clipboard, the text is encoded or decoded by this coding system. -The default value is the current system default encoding on 9x/Me and -`utf-16le-dos' (Unicode) on NT/W2K/XP. */); + +For MS-Windows and MS-DOS: +When sending or receiving text via selection and clipboard, the text +is encoded or decoded by this coding system. The default value is +the current system default encoding on 9x/Me, `utf-16le-dos' +\(Unicode) on NT/W2K/XP, and `iso-latin-1-dos' on MS-DOS. + +For X Windows: +When sending text via selection and clipboard, if the target +data-type matches with the type of this coding system, it is used +for encoding the text. Otherwise (including the case that this +variable is nil), a proper coding system is used as below: + +data-type coding system +--------- ------------- +UTF8_STRING utf-8 +COMPOUND_TEXT compound-text-with-extensions +STRING iso-latin-1 +C_STRING no-conversion + +When receiving text, if this coding system is non-nil, it is used +for decoding regardless of the data-type. If this is nil, a +proper coding system is used according to the data-type as above. + +See also the documentation of the variable `x-select-request-type' how +to control which data-type to request for receiving text. + +The default value is nil. */); /* The actual value is set dynamically in the dumped Emacs, see below. */ Vselection_coding_system = Qnil; @@ -1080,9 +1105,9 @@ The default value is the current system default encoding on 9x/Me and DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system, doc: /* Coding system for the next communication with other programs. Usually, `selection-coding-system' is used for communicating with -other programs. But, if this variable is set, it is used for the -next communication only. After the communication, this variable is -set to nil. */); +other programs (X Windows clients or MS Windows programs). But, if this +variable is set, it is used for the next communication only. +After the communication, this variable is set to nil. */); Vnext_selection_coding_system = Qnil; DEFSYM (QCLIPBOARD, "CLIPBOARD"); @@ -1123,5 +1148,3 @@ globals_of_w32select (void) clipboard_owner = create_owner (); } -/* arch-tag: c96e9724-5eb1-4dad-be07-289f092fd2af - (do not change this comment) */ diff --git a/src/w32term.c b/src/w32term.c index 1f53860de2e..7145efbc604 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1,7 +1,8 @@ /* Implementation of GUI terminal on the Microsoft W32 API. - Copyright (C) 1989, 1993, 1994, 1995, 1996, 1997, 1998, - 1999, 2000, 2001, 2002, 2003, 2004, 2005, - 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +Copyright (C) 1989, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, + 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -504,7 +505,7 @@ static void x_update_window_begin (struct window *w) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct w32_display_info *display_info = FRAME_W32_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); /* Hide the system caret during an update. */ if (w32_use_visible_system_caret && w32_system_caret_hwnd) @@ -517,15 +518,15 @@ x_update_window_begin (struct window *w) BLOCK_INPUT; - if (f == display_info->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { /* Don't do highlighting for mouse motion during the update. */ - display_info->mouse_face_defer = 1; + hlinfo->mouse_face_defer = 1; /* If F needs to be redrawn, simply forget about any prior mouse highlighting. */ if (FRAME_GARBAGED_P (f)) - display_info->mouse_face_window = Qnil; + hlinfo->mouse_face_window = Qnil; #if 0 /* Rows in a current matrix containing glyphs in mouse-face have their mouse_face_p flag set, which means that they are always @@ -539,8 +540,8 @@ x_update_window_begin (struct window *w) Likewise, don't do anything if the frame is garbaged; in that case, the frame's current matrix that we would use is all wrong, and we will redisplay that line anyway. */ - if (!NILP (display_info->mouse_face_window) - && w == XWINDOW (display_info->mouse_face_window)) + if (!NILP (hlinfo->mouse_face_window) + && w == XWINDOW (hlinfo->mouse_face_window)) { int i; @@ -549,7 +550,7 @@ x_update_window_begin (struct window *w) break; if (i < w->desired_matrix->nrows) - clear_mouse_face (display_info); + clear_mouse_face (hlinfo); } #endif /* 0 */ } @@ -600,7 +601,7 @@ static void x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritten_p) { - struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (XFRAME (w->frame)); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); if (!w->pseudo_window_p) { @@ -621,9 +622,9 @@ x_update_window_end (struct window *w, int cursor_on_p, XTframe_up_to_date to redisplay the mouse highlight. */ if (mouse_face_overwritten_p) { - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; } /* Unhide the caret. This won't actually show the cursor, unless it @@ -648,7 +649,7 @@ x_update_end (struct frame *f) return; /* Mouse highlight may be displayed again. */ - FRAME_W32_DISPLAY_INFO (f)->mouse_face_defer = 0; + MOUSE_HL_INFO (f)->mouse_face_defer = 0; } @@ -661,17 +662,17 @@ w32_frame_up_to_date (struct frame *f) { if (FRAME_W32_P (f)) { - struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - if (dpyinfo->mouse_face_deferred_gc - || f == dpyinfo->mouse_face_mouse_frame) + if (hlinfo->mouse_face_deferred_gc + || f == hlinfo->mouse_face_mouse_frame) { BLOCK_INPUT; - if (dpyinfo->mouse_face_mouse_frame) - note_mouse_highlight (dpyinfo->mouse_face_mouse_frame, - dpyinfo->mouse_face_mouse_x, - dpyinfo->mouse_face_mouse_y); - dpyinfo->mouse_face_deferred_gc = 0; + if (hlinfo->mouse_face_mouse_frame) + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, + hlinfo->mouse_face_mouse_x, + hlinfo->mouse_face_mouse_y); + hlinfo->mouse_face_deferred_gc = 0; UNBLOCK_INPUT; } } @@ -998,7 +999,7 @@ x_set_mouse_face_gc (struct glyph_string *s) struct face *face; /* What face has to be used last for the mouse face? */ - face_id = FRAME_W32_DISPLAY_INFO (s->f)->mouse_face_face_id; + face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; face = FACE_FROM_ID (s->f, face_id); if (face == NULL) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); @@ -1393,6 +1394,94 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s) } +/* Draw the foreground of glyph string S for glyphless characters. */ + +static void +x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +{ + struct glyph *glyph = s->first_glyph; + XChar2b char2b[8]; + int x, i, j; + int with_background; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + eabs (s->face->box_line_width); + else + x = s->x; + + SetTextColor (s->hdc, s->gc->foreground); + SetBkColor (s->hdc, s->gc->background); + SetTextAlign (s->hdc, TA_BASELINE | TA_LEFT); + + s->char2b = char2b; + with_background = ! (s->for_overlaps + || (s->background_filled_p && s->hl != DRAW_CURSOR)); + for (i = 0; i < s->nchars; i++, glyph++) + { + char buf[7], *str = NULL; + int len = glyph->u.glyphless.len; + + if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (len > 1 + && CHAR_TABLE_P (Vglyphless_char_display) + && (CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) + >= 1)) + { + Lisp_Object acronym + = (! glyph->u.glyphless.for_no_font + ? CHAR_TABLE_REF (Vglyphless_char_display, + glyph->u.glyphless.ch) + : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (STRINGP (acronym)) + str = (char *) SDATA (acronym); + } + } + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) + { + sprintf ((char *) buf, "%0*X", + glyph->u.glyphless.ch < 0x10000 ? 4 : 6, + glyph->u.glyphless.ch); + 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; + int upper_len = (len + 1) / 2; + unsigned code; + HFONT old_font; + + old_font = SelectObject (s->hdc, FONT_HANDLE (font)); + /* 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]); + STORE_XCHAR2B (char2b + j, code >> 8, code & 0xFF); + } + font->driver->draw (s, 0, upper_len, + x + glyph->slice.glyphless.upper_xoff, + s->ybase + glyph->slice.glyphless.upper_yoff, + with_background); + font->driver->draw (s, upper_len, len, + x + glyph->slice.glyphless.lower_xoff, + s->ybase + glyph->slice.glyphless.lower_yoff, + with_background); + SelectObject (s->hdc, old_font); + } + x += glyph->pixel_width; + } +} + + /* Brightness beyond which a color won't have its highlight brightness boosted. @@ -2281,6 +2370,14 @@ x_draw_glyph_string (struct glyph_string *s) x_draw_composite_glyph_string_foreground (s); break; + case GLYPHLESS_GLYPH: + if (s->for_overlaps) + s->background_filled_p = 1; + else + x_draw_glyph_string_background (s, 0); + x_draw_glyphless_glyph_string_foreground (s); + break; + default: abort (); } @@ -3963,6 +4060,7 @@ w32_read_socket (struct terminal *terminal, int expected, W32Msg msg; struct frame *f; struct w32_display_info *dpyinfo = &one_w32_display_info; + Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; if (interrupt_input_blocked) { @@ -4063,11 +4161,11 @@ w32_read_socket (struct terminal *terminal, int expected, if (f && !f->iconified) { - if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) - && !EQ (f->tool_bar_window, dpyinfo->mouse_face_window)) + if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_hidden = 1; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = 1; } if (temp_index == sizeof temp_buffer / sizeof (short)) @@ -4088,11 +4186,11 @@ w32_read_socket (struct terminal *terminal, int expected, if (f && !f->iconified) { - if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) - && !EQ (f->tool_bar_window, dpyinfo->mouse_face_window)) + if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_hidden = 1; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = 1; } if (temp_index == sizeof temp_buffer / sizeof (short)) @@ -4166,11 +4264,11 @@ w32_read_socket (struct terminal *terminal, int expected, if (f && !f->iconified) { - if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) - && !EQ (f->tool_bar_window, dpyinfo->mouse_face_window)) + if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_hidden = 1; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = 1; } if (temp_index == sizeof temp_buffer / sizeof (short)) @@ -4204,10 +4302,10 @@ w32_read_socket (struct terminal *terminal, int expected, else f = x_window_to_frame (dpyinfo, msg.msg.hwnd); - if (dpyinfo->mouse_face_hidden) + if (hlinfo->mouse_face_hidden) { - dpyinfo->mouse_face_hidden = 0; - clear_mouse_face (dpyinfo); + hlinfo->mouse_face_hidden = 0; + clear_mouse_face (hlinfo); } if (f) @@ -4219,7 +4317,7 @@ w32_read_socket (struct terminal *terminal, int expected, 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 @@ -4248,7 +4346,7 @@ w32_read_socket (struct terminal *terminal, int expected, { /* If we move outside the frame, then we're certainly no longer on any text in the frame. */ - clear_mouse_face (dpyinfo); + clear_mouse_face (hlinfo); } /* If the contents of the global variable help_echo_string @@ -4298,7 +4396,7 @@ w32_read_socket (struct terminal *terminal, int expected, 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)) { @@ -4537,12 +4635,12 @@ w32_read_socket (struct terminal *terminal, int expected, f = x_any_window_to_frame (dpyinfo, msg.msg.hwnd); if (f) { - if (f == dpyinfo->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { /* If we move outside the frame, then we're certainly no longer on any text in the frame. */ - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_mouse_frame = 0; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; } /* Generate a nil HELP_EVENT to cancel a help-echo. @@ -4572,12 +4670,12 @@ w32_read_socket (struct terminal *terminal, int expected, if (f == dpyinfo->w32_focus_frame) x_new_focus_frame (dpyinfo, 0); - if (f == dpyinfo->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { /* If we move outside the frame, then we're certainly no longer on any text in the frame. */ - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_mouse_frame = 0; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; } /* Generate a nil HELP_EVENT to cancel a help-echo. @@ -5725,6 +5823,7 @@ void x_free_frame_resources (struct frame *f) { struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); BLOCK_INPUT; @@ -5763,15 +5862,15 @@ x_free_frame_resources (struct frame *f) if (f == dpyinfo->x_highlight_frame) dpyinfo->x_highlight_frame = 0; - if (f == dpyinfo->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { - dpyinfo->mouse_face_beg_row - = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row - = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; - dpyinfo->mouse_face_deferred_gc = 0; - dpyinfo->mouse_face_mouse_frame = 0; + hlinfo->mouse_face_beg_row + = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row + = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_deferred_gc = 0; + hlinfo->mouse_face_mouse_frame = 0; } UNBLOCK_INPUT; @@ -5837,6 +5936,7 @@ void w32_initialize_display_info (Lisp_Object display_name) { struct w32_display_info *dpyinfo = &one_w32_display_info; + Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; memset (dpyinfo, 0, sizeof (*dpyinfo)); @@ -5862,12 +5962,12 @@ w32_initialize_display_info (Lisp_Object display_name) dpyinfo->smallest_font_height = 1; dpyinfo->smallest_char_width = 1; - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_face_id = DEFAULT_FACE_ID; - dpyinfo->mouse_face_window = Qnil; - dpyinfo->mouse_face_overlay = Qnil; - dpyinfo->mouse_face_hidden = 0; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_overlay = Qnil; + hlinfo->mouse_face_hidden = 0; dpyinfo->vertical_scroll_bar_cursor = w32_load_cursor (IDC_ARROW); /* TODO: dpyinfo->gray */ @@ -6336,7 +6436,9 @@ the cursor have no effect. */); doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties. A value of nil means ignore them. If you encounter fonts with bogus UNDERLINE_POSITION font properties, for example 7x13 on XFree prior -to 4.1, set this to nil. */); +to 4.1, set this to nil. You can also use `underline-minimum-offset' +to override the font's UNDERLINE_POSITION for small font display +sizes. */); x_use_underline_position_properties = 0; DEFVAR_BOOL ("x-underline-at-descent-line", @@ -6348,12 +6450,14 @@ baseline level. The default value is nil. */); x_underline_at_descent_line = 0; DEFVAR_LISP ("x-toolkit-scroll-bars", &Vx_toolkit_scroll_bars, - doc: /* If not nil, Emacs uses toolkit scroll bars. */); + doc: /* Which toolkit scroll bars Emacs uses, if any. +A value of nil means Emacs doesn't use toolkit scroll bars. +With the X Window system, the value is a symbol describing the +X toolkit. Possible values are: gtk, motif, xaw, or xaw3d. +With MS Windows, the value is t. */); Vx_toolkit_scroll_bars = Qt; staticpro (&last_mouse_motion_frame); last_mouse_motion_frame = Qnil; } -/* arch-tag: 5fa70624-ab86-499c-8a85-473958ee4646 - (do not change this comment) */ diff --git a/src/w32term.h b/src/w32term.h index ea245144ac3..bd535cae57a 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -143,36 +143,9 @@ struct w32_display_info /* Reusable Graphics Context for drawing a cursor in a non-default face. */ XGCValues *scratch_cursor_gc; - /* These variables describe the range of text currently shown in its - mouse-face, together with the window they apply to. As long as - the mouse stays within this range, we need not redraw anything on - its account. Rows and columns are glyph matrix positions in - MOUSE_FACE_WINDOW. */ - int mouse_face_beg_row, mouse_face_beg_col; - int mouse_face_beg_x, mouse_face_beg_y; - int mouse_face_end_row, mouse_face_end_col; - int mouse_face_end_x, mouse_face_end_y; - int mouse_face_past_end; - Lisp_Object mouse_face_window; - int mouse_face_face_id; - Lisp_Object mouse_face_overlay; - - /* 1 if a mouse motion event came and we didn't handle it right away because - gc was in progress. */ - int mouse_face_deferred_gc; - - /* FRAME and X, Y position of mouse when last checked for - highlighting. X and Y can be negative or out of range for the frame. */ - struct frame *mouse_face_mouse_frame; - int mouse_face_mouse_x, mouse_face_mouse_y; - - /* Nonzero means defer mouse-motion highlighting. */ - int mouse_face_defer; - - /* Nonzero means that the mouse highlight should not be shown. */ - int mouse_face_hidden; - - int mouse_face_image_state; + /* Information about the range of text currently shown in + mouse-face. */ + Mouse_HLInfo mouse_highlight; char *w32_id_name; diff --git a/src/window.c b/src/window.c index 7591401ee42..a2a0c793111 100644 --- a/src/window.c +++ b/src/window.c @@ -755,32 +755,26 @@ display margins, fringes, header line, and/or mode line. */) - 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 @@ coordinates_in_window (register struct window *w, register int *x, register int (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 @@ coordinates_in_window (register struct window *w, register int *x, register int { 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 @@ coordinates_in_window (register struct window *w, register int *x, register int 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 @@ coordinates_in_window (register struct window *w, register int *x, register int 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 @@ coordinates_in_window (register struct window *w, register int *x, register int 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; - } - } - 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; - } + && (eabs (x - right_x) < grabbable_width)) + return ON_VERTICAL_BORDER; } + /* 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 (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; - } + ? (x >= left_x + WINDOW_LEFT_FRINGE_WIDTH (w)) + : (x < left_x + lmargin_width))) + return ON_LEFT_MARGIN; - /* Convert X and Y to window-relative pixel coordinates. */ - *x -= left_x; - *y -= top_y; 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; - } + ? (x < right_x - WINDOW_RIGHT_FRINGE_WIDTH (w)) + : (x >= right_x - rmargin_width))) + return ON_RIGHT_MARGIN; - /* Convert X and Y to window-relative pixel coordinates. */ - *x -= left_x + WINDOW_LEFT_FRINGE_WIDTH (w); - *y -= top_y; 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 @@ If they are in the windows's left or right marginal areas, `left-margin'\n\ 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 @@ If they are in the windows's left or right marginal areas, `left-margin'\n\ struct check_window_data { Lisp_Object *window; - int *x, *y; + int x, y; enum window_part *part; }; @@ -1081,8 +1054,7 @@ check_window_containing (struct window *w, void *user_data) 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 @@ check_window_containing (struct window *w, void *user_data) 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 @@ window_from_coordinates (struct frame *f, int x, int y, enum window_part *part, 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 @@ window_from_coordinates (struct frame *f, int x, int y, enum window_part *part, && 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 @@ column 0. */) + 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 @@ check_all_windows (void) 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.) diff --git a/src/window.h b/src/window.h index e9529487b14..c1148836d79 100644 --- a/src/window.h +++ b/src/window.h @@ -788,8 +788,7 @@ EXFUN (Fset_window_point, 2); 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 @@ extern void foreach_window (struct frame *, 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); diff --git a/src/xdisp.c b/src/xdisp.c index 4c007e572ce..77e9db2e5eb 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1,8 +1,8 @@ /* Display generation from window structure and buffer text. - Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, - 1997, 1998, 1999, 2000, 2001, 2002, 2003, - 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1997, 1998, + 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, + 2010 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -214,11 +214,41 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ leftmost character with special glyphs, which will display as, well, empty. On text terminals, these special glyphs are simply blank characters. On graphics terminals, there's a single stretch - glyph with suitably computed width. Both the blanks and the + glyph of a suitably computed width. Both the blanks and the stretch glyph are given the face of the background of the line. This way, the terminal-specific back-end can still draw the glyphs left to right, even for R2L lines. + Bidirectional display and character compositions + + Some scripts cannot be displayed by drawing each character + individually, because adjacent characters change each other's shape + on display. For example, Arabic and Indic scripts belong to this + category. + + Emacs display supports this by providing "character compositions", + most of which is implemented in composite.c. During the buffer + scan that delivers characters to PRODUCE_GLYPHS, if the next + character to be delivered is a composed character, the iteration + calls composition_reseat_it and next_element_from_composition. If + they succeed to compose the character with one or more of the + following characters, the whole sequence of characters that where + composed is recorded in the `struct composition_it' object that is + part of the buffer iterator. The composed sequence could produce + one or more font glyphs (called "grapheme clusters") on the screen. + Each of these grapheme clusters is then delivered to PRODUCE_GLYPHS + in the direction corresponding to the current bidi scan direction + (recorded in the scan_dir member of the `struct bidi_it' object + that is part of the buffer iterator). In particular, if the bidi + iterator currently scans the buffer backwards, the grapheme + clusters are delivered back to front. This reorders the grapheme + clusters as appropriate for the current bidi context. Note that + this means that the grapheme clusters are always stored in the + LGSTRING object (see composite.c) in the logical order. + + Moving an iterator in bidirectional text + without producing glyphs + Note one important detail mentioned above: that the bidi reordering engine, driven by the iterator, produces characters in R2L rows starting at the character that will be the rightmost on display. @@ -888,6 +918,9 @@ static int clear_face_cache_count; #ifdef HAVE_WINDOW_SYSTEM #define CLEAR_IMAGE_CACHE_COUNT 101 static int clear_image_cache_count; + +/* Null glyph slice */ +static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 }; #endif /* Non-zero while redisplay_internal is in progress. */ @@ -913,10 +946,6 @@ EMACS_INT help_echo_pos; Lisp_Object previous_help_echo_string; -/* Null glyph slice */ - -static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 }; - /* Platform-independent portion of hourglass implementation. */ /* Non-zero means we're allowed to display a hourglass pointer. */ @@ -932,6 +961,21 @@ struct atimer *hourglass_atimer; /* Number of seconds to wait before displaying an hourglass cursor. */ Lisp_Object Vhourglass_delay; +/* Name of the face used to display glyphless characters. */ +Lisp_Object Qglyphless_char; + +/* Char-table to control the display of glyphless characters. */ +Lisp_Object Vglyphless_char_display; + +/* Symbol for the purpose of Vglyphless_char_display. */ +Lisp_Object Qglyphless_char_display; + +/* Method symbols for Vglyphless_char_display. */ +static Lisp_Object Qhex_code, Qempty_box, Qthin_space, Qzero_width; + +/* Default pixel width of `thin-space' display method. */ +#define THIN_SPACE_WIDTH 1 + /* Default number of seconds to wait before displaying an hourglass cursor. */ #define DEFAULT_HOURGLASS_DELAY 1 @@ -960,10 +1004,8 @@ static int text_outside_line_unchanged_p (struct window *, EMACS_INT, EMACS_INT); static void store_mode_line_noprop_char (char); static int store_mode_line_noprop (const unsigned char *, int, int); -static void x_consider_frame_title (Lisp_Object); static void handle_stop (struct it *); static void handle_stop_backwards (struct it *, EMACS_INT); -static int tool_bar_lines_needed (struct frame *, int *); static int single_display_spec_intangible_p (Lisp_Object); static void ensure_echo_area_buffers (void); static Lisp_Object unwind_with_echo_area_buffer (Lisp_Object); @@ -1076,6 +1118,8 @@ static int in_ellipses_for_invisible_text_p (struct display_pos *, #ifdef HAVE_WINDOW_SYSTEM +static void x_consider_frame_title (Lisp_Object); +static int tool_bar_lines_needed (struct frame *, int *); static void update_tool_bar (struct frame *, int); static void build_desired_tool_bar_string (struct frame *f); static int redisplay_tool_bar (struct frame *); @@ -1087,9 +1131,11 @@ static void append_stretch_glyph (struct it *, Lisp_Object, int, int, int); - #endif /* HAVE_WINDOW_SYSTEM */ +static int coords_in_mouse_face_p (struct window *, int, int); + + /*********************************************************************** Window display dimensions @@ -1781,8 +1827,6 @@ glyph_to_pixel_coords (struct window *w, int hpos, int vpos, } -#ifdef HAVE_WINDOW_SYSTEM - /* Find the glyph under window-relative coordinates X/Y in window W. Consider only glyphs from buffer text, i.e. no glyphs from overlay strings. Return in *HPOS and *VPOS the row and column number of @@ -1865,7 +1909,6 @@ x_y_to_hpos_vpos (struct window *w, int x, int y, int *hpos, int *vpos, return glyph; } - /* EXPORT: Convert frame-relative x/y to coordinates relative to window W. Takes pseudo-windows into account. */ @@ -1888,6 +1931,8 @@ frame_to_window_pixel_xy (struct window *w, int *x, int *y) } } +#ifdef HAVE_WINDOW_SYSTEM + /* EXPORT: Return in RECTS[] at most N clipping rectangles for glyph string S. Return the number of stored rectangles. */ @@ -2173,7 +2218,7 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) 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); @@ -2185,6 +2230,9 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) 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); @@ -5731,6 +5779,57 @@ static int (* get_next_element[NUM_IT_METHODS]) (struct it *it) = (IT)->string))) +/* Lookup the char-table Vglyphless_char_display for character C (-1 + if we want information for no-font case), and return the display + method symbol. By side-effect, update it->what and + it->glyphless_method. This function is called from + get_next_display_element for each character element, and from + x_produce_glyphs when no suitable font was found. */ + +Lisp_Object +lookup_glyphless_char_display (int c, struct it *it) +{ + Lisp_Object glyphless_method = Qnil; + + if (CHAR_TABLE_P (Vglyphless_char_display) + && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) >= 1) + glyphless_method = (c >= 0 + ? CHAR_TABLE_REF (Vglyphless_char_display, c) + : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + retry: + if (NILP (glyphless_method)) + { + if (c >= 0) + /* The default is to display the character by a proper font. */ + return Qnil; + /* The default for the no-font case is to display an empty box. */ + glyphless_method = Qempty_box; + } + if (EQ (glyphless_method, Qzero_width)) + { + if (c >= 0) + return glyphless_method; + /* This method can't be used for the no-font case. */ + glyphless_method = Qempty_box; + } + if (EQ (glyphless_method, Qthin_space)) + 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, Qhex_code)) + it->glyphless_method = GLYPHLESS_DISPLAY_HEX_CODE; + else if (STRINGP (glyphless_method)) + it->glyphless_method = GLYPHLESS_DISPLAY_ACRONYM; + else + { + /* Invalid value. We use the default method. */ + glyphless_method = Qnil; + goto retry; + } + it->what = IT_GLYPHLESS; + return glyphless_method; +} + /* Load IT's display element fields with information about the next display element from the current position of IT. Value is zero if end of buffer (or C string) is reached. */ @@ -5739,6 +5838,10 @@ static struct frame *last_escape_glyph_frame = NULL; static unsigned last_escape_glyph_face_id = (1 << FACE_ID_BITS); static int last_escape_glyph_merged_face_id = 0; +struct frame *last_glyphless_glyph_frame = NULL; +unsigned last_glyphless_glyph_face_id = (1 << FACE_ID_BITS); +int last_glyphless_glyph_merged_face_id = 0; + int get_next_display_element (struct it *it) { @@ -5817,6 +5920,15 @@ get_next_display_element (struct it *it) goto get_next; } + if (! NILP (lookup_glyphless_char_display (c, it))) + { + if (it->what == IT_GLYPHLESS) + goto done; + /* Don't display this character. */ + set_iterator_to_next (it, 0); + goto get_next; + } + if (! ASCII_CHAR_P (c) && ! NILP (Vnobreak_char_display)) nbsp_or_shy = (c == 0xA0 ? char_is_nbsp : c == 0xAD ? char_is_soft_hyphen @@ -6031,6 +6143,7 @@ get_next_display_element (struct it *it) } #endif + done: /* Is this character the last one of a run of characters with box? If yes, set IT->end_of_box_run_p to 1. */ if (it->face_box_p @@ -9271,6 +9384,8 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil); current_buffer->truncate_lines = message_truncate_lines ? Qt : Qnil; + if (!NILP (current_buffer->bidi_display_reordering)) + current_buffer->bidi_paragraph_direction = Qleft_to_right; /* Insert new message at BEG. */ TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -10737,7 +10852,7 @@ static int get_tool_bar_item (struct frame *f, int x, int y, struct glyph **glyph, int *hpos, int *vpos, int *prop_idx) { - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tool_bar_window); int area; @@ -10752,14 +10867,14 @@ get_tool_bar_item (struct frame *f, int x, int y, struct glyph **glyph, return -1; /* Is mouse on the highlighted item? */ - if (EQ (f->tool_bar_window, dpyinfo->mouse_face_window) - && *vpos >= dpyinfo->mouse_face_beg_row - && *vpos <= dpyinfo->mouse_face_end_row - && (*vpos > dpyinfo->mouse_face_beg_row - || *hpos >= dpyinfo->mouse_face_beg_col) - && (*vpos < dpyinfo->mouse_face_end_row - || *hpos < dpyinfo->mouse_face_end_col - || dpyinfo->mouse_face_past_end)) + if (EQ (f->tool_bar_window, hlinfo->mouse_face_window) + && *vpos >= hlinfo->mouse_face_beg_row + && *vpos <= hlinfo->mouse_face_end_row + && (*vpos > hlinfo->mouse_face_beg_row + || *hpos >= hlinfo->mouse_face_beg_col) + && (*vpos < hlinfo->mouse_face_end_row + || *hpos < hlinfo->mouse_face_end_col + || hlinfo->mouse_face_past_end)) return 0; return 1; @@ -10776,7 +10891,7 @@ void handle_tool_bar_click (struct frame *f, int x, int y, int down_p, unsigned int modifiers) { - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tool_bar_window); int hpos, vpos, prop_idx; struct glyph *glyph; @@ -10795,8 +10910,8 @@ handle_tool_bar_click (struct frame *f, int x, int y, int down_p, if (down_p) { /* Show item in pressed state. */ - show_mouse_face (dpyinfo, DRAW_IMAGE_SUNKEN); - dpyinfo->mouse_face_image_state = DRAW_IMAGE_SUNKEN; + show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN); + hlinfo->mouse_face_image_state = DRAW_IMAGE_SUNKEN; last_tool_bar_item = prop_idx; } else @@ -10806,8 +10921,8 @@ handle_tool_bar_click (struct frame *f, int x, int y, int down_p, EVENT_INIT (event); /* Show item in released state. */ - show_mouse_face (dpyinfo, DRAW_IMAGE_RAISED); - dpyinfo->mouse_face_image_state = DRAW_IMAGE_RAISED; + show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); + hlinfo->mouse_face_image_state = DRAW_IMAGE_RAISED; key = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_KEY); @@ -10837,6 +10952,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y) Lisp_Object window = f->tool_bar_window; struct window *w = XWINDOW (window); Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int hpos, vpos; struct glyph *glyph; struct glyph_row *row; @@ -10850,7 +10966,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y) values when mouse moves outside of the frame. */ if (x <= 0 || y <= 0) { - clear_mouse_face (dpyinfo); + clear_mouse_face (hlinfo); return; } @@ -10858,14 +10974,14 @@ note_tool_bar_highlight (struct frame *f, int x, int y) if (rc < 0) { /* Not on tool-bar item. */ - clear_mouse_face (dpyinfo); + clear_mouse_face (hlinfo); return; } else if (rc == 0) /* On same tool-bar item as before. */ goto set_help_echo; - clear_mouse_face (dpyinfo); + clear_mouse_face (hlinfo); /* Mouse is down, but on different tool-bar item? */ mouse_down_p = (dpyinfo->grabbed @@ -10875,7 +10991,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y) && last_tool_bar_item != prop_idx) return; - dpyinfo->mouse_face_image_state = DRAW_NORMAL_TEXT; + hlinfo->mouse_face_image_state = DRAW_NORMAL_TEXT; draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED; /* If tool-bar item is not enabled, don't highlight it. */ @@ -10889,22 +11005,22 @@ note_tool_bar_highlight (struct frame *f, int x, int y) x += row->glyphs[TEXT_AREA][i].pixel_width; /* Record this as the current active region. */ - dpyinfo->mouse_face_beg_col = hpos; - dpyinfo->mouse_face_beg_row = vpos; - dpyinfo->mouse_face_beg_x = x; - dpyinfo->mouse_face_beg_y = row->y; - dpyinfo->mouse_face_past_end = 0; - - dpyinfo->mouse_face_end_col = hpos + 1; - dpyinfo->mouse_face_end_row = vpos; - dpyinfo->mouse_face_end_x = x + glyph->pixel_width; - dpyinfo->mouse_face_end_y = row->y; - dpyinfo->mouse_face_window = window; - dpyinfo->mouse_face_face_id = TOOL_BAR_FACE_ID; + hlinfo->mouse_face_beg_col = hpos; + hlinfo->mouse_face_beg_row = vpos; + hlinfo->mouse_face_beg_x = x; + hlinfo->mouse_face_beg_y = row->y; + hlinfo->mouse_face_past_end = 0; + + hlinfo->mouse_face_end_col = hpos + 1; + hlinfo->mouse_face_end_row = vpos; + hlinfo->mouse_face_end_x = x + glyph->pixel_width; + hlinfo->mouse_face_end_y = row->y; + hlinfo->mouse_face_window = window; + hlinfo->mouse_face_face_id = TOOL_BAR_FACE_ID; /* Display it as active. */ - show_mouse_face (dpyinfo, draw); - dpyinfo->mouse_face_image_state = draw; + show_mouse_face (hlinfo, draw); + hlinfo->mouse_face_image_state = draw; } set_help_echo: @@ -11578,6 +11694,8 @@ redisplay_internal (int preserve_echo_area) reconsider_clip_changes (w, current_buffer); last_escape_glyph_frame = NULL; last_escape_glyph_face_id = (1 << FACE_ID_BITS); + last_glyphless_glyph_frame = NULL; + last_glyphless_glyph_face_id = (1 << FACE_ID_BITS); /* If new fonts have been loaded that make a glyph matrix adjustment necessary, do it. */ @@ -12723,6 +12841,15 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, && BUFFERP (glyph->object) && glyph->charpos == pt_old) && bpos_covered < pt_old) { + /* An empty line has a single glyph whose OBJECT is zero and + whose CHARPOS is the position of a newline on that line. + Note that on a TTY, there are more glyphs after that, which + were produced by extend_face_to_end_of_line, but their + CHARPOS is zero or negative. */ + int empty_line_p = + (row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end) + && INTEGERP (glyph->object) && glyph->charpos > 0; + if (row->ends_in_ellipsis_p && pos_after == last_pos) { EMACS_INT ellipsis_pos; @@ -12758,10 +12885,11 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, || (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 + && !empty_line_p + && (row->reversed_p + ? glyph_after > glyphs_end + : glyph_after < glyphs_end))) { cursor = glyph_after; x = -1; @@ -12815,8 +12943,9 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, cursor on that character's glyph. */ EMACS_INT strpos = glyph->charpos; - cursor = glyph; - for (glyph += incr; + if (tem) + cursor = glyph; + for ( ; (row->reversed_p ? glyph > stop : glyph < stop) && EQ (glyph->object, str); glyph += incr) @@ -12832,7 +12961,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, cursor = glyph; break; } - if (glyph->charpos < strpos) + if (tem && glyph->charpos < strpos) { strpos = glyph->charpos; cursor = glyph; @@ -12847,10 +12976,9 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, } /* This string is not what we want; skip all of the glyphs that came from it. */ - do - glyph += incr; while ((row->reversed_p ? glyph > stop : glyph < stop) - && EQ (glyph->object, str)); + && EQ (glyph->object, str)) + glyph += incr; } else glyph += incr; @@ -15333,10 +15461,12 @@ row_containing_pos (struct window *w, EMACS_INT charpos, { struct glyph *g; - if (NILP (XBUFFER (w->buffer)->bidi_display_reordering)) + if (NILP (XBUFFER (w->buffer)->bidi_display_reordering) + || (!best_row && !row->continued_p)) return row; /* In bidi-reordered rows, there could be several rows - occluding point. We need to find the one which fits + occluding point, all of them belonging to the same + continued line. We need to find the row which fits CHARPOS the best. */ for (g = row->glyphs[TEXT_AREA]; g < row->glyphs[TEXT_AREA] + row->used[TEXT_AREA]; @@ -15348,11 +15478,14 @@ row_containing_pos (struct window *w, EMACS_INT charpos, { mindif = eabs (g->charpos - charpos); best_row = row; + /* Exact match always wins. */ + if (mindif == 0) + return best_row; } } } } - else if (best_row) + else if (best_row && !row->continued_p) return best_row; ++row; } @@ -15897,6 +16030,9 @@ try_window_id (struct window *w) + (WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0) + window_internal_height (w)); +#if defined (HAVE_GPM) || defined (MSDOS) + x_clear_window_mouse_face (w); +#endif /* Perform the operation on the screen. */ if (dvpos > 0) { @@ -20651,6 +20787,42 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, } +/* Fill glyph string S from a sequence glyphs for glyphless characters. + See the comment of fill_glyph_string for arguments. + Value is the index of the first glyph not in S. */ + + +static int +fill_glyphless_glyph_string (struct glyph_string *s, int face_id, + int start, int end, int overlaps) +{ + struct glyph *glyph, *last; + int voffset; + + xassert (s->first_glyph->type == GLYPHLESS_GLYPH); + s->for_overlaps = overlaps; + glyph = s->row->glyphs[s->area] + start; + last = s->row->glyphs[s->area] + end; + voffset = glyph->voffset; + s->face = FACE_FROM_ID (s->f, face_id); + s->font = s->face->font; + s->nchars = 1; + s->width = glyph->pixel_width; + glyph++; + while (glyph < last + && glyph->type == GLYPHLESS_GLYPH + && glyph->voffset == voffset + && glyph->face_id == face_id) + { + s->nchars++; + s->width += glyph->pixel_width; + glyph++; + } + s->ybase += voffset; + return glyph - s->row->glyphs[s->area]; +} + + /* Fill glyph string S from a sequence of character glyphs. FACE_ID is the face id of the string. START is the index of the @@ -21161,6 +21333,28 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p) } while (0) +/* Add a glyph string for a sequence of glyphless character's glyphs + to the list of strings between HEAD and TAIL. The meanings of + arguments are the same as those of BUILD_CHAR_GLYPH_STRINGS. */ + +#define BUILD_GLYPHLESS_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \ + do \ + { \ + int face_id; \ + XChar2b *char2b; \ + \ + face_id = (row)->glyphs[area][START].face_id; \ + \ + s = (struct glyph_string *) alloca (sizeof *s); \ + INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \ + append_glyph_string (&HEAD, &TAIL, s); \ + s->x = (X); \ + START = fill_glyphless_glyph_string (s, face_id, START, END, \ + overlaps); \ + } \ + while (0) + + /* Build a list of glyph strings between HEAD and TAIL for the glyphs of AREA of glyph row ROW on window W between indices START and END. HL overrides the face for drawing glyph strings, e.g. it is @@ -21184,7 +21378,7 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p) BUILD_CHAR_GLYPH_STRINGS (START, END, HEAD, TAIL, \ HL, X, LAST_X); \ break; \ - \ + \ case COMPOSITE_GLYPH: \ if (first_glyph->u.cmp.automatic) \ BUILD_GSTRING_GLYPH_STRING (START, END, HEAD, TAIL, \ @@ -21193,21 +21387,26 @@ compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p) BUILD_COMPOSITE_GLYPH_STRING (START, END, HEAD, TAIL, \ HL, X, LAST_X); \ break; \ - \ + \ case STRETCH_GLYPH: \ BUILD_STRETCH_GLYPH_STRING (START, END, HEAD, TAIL, \ HL, X, LAST_X); \ break; \ - \ + \ case IMAGE_GLYPH: \ BUILD_IMAGE_GLYPH_STRING (START, END, HEAD, TAIL, \ HL, X, LAST_X); \ break; \ - \ + \ + case GLYPHLESS_GLYPH: \ + BUILD_GLYPHLESS_GLYPH_STRING (START, END, HEAD, TAIL, \ + HL, X, LAST_X); \ + break; \ + \ default: \ abort (); \ } \ - \ + \ if (s) \ { \ set_glyph_string_background_width (s, START, LAST_X); \ @@ -21291,7 +21490,7 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, if (head && !overlaps && row->contains_overlapping_glyphs_p) { struct glyph_string *h, *t; - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int mouse_beg_col, mouse_end_col, check_mouse_face = 0; int dummy_x = 0; @@ -21301,16 +21500,16 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, { struct glyph_row *mouse_beg_row, *mouse_end_row; - mouse_beg_row = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_beg_row); - mouse_end_row = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_end_row); + mouse_beg_row = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_beg_row); + mouse_end_row = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_end_row); if (row >= mouse_beg_row && row <= mouse_end_row) { check_mouse_face = 1; mouse_beg_col = (row == mouse_beg_row) - ? dpyinfo->mouse_face_beg_col : 0; + ? hlinfo->mouse_face_beg_col : 0; mouse_end_col = (row == mouse_end_row) - ? dpyinfo->mouse_face_end_col + ? hlinfo->mouse_face_end_col : row->used[TEXT_AREA]; } } @@ -22103,6 +22302,229 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, } +/* Append a glyph for a glyphless character to IT->glyph_row. FACE_ID + is a face ID to be used for the glyph. FOR_NO_FONT is nonzero if + 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_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. + + For the other display methods, LEN through LOWER_YOFF are zero. */ + +static void +append_glyphless_glyph (struct it *it, int face_id, int for_no_font, int len, + short upper_xoff, short upper_yoff, + short lower_xoff, short lower_yoff) +{ + struct glyph *glyph; + enum glyph_row_area area = it->area; + + glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area]; + if (glyph < it->glyph_row->glyphs[area + 1]) + { + /* If the glyph row is reversed, we need to prepend the glyph + rather than append it. */ + if (it->glyph_row->reversed_p && area == TEXT_AREA) + { + struct glyph *g; + + /* Make room for the additional glyph. */ + for (g = glyph - 1; g >= it->glyph_row->glyphs[area]; g--) + g[1] = *g; + glyph = it->glyph_row->glyphs[area]; + } + glyph->charpos = CHARPOS (it->position); + glyph->object = it->object; + glyph->pixel_width = it->pixel_width; + glyph->ascent = it->ascent; + glyph->descent = it->descent; + glyph->voffset = it->voffset; + glyph->type = GLYPHLESS_GLYPH; + glyph->u.glyphless.method = it->glyphless_method; + glyph->u.glyphless.for_no_font = for_no_font; + glyph->u.glyphless.len = len; + glyph->u.glyphless.ch = it->c; + glyph->slice.glyphless.upper_xoff = upper_xoff; + glyph->slice.glyphless.upper_yoff = upper_yoff; + glyph->slice.glyphless.lower_xoff = lower_xoff; + glyph->slice.glyphless.lower_yoff = lower_yoff; + glyph->avoid_cursor_p = it->avoid_cursor_p; + glyph->multibyte_p = it->multibyte_p; + glyph->left_box_line_p = it->start_of_box_run_p; + glyph->right_box_line_p = it->end_of_box_run_p; + glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent + || it->phys_descent > it->descent); + glyph->padding_p = 0; + glyph->glyph_not_available_p = 0; + glyph->face_id = face_id; + glyph->font_type = FONT_TYPE_UNKNOWN; + if (it->bidi_p) + { + glyph->resolved_level = it->bidi_it.resolved_level; + if ((it->bidi_it.type & 7) != it->bidi_it.type) + abort (); + glyph->bidi_type = it->bidi_it.type; + } + ++it->glyph_row->used[area]; + } + else + IT_EXPAND_MATRIX_WIDTH (it, area); +} + + +/* Produce a glyph 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. + + FOR_NO_FONT is nonzero if and only if this is for a character for + which no font was found. ACRONYM, if non-nil, is an acronym string + for the character. */ + +static void +produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym) +{ + int face_id; + struct face *face; + struct font *font; + int base_width, base_height, width, height; + short upper_xoff, upper_yoff, lower_xoff, lower_yoff; + int len; + + /* Get the metrics of the base font. We always refer to the current + ASCII face. */ + face = FACE_FROM_ID (it->f, it->face_id)->ascii_face; + font = face->font ? face->font : FRAME_FONT (it->f); + it->ascent = FONT_BASE (font) + font->baseline_offset; + it->descent = FONT_DESCENT (font) - font->baseline_offset; + base_height = it->ascent + it->descent; + base_width = font->average_width; + + /* Get a face ID for the glyph by utilizing a cache (the same way as + doen for `escape-glyph' in get_next_display_element). */ + if (it->f == last_glyphless_glyph_frame + && it->face_id == last_glyphless_glyph_face_id) + { + face_id = last_glyphless_glyph_merged_face_id; + } + else + { + /* Merge the `glyphless-char' face into the current face. */ + face_id = merge_faces (it->f, Qglyphless_char, 0, it->face_id); + last_glyphless_glyph_frame = it->f; + last_glyphless_glyph_face_id = it->face_id; + last_glyphless_glyph_merged_face_id = face_id; + } + + if (it->glyphless_method == GLYPHLESS_DISPLAY_THIN_SPACE) + { + it->pixel_width = THIN_SPACE_WIDTH; + len = 0; + upper_xoff = upper_yoff = lower_xoff = lower_yoff = 0; + } + else if (it->glyphless_method == GLYPHLESS_DISPLAY_EMPTY_BOX) + { + width = CHAR_WIDTH (it->c); + if (width == 0) + width = 1; + else if (width > 4) + width = 4; + it->pixel_width = base_width * width; + len = 0; + upper_xoff = upper_yoff = lower_xoff = lower_yoff = 0; + } + else + { + char buf[7], *str; + unsigned int code[6]; + int upper_len; + int ascent, descent; + struct font_metrics metrics_upper, metrics_lower; + + face = FACE_FROM_ID (it->f, face_id); + font = face->font ? face->font : FRAME_FONT (it->f); + PREPARE_FACE_FOR_DISPLAY (it->f, face); + + if (it->glyphless_method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (! STRINGP (acronym) && CHAR_TABLE_P (Vglyphless_char_display)) + acronym = CHAR_TABLE_REF (Vglyphless_char_display, it->c); + str = STRINGP (acronym) ? (char *) SDATA (acronym) : ""; + } + else + { + xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE); + sprintf (buf, "%0*X", it->c < 0x10000 ? 4 : 6, it->c); + str = buf; + } + for (len = 0; str[len] && ASCII_BYTE_P (str[len]); len++) + code[len] = font->driver->encode_char (font, str[len]); + upper_len = (len + 1) / 2; + font->driver->text_extents (font, code, upper_len, + &metrics_upper); + font->driver->text_extents (font, code + upper_len, len - upper_len, + &metrics_lower); + + + + /* +4 is for vertical bars of a box plus 1-pixel spaces at both side. */ + width = max (metrics_upper.width, metrics_lower.width) + 4; + upper_xoff = upper_yoff = 2; /* the typical case */ + if (base_width >= width) + { + /* Align the upper to the left, the lower to the right. */ + it->pixel_width = base_width; + lower_xoff = base_width - 2 - metrics_lower.width; + } + else + { + /* Center the shorter one. */ + it->pixel_width = width; + if (metrics_upper.width >= metrics_lower.width) + lower_xoff = (width - metrics_lower.width) / 2; + else + upper_xoff = (width - metrics_upper.width) / 2; + } + + /* +5 is for horizontal bars of a box plus 1-pixel spaces at + top, bottom, and between upper and lower strings. */ + height = (metrics_upper.ascent + metrics_upper.descent + + metrics_lower.ascent + metrics_lower.descent) + 5; + /* Center vertically. + H:base_height, D:base_descent + h:height, ld:lower_descent, la:lower_ascent, ud:upper_descent + + ascent = - (D - H/2 - h/2 + 1); "+ 1" for rounding up + descent = D - H/2 + h/2; + lower_yoff = descent - 2 - ld; + upper_yoff = lower_yoff - la - 1 - ud; */ + ascent = - (it->descent - (base_height + height + 1) / 2); + descent = it->descent - (base_height - height) / 2; + lower_yoff = descent - 2 - metrics_lower.descent; + upper_yoff = (lower_yoff - metrics_lower.ascent - 1 + - metrics_upper.descent); + /* Don't make the height shorter than the base height. */ + if (height > base_height) + { + it->ascent = ascent; + it->descent = descent; + } + } + + it->phys_ascent = it->ascent; + it->phys_descent = it->descent; + if (it->glyph_row) + append_glyphless_glyph (it, face_id, for_no_font, len, + upper_xoff, upper_yoff, + lower_xoff, lower_yoff); + it->nglyphs = 1; + take_vertical_position_into_account (it); +} + + /* RIF: Produce glyphs/get display metrics for the display element IT is loaded with. See the description of struct it in dispextern.h @@ -22120,29 +22542,25 @@ x_produce_glyphs (struct it *it) XChar2b char2b; struct face *face = FACE_FROM_ID (it->f, it->face_id); struct font *font = face->font; - int font_not_found_p = font == NULL; struct font_metrics *pcm = NULL; int boff; /* baseline offset */ - if (font_not_found_p) - { - /* When no suitable font found, display an empty box based - on the metrics of the font of the default face (or what - remapped). */ - struct face *no_font_face - = FACE_FROM_ID (it->f, - NILP (Vface_remapping_alist) ? DEFAULT_FACE_ID - : lookup_basic_face (it->f, DEFAULT_FACE_ID)); - font = no_font_face->font; - boff = font->baseline_offset; - } - else + if (font == NULL) { - boff = font->baseline_offset; - if (font->vertical_centering) - boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; + /* When no suitable font is found, display this character by + the method specified in the first extra slot of + Vglyphless_char_display. */ + Lisp_Object acronym = lookup_glyphless_char_display (-1, it); + + xassert (it->what == IT_GLYPHLESS); + produce_glyphless_glyph (it, 1, STRINGP (acronym) ? acronym : Qnil); + goto done; } + boff = font->baseline_offset; + if (font->vertical_centering) + boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; + if (it->char_to_display != '\n' && it->char_to_display != '\t') { int stretched_p; @@ -22161,8 +22579,7 @@ x_produce_glyphs (struct it *it) it->descent = FONT_DESCENT (font) - boff; } - if (! font_not_found_p - && get_char_glyph_code (it->char_to_display, font, &char2b)) + if (get_char_glyph_code (it->char_to_display, font, &char2b)) { pcm = get_per_char_metric (it->f, font, &char2b); if (pcm->width == 0 @@ -22752,11 +23169,14 @@ x_produce_glyphs (struct it *it) if (it->glyph_row) append_composite_glyph (it); } + else if (it->what == IT_GLYPHLESS) + produce_glyphless_glyph (it, 0, Qnil); else if (it->what == IT_IMAGE) produce_image_glyph (it); else if (it->what == IT_STRETCH) produce_stretch_glyph (it); + done: /* Accumulate dimensions. Note: can't assume that it->descent > 0 because this isn't true for images with `:ascent 100'. */ xassert (it->ascent >= 0 && it->descent >= 0); @@ -23028,6 +23448,8 @@ set_frame_cursor_types (struct frame *f, Lisp_Object arg) } +#ifdef HAVE_WINDOW_SYSTEM + /* Return the cursor we want to be displayed in window W. Return width of bar/hbar cursor through WIDTH arg. Return with ACTIVE_CURSOR arg set to 1 if cursor in window W is `active' @@ -23073,10 +23495,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, /* Detect a nonselected window or nonselected frame. */ else if (w != XWINDOW (f->selected_window) -#ifdef HAVE_WINDOW_SYSTEM - || f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame -#endif - ) + || f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame) { *active_cursor = 0; @@ -23117,7 +23536,6 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, /* Use normal cursor if not blinked off. */ if (!w->cursor_off_p) { -#ifdef HAVE_WINDOW_SYSTEM if (glyph != NULL && glyph->type == IMAGE_GLYPH) { if (cursor_type == FILLED_BOX_CURSOR) @@ -23145,7 +23563,6 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, cursor_type = HOLLOW_BOX_CURSOR; } } -#endif return cursor_type; } @@ -23187,8 +23604,6 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, } -#ifdef HAVE_WINDOW_SYSTEM - /* Notice when the text cursor of window W has been completely overwritten by a drawing operation that outputs glyphs in AREA starting at X0 and ending at X1 in the line starting at Y0 and @@ -23354,7 +23769,7 @@ void erase_phys_cursor (struct window *w) { struct frame *f = XFRAME (w->frame); - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int hpos = w->phys_cursor.hpos; int vpos = w->phys_cursor.vpos; int mouse_face_here_p = 0; @@ -23410,14 +23825,8 @@ erase_phys_cursor (struct window *w) /* If the cursor is in the mouse face area, redisplay that when we clear the cursor. */ - if (! NILP (dpyinfo->mouse_face_window) - && w == XWINDOW (dpyinfo->mouse_face_window) - && (vpos > dpyinfo->mouse_face_beg_row - || (vpos == dpyinfo->mouse_face_beg_row - && hpos >= dpyinfo->mouse_face_beg_col)) - && (vpos < dpyinfo->mouse_face_end_row - || (vpos == dpyinfo->mouse_face_end_row - && hpos < dpyinfo->mouse_face_end_col)) + if (! NILP (hlinfo->mouse_face_window) + && coords_in_mouse_face_p (w, hpos, vpos) /* Don't redraw the cursor's spot in mouse face if it is at the end of a line (on a newline). The cursor appears there, but mouse highlighting does not. */ @@ -23608,30 +24017,50 @@ x_clear_cursor (struct window *w) update_window_cursor (w, 0); } +#endif /* HAVE_WINDOW_SYSTEM */ + +/* Implementation of draw_row_with_mouse_face for GUI sessions, GPM, + and MSDOS. */ +void +draw_row_with_mouse_face (struct window *w, int start_x, struct glyph_row *row, + int start_hpos, int end_hpos, + enum draw_glyphs_face draw) +{ +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (XFRAME (w->frame))) + { + draw_glyphs (w, start_x, row, TEXT_AREA, start_hpos, end_hpos, draw, 0); + return; + } +#endif +#if defined (HAVE_GPM) || defined (MSDOS) + tty_draw_row_with_mouse_face (w, row, start_hpos, end_hpos, draw); +#endif +} /* EXPORT: Display the active region described by mouse_face_* according to DRAW. */ void -show_mouse_face (Display_Info *dpyinfo, enum draw_glyphs_face draw) +show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) { - struct window *w = XWINDOW (dpyinfo->mouse_face_window); + struct window *w = XWINDOW (hlinfo->mouse_face_window); struct frame *f = XFRAME (WINDOW_FRAME (w)); if (/* If window is in the process of being destroyed, don't bother to do anything. */ w->current_matrix != NULL /* Don't update mouse highlight if hidden */ - && (draw != DRAW_MOUSE_FACE || !dpyinfo->mouse_face_hidden) + && (draw != DRAW_MOUSE_FACE || !hlinfo->mouse_face_hidden) /* Recognize when we are called to operate on rows that don't exist anymore. This can happen when a window is split. */ - && dpyinfo->mouse_face_end_row < w->current_matrix->nrows) + && hlinfo->mouse_face_end_row < w->current_matrix->nrows) { int phys_cursor_on_p = w->phys_cursor_on_p; struct glyph_row *row, *first, *last; - first = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_beg_row); - last = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_end_row); + first = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_beg_row); + last = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_end_row); for (row = first; row <= last && row->enabled_p; ++row) { @@ -23640,8 +24069,30 @@ show_mouse_face (Display_Info *dpyinfo, enum draw_glyphs_face draw) /* For all but the first row, the highlight starts at column 0. */ if (row == first) { - start_hpos = dpyinfo->mouse_face_beg_col; - start_x = dpyinfo->mouse_face_beg_x; + /* R2L rows have BEG and END in reversed order, but the + screen drawing geometry is always left to right. So + we need to mirror the beginning and end of the + highlighted area in R2L rows. */ + if (!row->reversed_p) + { + start_hpos = hlinfo->mouse_face_beg_col; + start_x = hlinfo->mouse_face_beg_x; + } + else if (row == last) + { + start_hpos = hlinfo->mouse_face_end_col; + start_x = hlinfo->mouse_face_end_x; + } + else + { + start_hpos = 0; + start_x = 0; + } + } + else if (row->reversed_p && row == last) + { + start_hpos = hlinfo->mouse_face_end_col; + start_x = hlinfo->mouse_face_end_x; } else { @@ -23650,7 +24101,20 @@ show_mouse_face (Display_Info *dpyinfo, enum draw_glyphs_face draw) } if (row == last) - end_hpos = dpyinfo->mouse_face_end_col; + { + if (!row->reversed_p) + end_hpos = hlinfo->mouse_face_end_col; + else if (row == first) + end_hpos = hlinfo->mouse_face_beg_col; + else + { + end_hpos = row->used[TEXT_AREA]; + if (draw == DRAW_NORMAL_TEXT) + row->fill_line_p = 1; /* Clear to end of line */ + } + } + else if (row->reversed_p && row == first) + end_hpos = hlinfo->mouse_face_beg_col; else { end_hpos = row->used[TEXT_AREA]; @@ -23660,18 +24124,19 @@ show_mouse_face (Display_Info *dpyinfo, enum draw_glyphs_face draw) if (end_hpos > start_hpos) { - draw_glyphs (w, start_x, row, TEXT_AREA, - start_hpos, end_hpos, - draw, 0); + draw_row_with_mouse_face (w, start_x, row, + start_hpos, end_hpos, draw); row->mouse_face_p = draw == DRAW_MOUSE_FACE || draw == DRAW_IMAGE_RAISED; } } +#ifdef HAVE_WINDOW_SYSTEM /* When we've written over the cursor, arrange for it to be displayed again. */ - if (phys_cursor_on_p && !w->phys_cursor_on_p) + if (FRAME_WINDOW_P (f) + && phys_cursor_on_p && !w->phys_cursor_on_p) { BLOCK_INPUT; display_and_set_cursor (w, 1, @@ -23679,15 +24144,22 @@ show_mouse_face (Display_Info *dpyinfo, enum draw_glyphs_face draw) w->phys_cursor.x, w->phys_cursor.y); UNBLOCK_INPUT; } +#endif /* HAVE_WINDOW_SYSTEM */ } +#ifdef HAVE_WINDOW_SYSTEM /* Change the mouse cursor. */ - if (draw == DRAW_NORMAL_TEXT && !EQ (dpyinfo->mouse_face_window, f->tool_bar_window)) - FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->text_cursor); - else if (draw == DRAW_MOUSE_FACE) - FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->hand_cursor); - else - FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->nontext_cursor); + if (FRAME_WINDOW_P (f)) + { + if (draw == DRAW_NORMAL_TEXT + && !EQ (hlinfo->mouse_face_window, f->tool_bar_window)) + FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->text_cursor); + else if (draw == DRAW_MOUSE_FACE) + FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->hand_cursor); + else + FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->nontext_cursor); + } +#endif /* HAVE_WINDOW_SYSTEM */ } /* EXPORT: @@ -23696,23 +24168,70 @@ show_mouse_face (Display_Info *dpyinfo, enum draw_glyphs_face draw) face was actually drawn unhighlighted. */ int -clear_mouse_face (Display_Info *dpyinfo) +clear_mouse_face (Mouse_HLInfo *hlinfo) { int cleared = 0; - if (!dpyinfo->mouse_face_hidden && !NILP (dpyinfo->mouse_face_window)) + if (!hlinfo->mouse_face_hidden && !NILP (hlinfo->mouse_face_window)) { - show_mouse_face (dpyinfo, DRAW_NORMAL_TEXT); + show_mouse_face (hlinfo, DRAW_NORMAL_TEXT); cleared = 1; } - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; - dpyinfo->mouse_face_overlay = Qnil; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_overlay = Qnil; return cleared; } +/* Return non-zero if the coordinates HPOS and VPOS on windows W are + within the mouse face on that window. */ +static int +coords_in_mouse_face_p (struct window *w, int hpos, int vpos) +{ + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); + + /* Quickly resolve the easy cases. */ + if (!(WINDOWP (hlinfo->mouse_face_window) + && XWINDOW (hlinfo->mouse_face_window) == w)) + return 0; + if (vpos < hlinfo->mouse_face_beg_row + || vpos > hlinfo->mouse_face_end_row) + return 0; + if (vpos > hlinfo->mouse_face_beg_row + && vpos < hlinfo->mouse_face_end_row) + return 1; + + if (!MATRIX_ROW (w->current_matrix, vpos)->reversed_p) + { + if (hlinfo->mouse_face_beg_row == hlinfo->mouse_face_end_row) + { + if (hlinfo->mouse_face_beg_col <= hpos && hpos < hlinfo->mouse_face_end_col) + return 1; + } + else if ((vpos == hlinfo->mouse_face_beg_row + && hpos >= hlinfo->mouse_face_beg_col) + || (vpos == hlinfo->mouse_face_end_row + && hpos < hlinfo->mouse_face_end_col)) + return 1; + } + else + { + if (hlinfo->mouse_face_beg_row == hlinfo->mouse_face_end_row) + { + if (hlinfo->mouse_face_end_col < hpos && hpos <= hlinfo->mouse_face_beg_col) + return 1; + } + else if ((vpos == hlinfo->mouse_face_beg_row + && hpos <= hlinfo->mouse_face_beg_col) + || (vpos == hlinfo->mouse_face_end_row + && hpos > hlinfo->mouse_face_end_col)) + return 1; + } + return 0; +} + /* EXPORT: Non-zero if physical cursor of window W is within mouse face. */ @@ -23720,32 +24239,135 @@ clear_mouse_face (Display_Info *dpyinfo) int cursor_in_mouse_face_p (struct window *w) { - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame)); - int in_mouse_face = 0; + return coords_in_mouse_face_p (w, w->phys_cursor.hpos, w->phys_cursor.vpos); +} - if (WINDOWP (dpyinfo->mouse_face_window) - && XWINDOW (dpyinfo->mouse_face_window) == w) - { - int hpos = w->phys_cursor.hpos; - int vpos = w->phys_cursor.vpos; - if (vpos >= dpyinfo->mouse_face_beg_row - && vpos <= dpyinfo->mouse_face_end_row - && (vpos > dpyinfo->mouse_face_beg_row - || hpos >= dpyinfo->mouse_face_beg_col) - && (vpos < dpyinfo->mouse_face_end_row - || hpos < dpyinfo->mouse_face_end_col - || dpyinfo->mouse_face_past_end)) - in_mouse_face = 1; - } + +/* Find the glyph rows START_ROW and END_ROW of window W that display + characters between buffer positions START_CHARPOS and END_CHARPOS + (excluding END_CHARPOS). This is similar to row_containing_pos, + but is more accurate when bidi reordering makes buffer positions + change non-linearly with glyph rows. */ +static void +rows_from_pos_range (struct window *w, + EMACS_INT start_charpos, EMACS_INT end_charpos, + struct glyph_row **start, struct glyph_row **end) +{ + struct glyph_row *first = MATRIX_FIRST_TEXT_ROW (w->current_matrix); + int last_y = window_text_bottom_y (w); + struct glyph_row *row; - return in_mouse_face; -} + *start = NULL; + *end = NULL; + + while (!first->enabled_p + && first < MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)) + first++; + + /* Find the START row. */ + for (row = first; + row->enabled_p && MATRIX_ROW_BOTTOM_Y (row) <= last_y; + row++) + { + /* A row can potentially be the START row if the range of the + characters it displays intersects the range + [START_CHARPOS..END_CHARPOS). */ + if (! ((start_charpos < MATRIX_ROW_START_CHARPOS (row) + && end_charpos < MATRIX_ROW_START_CHARPOS (row)) + /* See the commentary in row_containing_pos, for the + explanation of the complicated way to check whether + some position is beyond the end of the characters + displayed by a row. */ + || ((start_charpos > MATRIX_ROW_END_CHARPOS (row) + || (start_charpos == MATRIX_ROW_END_CHARPOS (row) + && !row->ends_at_zv_p + && !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row))) + && (end_charpos > MATRIX_ROW_END_CHARPOS (row) + || (end_charpos == MATRIX_ROW_END_CHARPOS (row) + && !row->ends_at_zv_p + && !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row)))))) + { + /* Found a candidate row. Now make sure at least one of the + glyphs it displays has a charpos from the range + [START_CHARPOS..END_CHARPOS). + + This is not obvious because bidi reordering could make + buffer positions of a row be 1,2,3,102,101,100, and if we + want to highlight characters in [50..60), we don't want + this row, even though [50..60) does intersect [1..103), + the range of character positions given by the row's start + and end positions. */ + struct glyph *g = row->glyphs[TEXT_AREA]; + struct glyph *e = g + row->used[TEXT_AREA]; + + while (g < e) + { + if (BUFFERP (g->object) + && start_charpos <= g->charpos && g->charpos < end_charpos) + *start = row; + g++; + } + if (*start) + break; + } + } + /* Find the END row. */ + if (!*start + /* If the last row is partially visible, start looking for END + from that row, instead of starting from FIRST. */ + && !(row->enabled_p + && row->y < last_y && MATRIX_ROW_BOTTOM_Y (row) > last_y)) + row = first; + for ( ; row->enabled_p && MATRIX_ROW_BOTTOM_Y (row) <= last_y; row++) + { + struct glyph_row *next = row + 1; + + if (!next->enabled_p + || next >= MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w) + /* The first row >= START whose range of displayed characters + does NOT intersect the range [START_CHARPOS..END_CHARPOS] + is the row END + 1. */ + || (start_charpos < MATRIX_ROW_START_CHARPOS (next) + && end_charpos < MATRIX_ROW_START_CHARPOS (next)) + || ((start_charpos > MATRIX_ROW_END_CHARPOS (next) + || (start_charpos == MATRIX_ROW_END_CHARPOS (next) + && !next->ends_at_zv_p + && !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (next))) + && (end_charpos > MATRIX_ROW_END_CHARPOS (next) + || (end_charpos == MATRIX_ROW_END_CHARPOS (next) + && !next->ends_at_zv_p + && !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (next))))) + { + *end = row; + break; + } + else + { + /* If the next row's edges intersect [START_CHARPOS..END_CHARPOS], + but none of the characters it displays are in the range, it is + also END + 1. */ + struct glyph *g = next->glyphs[TEXT_AREA]; + struct glyph *e = g + next->used[TEXT_AREA]; + while (g < e) + { + if (BUFFERP (g->object) + && start_charpos <= g->charpos && g->charpos < end_charpos) + break; + g++; + } + if (g == e) + { + *end = row; + break; + } + } + } +} - -/* This function sets the mouse_face_* elements of DPYINFO, assuming +/* This function sets the mouse_face_* elements of HLINFO, assuming the mouse cursor is on a glyph with buffer charpos MOUSE_CHARPOS in window WINDOW. START_CHARPOS and END_CHARPOS are buffer positions for the overlay or run of text properties specifying the mouse @@ -23756,7 +24378,7 @@ cursor_in_mouse_face_p (struct window *w) static void mouse_face_from_buffer_pos (Lisp_Object window, - Display_Info *dpyinfo, + Mouse_HLInfo *hlinfo, EMACS_INT mouse_charpos, EMACS_INT start_charpos, EMACS_INT end_charpos, @@ -23766,166 +24388,313 @@ mouse_face_from_buffer_pos (Lisp_Object window, { struct window *w = XWINDOW (window); struct glyph_row *first = MATRIX_FIRST_TEXT_ROW (w->current_matrix); - struct glyph_row *row; + struct glyph_row *r1, *r2; struct glyph *glyph, *end; - EMACS_INT ignore; + EMACS_INT ignore, pos; int x; xassert (NILP (display_string) || STRINGP (display_string)); xassert (NILP (before_string) || STRINGP (before_string)); xassert (NILP (after_string) || STRINGP (after_string)); - /* Find the first highlighted glyph. */ - if (start_charpos < MATRIX_ROW_START_CHARPOS (first)) + /* Find the rows corresponding to START_CHARPOS and END_CHARPOS. */ + rows_from_pos_range (w, start_charpos, end_charpos, &r1, &r2); + if (r1 == NULL) + r1 = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); + /* If the before-string or display-string contains newlines, + rows_from_pos_range skips to its last row. Move back. */ + if (!NILP (before_string) || !NILP (display_string)) + { + struct glyph_row *prev; + while ((prev = r1 - 1, prev >= first) + && MATRIX_ROW_END_CHARPOS (prev) == start_charpos + && prev->used[TEXT_AREA] > 0) + { + struct glyph *beg = prev->glyphs[TEXT_AREA]; + glyph = beg + prev->used[TEXT_AREA]; + while (--glyph >= beg && INTEGERP (glyph->object)); + if (glyph < beg + || !(EQ (glyph->object, before_string) + || EQ (glyph->object, display_string))) + break; + r1 = prev; + } + } + if (r2 == NULL) { - dpyinfo->mouse_face_beg_col = 0; - dpyinfo->mouse_face_beg_row = MATRIX_ROW_VPOS (first, w->current_matrix); - dpyinfo->mouse_face_beg_x = first->x; - dpyinfo->mouse_face_beg_y = first->y; + r2 = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); + hlinfo->mouse_face_past_end = 1; } - else + else if (!NILP (after_string)) { - row = row_containing_pos (w, start_charpos, first, NULL, 0); - if (row == NULL) - row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); - - /* If the before-string or display-string contains newlines, - row_containing_pos skips to its last row. Move back. */ - if (!NILP (before_string) || !NILP (display_string)) - { - struct glyph_row *prev; - while ((prev = row - 1, prev >= first) - && MATRIX_ROW_END_CHARPOS (prev) == start_charpos - && prev->used[TEXT_AREA] > 0) - { - struct glyph *beg = prev->glyphs[TEXT_AREA]; - glyph = beg + prev->used[TEXT_AREA]; - while (--glyph >= beg && INTEGERP (glyph->object)); - if (glyph < beg - || !(EQ (glyph->object, before_string) - || EQ (glyph->object, display_string))) - break; - row = prev; - } - } + /* If the after-string has newlines, advance to its last row. */ + struct glyph_row *next; + struct glyph_row *last + = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); - glyph = row->glyphs[TEXT_AREA]; - end = glyph + row->used[TEXT_AREA]; - x = row->x; - dpyinfo->mouse_face_beg_y = row->y; - dpyinfo->mouse_face_beg_row = MATRIX_ROW_VPOS (row, w->current_matrix); + for (next = r2 + 1; + next <= last + && next->used[TEXT_AREA] > 0 + && EQ (next->glyphs[TEXT_AREA]->object, after_string); + ++next) + r2 = next; + } + /* The rest of the display engine assumes that mouse_face_beg_row is + either above below mouse_face_end_row or identical to it. But + with bidi-reordered continued lines, the row for START_CHARPOS + could be below the row for END_CHARPOS. If so, swap the rows and + store them in correct order. */ + if (r1->y > r2->y) + { + struct glyph_row *tem = r2; + + r2 = r1; + r1 = tem; + } + + hlinfo->mouse_face_beg_y = r1->y; + hlinfo->mouse_face_beg_row = MATRIX_ROW_VPOS (r1, w->current_matrix); + hlinfo->mouse_face_end_y = r2->y; + hlinfo->mouse_face_end_row = MATRIX_ROW_VPOS (r2, w->current_matrix); + + /* For a bidi-reordered row, the positions of BEFORE_STRING, + AFTER_STRING, DISPLAY_STRING, START_CHARPOS, and END_CHARPOS + could be anywhere in the row and in any order. The strategy + below is to find the leftmost and the rightmost glyph that + belongs to either of these 3 strings, or whose position is + between START_CHARPOS and END_CHARPOS, and highlight all the + glyphs between those two. This may cover more than just the text + between START_CHARPOS and END_CHARPOS if the range of characters + strides the bidi level boundary, e.g. if the beginning is in R2L + text while the end is in L2R text or vice versa. */ + if (!r1->reversed_p) + { + /* This row is in a left to right paragraph. Scan it left to + right. */ + glyph = r1->glyphs[TEXT_AREA]; + end = glyph + r1->used[TEXT_AREA]; + x = r1->x; /* Skip truncation glyphs at the start of the glyph row. */ - if (row->displays_text_p) + if (r1->displays_text_p) for (; glyph < end && INTEGERP (glyph->object) && glyph->charpos < 0; ++glyph) x += glyph->pixel_width; - /* Scan the glyph row, stopping before BEFORE_STRING or - DISPLAY_STRING or START_CHARPOS. */ + /* Scan the glyph row, looking for BEFORE_STRING, AFTER_STRING, + or DISPLAY_STRING, and the first glyph from buffer whose + position is between START_CHARPOS and END_CHARPOS. */ for (; glyph < end && !INTEGERP (glyph->object) - && !EQ (glyph->object, before_string) && !EQ (glyph->object, display_string) && !(BUFFERP (glyph->object) - && glyph->charpos >= start_charpos); + && (glyph->charpos >= start_charpos + && glyph->charpos < end_charpos)); ++glyph) - x += glyph->pixel_width; - - dpyinfo->mouse_face_beg_x = x; - dpyinfo->mouse_face_beg_col = glyph - row->glyphs[TEXT_AREA]; - } - - /* Find the last highlighted glyph. */ - row = row_containing_pos (w, end_charpos, first, NULL, 0); - if (row == NULL) - { - row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); - dpyinfo->mouse_face_past_end = 1; + { + /* BEFORE_STRING or AFTER_STRING are only relevant if they + are present at buffer positions between START_CHARPOS and + END_CHARPOS, or if they come from an overlay. */ + if (EQ (glyph->object, before_string)) + { + pos = string_buffer_position (w, before_string, + start_charpos); + /* If pos == 0, it means before_string came from an + overlay, not from a buffer position. */ + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + else if (EQ (glyph->object, after_string)) + { + pos = string_buffer_position (w, after_string, end_charpos); + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + x += glyph->pixel_width; + } + hlinfo->mouse_face_beg_x = x; + hlinfo->mouse_face_beg_col = glyph - r1->glyphs[TEXT_AREA]; } - else if (!NILP (after_string)) + else { - /* If the after-string has newlines, advance to its last row. */ - struct glyph_row *next; - struct glyph_row *last - = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); + /* This row is in a right to left paragraph. Scan it right to + left. */ + struct glyph *g; - for (next = row + 1; - next <= last - && next->used[TEXT_AREA] > 0 - && EQ (next->glyphs[TEXT_AREA]->object, after_string); - ++next) - row = next; - } + end = r1->glyphs[TEXT_AREA] - 1; + glyph = end + r1->used[TEXT_AREA]; - glyph = row->glyphs[TEXT_AREA]; - end = glyph + row->used[TEXT_AREA]; - x = row->x; - dpyinfo->mouse_face_end_y = row->y; - dpyinfo->mouse_face_end_row = MATRIX_ROW_VPOS (row, w->current_matrix); + /* Skip truncation glyphs at the start of the glyph row. */ + if (r1->displays_text_p) + for (; glyph > end + && INTEGERP (glyph->object) + && glyph->charpos < 0; + --glyph) + ; - /* Skip truncation glyphs at the start of the row. */ - if (row->displays_text_p) - for (; glyph < end - && INTEGERP (glyph->object) - && glyph->charpos < 0; - ++glyph) - x += glyph->pixel_width; - - /* Scan the glyph row, stopping at END_CHARPOS or when we encounter - AFTER_STRING. */ - for (; glyph < end - && !INTEGERP (glyph->object) - && !EQ (glyph->object, after_string) - && !(BUFFERP (glyph->object) && glyph->charpos >= end_charpos); - ++glyph) - x += glyph->pixel_width; + /* Scan the glyph row, looking for BEFORE_STRING, AFTER_STRING, + or DISPLAY_STRING, and the first glyph from buffer whose + position is between START_CHARPOS and END_CHARPOS. */ + for (; glyph > end + && !INTEGERP (glyph->object) + && !EQ (glyph->object, display_string) + && !(BUFFERP (glyph->object) + && (glyph->charpos >= start_charpos + && glyph->charpos < end_charpos)); + --glyph) + { + /* BEFORE_STRING or AFTER_STRING are only relevant if they + are present at buffer positions between START_CHARPOS and + END_CHARPOS, or if they come from an overlay. */ + if (EQ (glyph->object, before_string)) + { + pos = string_buffer_position (w, before_string, start_charpos); + /* If pos == 0, it means before_string came from an + overlay, not from a buffer position. */ + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + else if (EQ (glyph->object, after_string)) + { + pos = string_buffer_position (w, after_string, end_charpos); + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + } + + glyph++; /* first glyph to the right of the highlighted area */ + for (g = r1->glyphs[TEXT_AREA], x = r1->x; g < glyph; g++) + x += g->pixel_width; + hlinfo->mouse_face_beg_x = x; + hlinfo->mouse_face_beg_col = glyph - r1->glyphs[TEXT_AREA]; + } - /* If we found AFTER_STRING, consume it and stop. */ - if (EQ (glyph->object, after_string)) + /* If the highlight ends in a different row, compute GLYPH and END + for the end row. Otherwise, reuse the values computed above for + the row where the highlight begins. */ + if (r2 != r1) { - for (; EQ (glyph->object, after_string) && glyph < end; ++glyph) + if (!r2->reversed_p) + { + glyph = r2->glyphs[TEXT_AREA]; + end = glyph + r2->used[TEXT_AREA]; + x = r2->x; + } + else + { + end = r2->glyphs[TEXT_AREA] - 1; + glyph = end + r2->used[TEXT_AREA]; + } + } + + if (!r2->reversed_p) + { + /* Skip truncation and continuation glyphs near the end of the + row, and also blanks and stretch glyphs inserted by + extend_face_to_end_of_line. */ + while (end > glyph + && INTEGERP ((end - 1)->object) + && (end - 1)->charpos <= 0) + --end; + /* Scan the rest of the glyph row from the end, looking for the + first glyph that comes from BEFORE_STRING, AFTER_STRING, or + DISPLAY_STRING, or whose position is between START_CHARPOS + and END_CHARPOS */ + for (--end; + end > glyph + && !INTEGERP (end->object) + && !EQ (end->object, display_string) + && !(BUFFERP (end->object) + && (end->charpos >= start_charpos + && end->charpos < end_charpos)); + --end) + { + /* BEFORE_STRING or AFTER_STRING are only relevant if they + are present at buffer positions between START_CHARPOS and + END_CHARPOS, or if they come from an overlay. */ + if (EQ (end->object, before_string)) + { + pos = string_buffer_position (w, before_string, start_charpos); + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + else if (EQ (end->object, after_string)) + { + pos = string_buffer_position (w, after_string, end_charpos); + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + } + /* Find the X coordinate of the last glyph to be highlighted. */ + for (; glyph <= end; ++glyph) x += glyph->pixel_width; + + hlinfo->mouse_face_end_x = x; + hlinfo->mouse_face_end_col = glyph - r2->glyphs[TEXT_AREA]; } else { - /* If there's no after-string, we must check if we overshot, - which might be the case if we stopped after a string glyph. - That glyph may belong to a before-string or display-string - associated with the end position, which must not be - highlighted. */ - Lisp_Object prev_object; - EMACS_INT pos; - - while (glyph > row->glyphs[TEXT_AREA]) - { - prev_object = (glyph - 1)->object; - if (!STRINGP (prev_object) || EQ (prev_object, display_string)) - break; - - pos = string_buffer_position (w, prev_object, end_charpos); - if (pos && pos < end_charpos) - break; - - for (; glyph > row->glyphs[TEXT_AREA] - && EQ ((glyph - 1)->object, prev_object); - --glyph) - x -= (glyph - 1)->pixel_width; + /* Skip truncation and continuation glyphs near the end of the + row, and also blanks and stretch glyphs inserted by + extend_face_to_end_of_line. */ + x = r2->x; + end++; + while (end < glyph + && INTEGERP (end->object) + && end->charpos <= 0) + { + x += end->pixel_width; + ++end; + } + /* Scan the rest of the glyph row from the end, looking for the + first glyph that comes from BEFORE_STRING, AFTER_STRING, or + DISPLAY_STRING, or whose position is between START_CHARPOS + and END_CHARPOS */ + for ( ; + end < glyph + && !INTEGERP (end->object) + && !EQ (end->object, display_string) + && !(BUFFERP (end->object) + && (end->charpos >= start_charpos + && end->charpos < end_charpos)); + ++end) + { + /* BEFORE_STRING or AFTER_STRING are only relevant if they + are present at buffer positions between START_CHARPOS and + END_CHARPOS, or if they come from an overlay. */ + if (EQ (end->object, before_string)) + { + pos = string_buffer_position (w, before_string, start_charpos); + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + else if (EQ (end->object, after_string)) + { + pos = string_buffer_position (w, after_string, end_charpos); + if (!pos || (pos >= start_charpos && pos < end_charpos)) + break; + } + x += end->pixel_width; } + hlinfo->mouse_face_end_x = x; + hlinfo->mouse_face_end_col = end - r2->glyphs[TEXT_AREA]; } - dpyinfo->mouse_face_end_x = x; - dpyinfo->mouse_face_end_col = glyph - row->glyphs[TEXT_AREA]; - dpyinfo->mouse_face_window = window; - dpyinfo->mouse_face_face_id + hlinfo->mouse_face_window = window; + hlinfo->mouse_face_face_id = face_at_buffer_position (w, mouse_charpos, 0, 0, &ignore, mouse_charpos + 1, - !dpyinfo->mouse_face_hidden, -1); - show_mouse_face (dpyinfo, DRAW_MOUSE_FACE); + !hlinfo->mouse_face_hidden, -1); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE); } +/* The following function is not used anymore (replaced with + mouse_face_from_string_pos), but I leave it here for the time + being, in case someone would. */ + +#if 0 /* not used */ /* Find the position of the glyph for position POS in OBJECT in window W's current matrix, and return in *X, *Y the pixel @@ -24003,7 +24772,132 @@ fast_find_string_pos (struct window *w, EMACS_INT pos, Lisp_Object object, return best_glyph != NULL; } +#endif /* not used */ +/* Find the positions of the first and the last glyphs in window W's + current matrix that occlude positions [STARTPOS..ENDPOS] in OBJECT + (assumed to be a string), and return in HLINFO's mouse_face_* + members the pixel and column/row coordinates of those glyphs. */ + +static void +mouse_face_from_string_pos (struct window *w, Mouse_HLInfo *hlinfo, + Lisp_Object object, + EMACS_INT startpos, EMACS_INT endpos) +{ + int yb = window_text_bottom_y (w); + struct glyph_row *r; + struct glyph *g, *e; + int gx; + int found = 0; + + /* Find the glyph row with at least one position in the range + [STARTPOS..ENDPOS], and the first glyph in that row whose + position belongs to that range. */ + for (r = MATRIX_FIRST_TEXT_ROW (w->current_matrix); + r->enabled_p && r->y < yb; + ++r) + { + if (!r->reversed_p) + { + g = r->glyphs[TEXT_AREA]; + e = g + r->used[TEXT_AREA]; + for (gx = r->x; g < e; gx += g->pixel_width, ++g) + if (EQ (g->object, object) + && startpos <= g->charpos && g->charpos <= endpos) + { + hlinfo->mouse_face_beg_row = r - w->current_matrix->rows; + hlinfo->mouse_face_beg_y = r->y; + hlinfo->mouse_face_beg_col = g - r->glyphs[TEXT_AREA]; + hlinfo->mouse_face_beg_x = gx; + found = 1; + break; + } + } + else + { + struct glyph *g1; + + e = r->glyphs[TEXT_AREA]; + g = e + r->used[TEXT_AREA]; + for ( ; g > e; --g) + if (EQ ((g-1)->object, object) + && startpos <= (g-1)->charpos && (g-1)->charpos <= endpos) + { + hlinfo->mouse_face_beg_row = r - w->current_matrix->rows; + hlinfo->mouse_face_beg_y = r->y; + hlinfo->mouse_face_beg_col = g - r->glyphs[TEXT_AREA]; + for (gx = r->x, g1 = r->glyphs[TEXT_AREA]; g1 < g; ++g1) + gx += g1->pixel_width; + hlinfo->mouse_face_beg_x = gx; + found = 1; + break; + } + } + if (found) + break; + } + + if (!found) + return; + + /* Starting with the next row, look for the first row which does NOT + include any glyphs whose positions are in the range. */ + for (++r; r->enabled_p && r->y < yb; ++r) + { + g = r->glyphs[TEXT_AREA]; + e = g + r->used[TEXT_AREA]; + found = 0; + for ( ; g < e; ++g) + if (EQ (g->object, object) + && startpos <= g->charpos && g->charpos <= endpos) + { + found = 1; + break; + } + if (!found) + break; + } + + /* The highlighted region ends on the previous row. */ + r--; + + /* Set the end row and its vertical pixel coordinate. */ + hlinfo->mouse_face_end_row = r - w->current_matrix->rows; + hlinfo->mouse_face_end_y = r->y; + + /* Compute and set the end column and the end column's horizontal + pixel coordinate. */ + if (!r->reversed_p) + { + g = r->glyphs[TEXT_AREA]; + e = g + r->used[TEXT_AREA]; + for ( ; e > g; --e) + if (EQ ((e-1)->object, object) + && startpos <= (e-1)->charpos && (e-1)->charpos <= endpos) + break; + hlinfo->mouse_face_end_col = e - g; + + for (gx = r->x; g < e; ++g) + gx += g->pixel_width; + hlinfo->mouse_face_end_x = gx; + } + else + { + e = r->glyphs[TEXT_AREA]; + g = e + r->used[TEXT_AREA]; + for (gx = r->x ; e < g; ++e) + { + if (EQ (e->object, object) + && startpos <= e->charpos && e->charpos <= endpos) + break; + gx += e->pixel_width; + } + hlinfo->mouse_face_end_col = e - r->glyphs[TEXT_AREA]; + hlinfo->mouse_face_end_x = gx; + } +} + +#ifdef HAVE_WINDOW_SYSTEM /* See if position X, Y is within a hot-spot of an image. */ @@ -24175,6 +25069,8 @@ define_frame_cursor1 (struct frame *f, Cursor cursor, Lisp_Object pointer) FRAME_RIF (f)->define_frame_cursor (f, cursor); } +#endif /* HAVE_WINDOW_SYSTEM */ + /* Take proper action when mouse has moved to the mode or header line or marginal area AREA of window W, x-position X and y-position Y. X is relative to the start of the text display area of W, so the @@ -24187,8 +25083,11 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, { struct window *w = XWINDOW (window); struct frame *f = XFRAME (w->frame); - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - Cursor cursor = FRAME_X_OUTPUT (f)->nontext_cursor; + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); +#ifdef HAVE_WINDOW_SYSTEM + Display_Info *dpyinfo; +#endif + Cursor cursor = No_Cursor; Lisp_Object pointer = Qnil; int dx, dy, width, height; EMACS_INT charpos; @@ -24205,6 +25104,8 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, int x0; struct glyph *end; + /* Kludge alert: mode_line_string takes X/Y in pixels, but + returns them in row/column units! */ string = mode_line_string (w, area, &x, &y, &charpos, &object, &dx, &dy, &width, &height); @@ -24212,7 +25113,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, ? MATRIX_MODE_LINE_ROW (w->current_matrix) : MATRIX_HEADER_LINE_ROW (w->current_matrix)); - /* Find glyph */ + /* Find the glyph under the mouse pointer. */ if (row->mode_line_p && row->enabled_p) { glyph = row_start_glyph = row->glyphs[TEXT_AREA]; @@ -24230,12 +25131,15 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, else { x -= WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w); + /* Kludge alert: marginal_area_string takes X/Y in pixels, but + returns them in row/column units! */ string = marginal_area_string (w, area, &x, &y, &charpos, &object, &dx, &dy, &width, &height); } help = Qnil; +#ifdef HAVE_WINDOW_SYSTEM if (IMAGEP (object)) { Lisp_Object image_map, hotspot; @@ -24272,6 +25176,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, if (NILP (pointer)) pointer = Fplist_get (XCDR (object), QCpointer); } +#endif /* HAVE_WINDOW_SYSTEM */ if (STRINGP (string)) { @@ -24291,19 +25196,27 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, } } - if (NILP (pointer)) - pointer = Fget_text_property (pos, Qpointer, string); - - /* Change the mouse pointer according to what is under X/Y. */ - if (NILP (pointer) && ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE))) +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) { - Lisp_Object map; - map = Fget_text_property (pos, Qlocal_map, string); - if (!KEYMAPP (map)) - map = Fget_text_property (pos, Qkeymap, string); - if (!KEYMAPP (map)) - cursor = dpyinfo->vertical_scroll_bar_cursor; + dpyinfo = FRAME_X_DISPLAY_INFO (f); + cursor = FRAME_X_OUTPUT (f)->nontext_cursor; + if (NILP (pointer)) + pointer = Fget_text_property (pos, Qpointer, string); + + /* Change the mouse pointer according to what is under X/Y. */ + if (NILP (pointer) + && ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE))) + { + Lisp_Object map; + map = Fget_text_property (pos, Qlocal_map, string); + if (!KEYMAPP (map)) + map = Fget_text_property (pos, Qkeymap, string); + if (!KEYMAPP (map)) + cursor = dpyinfo->vertical_scroll_bar_cursor; + } } +#endif /* Change the mouse face according to what is under X/Y. */ mouse_face = Fget_text_property (pos, Qmouse_face, string); @@ -24318,102 +25231,128 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, int gpos; int gseq_length; int total_pixel_width; - EMACS_INT ignore; + EMACS_INT begpos, endpos, ignore; int vpos, hpos; b = Fprevious_single_property_change (make_number (charpos + 1), Qmouse_face, string, Qnil); if (NILP (b)) - b = make_number (0); + begpos = 0; + else + begpos = XINT (b); e = Fnext_single_property_change (pos, Qmouse_face, string, Qnil); if (NILP (e)) - e = make_number (SCHARS (string)); - - /* Calculate the position(glyph position: GPOS) of GLYPH in - displayed string. GPOS is different from CHARPOS. - - CHARPOS is the position of glyph in internal string - object. A mode line string format has structures which - is converted to a flatten by emacs lisp interpreter. - The internal string is an element of the structures. - The displayed string is the flatten string. */ - gpos = 0; - if (glyph > row_start_glyph) - { - tmp_glyph = glyph - 1; - while (tmp_glyph >= row_start_glyph - && tmp_glyph->charpos >= XINT (b) - && EQ (tmp_glyph->object, glyph->object)) - { - tmp_glyph--; - gpos++; - } - } - - /* Calculate the lenght(glyph sequence length: GSEQ_LENGTH) of - displayed string holding GLYPH. - - GSEQ_LENGTH is different from SCHARS (STRING). - SCHARS (STRING) returns the length of the internal string. */ - for (tmp_glyph = glyph, gseq_length = gpos; - tmp_glyph->charpos < XINT (e); - tmp_glyph++, gseq_length++) - { - if (!EQ (tmp_glyph->object, glyph->object)) - break; - } + endpos = SCHARS (string); + else + endpos = XINT (e); + + /* Calculate the glyph position GPOS of GLYPH in the + displayed string, relative to the beginning of the + highlighted part of the string. + + Note: GPOS is different from CHARPOS. CHARPOS is the + position of GLYPH in the internal string object. A mode + line string format has structures which are converted to + a flattened string by the Emacs Lisp interpreter. The + internal string is an element of those structures. The + displayed string is the flattened string. */ + tmp_glyph = row_start_glyph; + while (tmp_glyph < glyph + && (!(EQ (tmp_glyph->object, glyph->object) + && begpos <= tmp_glyph->charpos + && tmp_glyph->charpos < endpos))) + tmp_glyph++; + gpos = glyph - tmp_glyph; + + /* Calculate the length GSEQ_LENGTH of the glyph sequence of + the highlighted part of the displayed string to which + GLYPH belongs. Note: GSEQ_LENGTH is different from + SCHARS (STRING), because the latter returns the length of + the internal string. */ + for (tmp_glyph = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1; + tmp_glyph > glyph + && (!(EQ (tmp_glyph->object, glyph->object) + && begpos <= tmp_glyph->charpos + && tmp_glyph->charpos < endpos)); + tmp_glyph--) + ; + gseq_length = gpos + (tmp_glyph - glyph) + 1; + /* Calculate the total pixel width of all the glyphs between + the beginning of the highlighted area and GLYPH. */ total_pixel_width = 0; for (tmp_glyph = glyph - gpos; tmp_glyph != glyph; tmp_glyph++) total_pixel_width += tmp_glyph->pixel_width; - /* Pre calculation of re-rendering position */ - vpos = (x - gpos); - hpos = (area == ON_MODE_LINE + /* Pre calculation of re-rendering position. Note: X is in + column units here, after the call to mode_line_string or + marginal_area_string. */ + hpos = x - gpos; + vpos = (area == ON_MODE_LINE ? (w->current_matrix)->nrows - 1 : 0); - /* If the re-rendering position is included in the last - re-rendering area, we should do nothing. */ - if ( EQ (window, dpyinfo->mouse_face_window) - && dpyinfo->mouse_face_beg_col <= vpos - && vpos < dpyinfo->mouse_face_end_col - && dpyinfo->mouse_face_beg_row == hpos ) + /* If GLYPH's position is included in the region that is + already drawn in mouse face, we have nothing to do. */ + if ( EQ (window, hlinfo->mouse_face_window) + && (!row->reversed_p + ? (hlinfo->mouse_face_beg_col <= hpos + && hpos < hlinfo->mouse_face_end_col) + /* In R2L rows we swap BEG and END, see below. */ + : (hlinfo->mouse_face_end_col <= hpos + && hpos < hlinfo->mouse_face_beg_col)) + && hlinfo->mouse_face_beg_row == vpos ) return; - if (clear_mouse_face (dpyinfo)) + if (clear_mouse_face (hlinfo)) cursor = No_Cursor; - dpyinfo->mouse_face_beg_col = vpos; - dpyinfo->mouse_face_beg_row = hpos; - - dpyinfo->mouse_face_beg_x = original_x_pixel - (total_pixel_width + dx); - dpyinfo->mouse_face_beg_y = 0; - - dpyinfo->mouse_face_end_col = vpos + gseq_length; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_beg_row; - - dpyinfo->mouse_face_end_x = 0; - dpyinfo->mouse_face_end_y = 0; - - dpyinfo->mouse_face_past_end = 0; - dpyinfo->mouse_face_window = window; + if (!row->reversed_p) + { + hlinfo->mouse_face_beg_col = hpos; + hlinfo->mouse_face_beg_x = original_x_pixel + - (total_pixel_width + dx); + hlinfo->mouse_face_end_col = hpos + gseq_length; + hlinfo->mouse_face_end_x = 0; + } + else + { + /* In R2L rows, show_mouse_face expects BEG and END + coordinates to be swapped. */ + hlinfo->mouse_face_end_col = hpos; + hlinfo->mouse_face_end_x = original_x_pixel + - (total_pixel_width + dx); + hlinfo->mouse_face_beg_col = hpos + gseq_length; + hlinfo->mouse_face_beg_x = 0; + } - dpyinfo->mouse_face_face_id = face_at_string_position (w, string, - charpos, - 0, 0, 0, &ignore, - glyph->face_id, 1); - show_mouse_face (dpyinfo, DRAW_MOUSE_FACE); + hlinfo->mouse_face_beg_row = vpos; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_beg_row; + hlinfo->mouse_face_beg_y = 0; + hlinfo->mouse_face_end_y = 0; + hlinfo->mouse_face_past_end = 0; + hlinfo->mouse_face_window = window; + + hlinfo->mouse_face_face_id = face_at_string_position (w, string, + charpos, + 0, 0, 0, + &ignore, + glyph->face_id, + 1); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE); if (NILP (pointer)) pointer = Qhand; } else if ((area == ON_MODE_LINE) || (area == ON_HEADER_LINE)) - clear_mouse_face (dpyinfo); + clear_mouse_face (hlinfo); } - define_frame_cursor1 (f, cursor, pointer); +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + define_frame_cursor1 (f, cursor, pointer); +#endif } @@ -24426,7 +25365,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, void note_mouse_highlight (struct frame *f, int x, int y) { - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); enum window_part part; Lisp_Object window; struct window *w; @@ -24435,7 +25374,7 @@ note_mouse_highlight (struct frame *f, int x, int y) struct buffer *b; /* When a menu is active, don't highlight because this looks odd. */ -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (MSDOS) if (popup_activated ()) return; #endif @@ -24445,28 +25384,28 @@ note_mouse_highlight (struct frame *f, int x, int y) || f->pointer_invisible) return; - dpyinfo->mouse_face_mouse_x = x; - dpyinfo->mouse_face_mouse_y = y; - dpyinfo->mouse_face_mouse_frame = f; + hlinfo->mouse_face_mouse_x = x; + hlinfo->mouse_face_mouse_y = y; + hlinfo->mouse_face_mouse_frame = f; - if (dpyinfo->mouse_face_defer) + if (hlinfo->mouse_face_defer) return; if (gc_in_progress) { - dpyinfo->mouse_face_deferred_gc = 1; + hlinfo->mouse_face_deferred_gc = 1; return; } /* 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. */ - if (! EQ (window, dpyinfo->mouse_face_window) + if (! EQ (window, hlinfo->mouse_face_window) || (part != ON_TEXT && part != ON_MODE_LINE && part != ON_HEADER_LINE - && !NILP (dpyinfo->mouse_face_window))) - clear_mouse_face (dpyinfo); + && !NILP (hlinfo->mouse_face_window))) + clear_mouse_face (hlinfo); /* Not on a window -> return. */ if (!WINDOWP (window)) @@ -24479,6 +25418,7 @@ note_mouse_highlight (struct frame *f, int x, int y) w = XWINDOW (window); frame_to_window_pixel_xy (w, &x, &y); +#ifdef HAVE_WINDOW_SYSTEM /* Handle tool-bar window differently since it doesn't display a buffer. */ if (EQ (window, f->tool_bar_window)) @@ -24486,6 +25426,7 @@ note_mouse_highlight (struct frame *f, int x, int y) note_tool_bar_highlight (f, x, y); return; } +#endif /* Mouse is on the mode, header line or margin? */ if (part == ON_MODE_LINE || part == ON_HEADER_LINE @@ -24495,6 +25436,7 @@ note_mouse_highlight (struct frame *f, int x, int y) return; } +#ifdef HAVE_WINDOW_SYSTEM if (part == ON_VERTICAL_BORDER) { cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; @@ -24505,6 +25447,7 @@ note_mouse_highlight (struct frame *f, int x, int y) cursor = FRAME_X_OUTPUT (f)->nontext_cursor; else cursor = FRAME_X_OUTPUT (f)->text_cursor; +#endif /* Are we in a window whose display is up to date? And verify the buffer's text has not changed. */ @@ -24528,6 +25471,7 @@ note_mouse_highlight (struct frame *f, int x, int y) /* Find the glyph under X/Y. */ glyph = x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, &dx, &dy, &area); +#ifdef HAVE_WINDOW_SYSTEM /* Look for :pointer property on image. */ if (glyph != NULL && glyph->type == IMAGE_GLYPH) { @@ -24569,21 +25513,38 @@ note_mouse_highlight (struct frame *f, int x, int y) pointer = Fplist_get (XCDR (img->spec), QCpointer); } } +#endif /* HAVE_WINDOW_SYSTEM */ /* Clear mouse face if X/Y not over text. */ if (glyph == NULL || area != TEXT_AREA - || !MATRIX_ROW (w->current_matrix, vpos)->displays_text_p) - { - if (clear_mouse_face (dpyinfo)) + || !MATRIX_ROW (w->current_matrix, vpos)->displays_text_p + /* Glyph's OBJECT is an integer for glyphs inserted by the + display engine for its internal purposes, like truncation + and continuation glyphs and blanks beyond the end of + line's text on text terminals. If we are over such a + glyph, we are not over any text. */ + || INTEGERP (glyph->object) + /* R2L rows have a stretch glyph at their front, which + stands for no text, whereas L2R rows have no glyphs at + all beyond the end of text. Treat such stretch glyphs + like we do with NULL glyphs in L2R rows. */ + || (MATRIX_ROW (w->current_matrix, vpos)->reversed_p + && glyph == MATRIX_ROW (w->current_matrix, vpos)->glyphs[TEXT_AREA] + && glyph->type == STRETCH_GLYPH + && glyph->avoid_cursor_p)) + { + if (clear_mouse_face (hlinfo)) cursor = No_Cursor; - if (NILP (pointer)) +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f) && NILP (pointer)) { if (area != TEXT_AREA) cursor = FRAME_X_OUTPUT (f)->nontext_cursor; else pointer = Vvoid_text_area_pointer; } +#endif goto set_cursor; } @@ -24618,14 +25579,7 @@ note_mouse_highlight (struct frame *f, int x, int y) else noverlays = 0; - same_region = (EQ (window, dpyinfo->mouse_face_window) - && vpos >= dpyinfo->mouse_face_beg_row - && vpos <= dpyinfo->mouse_face_end_row - && (vpos > dpyinfo->mouse_face_beg_row - || hpos >= dpyinfo->mouse_face_beg_col) - && (vpos < dpyinfo->mouse_face_end_row - || hpos < dpyinfo->mouse_face_end_col - || dpyinfo->mouse_face_past_end)); + same_region = coords_in_mouse_face_p (w, hpos, vpos); if (same_region) cursor = No_Cursor; @@ -24636,8 +25590,8 @@ note_mouse_highlight (struct frame *f, int x, int y) the one we are currently highlighting, we have to check if we enter the overlapping overlay, and then highlight only that. */ - || (OVERLAYP (dpyinfo->mouse_face_overlay) - && mouse_face_overlay_overlaps (dpyinfo->mouse_face_overlay))) + || (OVERLAYP (hlinfo->mouse_face_overlay) + && mouse_face_overlay_overlaps (hlinfo->mouse_face_overlay))) { /* Find the highest priority overlay with a mouse-face. */ overlay = Qnil; @@ -24650,12 +25604,12 @@ note_mouse_highlight (struct frame *f, int x, int y) /* If we're highlighting the same overlay as before, there's no need to do that again. */ - if (!NILP (overlay) && EQ (overlay, dpyinfo->mouse_face_overlay)) + if (!NILP (overlay) && EQ (overlay, hlinfo->mouse_face_overlay)) goto check_help_echo; - dpyinfo->mouse_face_overlay = overlay; + hlinfo->mouse_face_overlay = overlay; /* Clear the display of the old active region, if any. */ - if (clear_mouse_face (dpyinfo)) + if (clear_mouse_face (hlinfo)) cursor = No_Cursor; /* If no overlay applies, get a text property. */ @@ -24679,23 +25633,14 @@ note_mouse_highlight (struct frame *f, int x, int y) b = make_number (0); if (NILP (e)) e = make_number (SCHARS (object) - 1); - - fast_find_string_pos (w, XINT (b), object, - &dpyinfo->mouse_face_beg_col, - &dpyinfo->mouse_face_beg_row, - &dpyinfo->mouse_face_beg_x, - &dpyinfo->mouse_face_beg_y, 0); - fast_find_string_pos (w, XINT (e), object, - &dpyinfo->mouse_face_end_col, - &dpyinfo->mouse_face_end_row, - &dpyinfo->mouse_face_end_x, - &dpyinfo->mouse_face_end_y, 1); - dpyinfo->mouse_face_past_end = 0; - dpyinfo->mouse_face_window = window; - dpyinfo->mouse_face_face_id + mouse_face_from_string_pos (w, hlinfo, object, + XINT (b), XINT (e)); + hlinfo->mouse_face_past_end = 0; + hlinfo->mouse_face_window = window; + hlinfo->mouse_face_face_id = face_at_string_position (w, object, pos, 0, 0, 0, &ignore, glyph->face_id, 1); - show_mouse_face (dpyinfo, DRAW_MOUSE_FACE); + show_mouse_face (hlinfo, DRAW_MOUSE_FACE); cursor = No_Cursor; } else @@ -24729,17 +25674,33 @@ note_mouse_highlight (struct frame *f, int x, int y) { Lisp_Object before, after; Lisp_Object before_string, after_string; + /* To correctly find the limits of mouse highlight + in a bidi-reordered buffer, we must not use the + optimization of limiting the search in + previous-single-property-change and + next-single-property-change, because + rows_from_pos_range needs the real start and end + positions to DTRT in this case. That's because + the first row visible in a window does not + necessarily display the character whose position + is the smallest. */ + Lisp_Object lim1 = + NILP (XBUFFER (buffer)->bidi_display_reordering) + ? Fmarker_position (w->start) + : Qnil; + Lisp_Object lim2 = + NILP (XBUFFER (buffer)->bidi_display_reordering) + ? make_number (BUF_Z (XBUFFER (buffer)) + - XFASTINT (w->window_end_pos)) + : Qnil; if (NILP (overlay)) { /* Handle the text property case. */ before = Fprevious_single_property_change - (make_number (pos + 1), Qmouse_face, buffer, - Fmarker_position (w->start)); + (make_number (pos + 1), Qmouse_face, buffer, lim1); after = Fnext_single_property_change - (make_number (pos), Qmouse_face, buffer, - make_number (BUF_Z (XBUFFER (buffer)) - - XFASTINT (w->window_end_pos))); + (make_number (pos), Qmouse_face, buffer, lim2); before_string = after_string = Qnil; } else @@ -24754,7 +25715,7 @@ note_mouse_highlight (struct frame *f, int x, int y) if (!STRINGP (after_string)) after_string = Qnil; } - mouse_face_from_buffer_pos (window, dpyinfo, pos, + mouse_face_from_buffer_pos (window, hlinfo, pos, XFASTINT (before), XFASTINT (after), before_string, after_string, @@ -24833,8 +25794,9 @@ note_mouse_highlight (struct frame *f, int x, int y) } } +#ifdef HAVE_WINDOW_SYSTEM /* Look for a `pointer' property. */ - if (NILP (pointer)) + if (FRAME_WINDOW_P (f) && NILP (pointer)) { /* Check overlays first. */ for (i = noverlays - 1; i >= 0 && NILP (pointer); --i) @@ -24873,6 +25835,7 @@ note_mouse_highlight (struct frame *f, int x, int y) Qpointer, object); } } +#endif /* HAVE_WINDOW_SYSTEM */ BEGV = obegv; ZV = ozv; @@ -24881,7 +25844,14 @@ note_mouse_highlight (struct frame *f, int x, int y) set_cursor: - define_frame_cursor1 (f, cursor, pointer); +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + define_frame_cursor1 (f, cursor, pointer); +#else + /* This is here to prevent a compiler error, about "label at end of + compound statement". */ + return; +#endif } @@ -24893,13 +25863,13 @@ note_mouse_highlight (struct frame *f, int x, int y) void x_clear_window_mouse_face (struct window *w) { - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame)); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); Lisp_Object window; BLOCK_INPUT; XSETWINDOW (window, w); - if (EQ (window, dpyinfo->mouse_face_window)) - clear_mouse_face (dpyinfo); + if (EQ (window, hlinfo->mouse_face_window)) + clear_mouse_face (hlinfo); UNBLOCK_INPUT; } @@ -24912,20 +25882,18 @@ void cancel_mouse_face (struct frame *f) { Lisp_Object window; - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - window = dpyinfo->mouse_face_window; + window = hlinfo->mouse_face_window; if (! NILP (window) && XFRAME (XWINDOW (window)->frame) == f) { - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; } } -#endif /* HAVE_WINDOW_SYSTEM */ - /*********************************************************************** Exposure Events @@ -25382,12 +26350,12 @@ expose_frame (struct frame *f, int x, int y, int w, int h) focus-follows-mouse with delayed raise. --jason 2001-10-12 */ if (mouse_face_overwritten_p && !FRAME_GARBAGED_P (f)) { - Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); - if (f == dpyinfo->mouse_face_mouse_frame) + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + if (f == hlinfo->mouse_face_mouse_frame) { - int x = dpyinfo->mouse_face_mouse_x; - int y = dpyinfo->mouse_face_mouse_y; - clear_mouse_face (dpyinfo); + int x = hlinfo->mouse_face_mouse_x; + int y = hlinfo->mouse_face_mouse_y; + clear_mouse_face (hlinfo); note_mouse_highlight (f, x, y); } } @@ -25974,7 +26942,9 @@ the frame's other specifications determine how to blink the cursor off. */); Vblink_cursor_alist = Qnil; DEFVAR_BOOL ("auto-hscroll-mode", &automatic_hscrolling_p, - doc: /* *Non-nil means scroll the display automatically to make point visible. */); + doc: /* Allow or disallow automatic horizontal scrolling of windows. +If non-nil, windows are automatically scrolled horizontally to make +point visible. */); automatic_hscrolling_p = 1; Qauto_hscroll_mode = intern_c_string ("auto-hscroll-mode"); staticpro (&Qauto_hscroll_mode); @@ -26089,16 +27059,46 @@ baseline. The default value is 1. */); underline_minimum_offset = 1; DEFVAR_BOOL ("display-hourglass", &display_hourglass_p, - doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */); + doc: /* Non-nil means show an hourglass pointer, when Emacs is busy. +This feature only works when on a window system that can change +cursor shapes. */); display_hourglass_p = 1; DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay, - doc: /* *Seconds to wait before displaying an hourglass pointer. -Value must be an integer or float. */); + doc: /* *Seconds to wait before displaying an hourglass pointer when Emacs is busy. */); Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY); hourglass_atimer = NULL; hourglass_shown_p = 0; + + DEFSYM (Qglyphless_char, "glyphless-char"); + DEFSYM (Qhex_code, "hex-code"); + DEFSYM (Qempty_box, "empty-box"); + DEFSYM (Qthin_space, "thin-space"); + DEFSYM (Qzero_width, "zero-width"); + + DEFSYM (Qglyphless_char_display, "glyphless-char-display"); + /* Intern this now in case it isn't already done. + Setting this variable twice is harmless. + But don't staticpro it here--that is done in alloc.c. */ + Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots"); + Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_number (1)); + + DEFVAR_LISP ("glyphless-char-display", &Vglyphless_char_display, + 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: + 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 `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), + Qempty_box); } @@ -26216,5 +27216,3 @@ cancel_hourglass (void) } #endif /* ! WINDOWSNT */ -/* arch-tag: eacc864d-bb6a-4b74-894a-1a4399a1358b - (do not change this comment) */ diff --git a/src/xfaces.c b/src/xfaces.c index 21adb948c91..5c7cfe67607 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1,6 +1,8 @@ /* xfaces.c -- "Face" primitives. - Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -4538,7 +4540,7 @@ uncache_face (struct face_cache *c, struct face *face) Value is the ID of the face found. If no suitable face is found, realize a new one. */ -INLINE int +static INLINE int lookup_face (struct frame *f, Lisp_Object *attr) { struct face_cache *cache = FRAME_FACE_CACHE (f); @@ -6731,7 +6733,8 @@ See `set-face-stipple' for possible values for this variable. */); Vface_default_stipple = make_pure_c_string ("gray3"); DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist, - doc: /* An alist of defined terminal colors and their RGB values. */); + doc: /* An alist of defined terminal colors and their RGB values. +See the docstring of `tty-color-alist' for the details. */); Vtty_defined_color_alist = Qnil; DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed, @@ -6808,5 +6811,3 @@ a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */); #endif } -/* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749 - (do not change this comment) */ diff --git a/src/xfns.c b/src/xfns.c index cb6733e8fa1..32e390e1e1e 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1,7 +1,8 @@ /* Functions for the X window system. - Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -99,6 +100,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <Xm/Xm.h> #include <Xm/DialogS.h> #include <Xm/FileSB.h> +#include <Xm/List.h> +#include <Xm/TextF.h> #endif #ifdef USE_LUCID @@ -516,12 +519,20 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr) 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)); + x_catch_errors (dpy); - if (win == FRAME_X_DISPLAY_INFO (f)->root_window) + if (win == dpyinfo->root_window) win = FRAME_OUTER_WINDOW (f); /* This loop traverses up the containment tree until we hit the root @@ -606,6 +617,33 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr) 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; @@ -3075,25 +3113,11 @@ If FRAME is nil, use the selected frame. */) static void set_machine_and_pid_properties (struct frame *f) { - /* See the above comment "Note: Encoding strategy". */ - XTextProperty text; - int bytes, stringp; - int do_free_text_value = 0; long pid = (long) getpid (); - text.value = x_encode_text (Vsystem_name, - Qcompound_text, 0, &bytes, &stringp, - &do_free_text_value); - text.encoding = (stringp ? XA_STRING - : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT); - text.format = 8; - text.nitems = bytes; - XSetWMClientMachine (FRAME_X_DISPLAY (f), - FRAME_OUTER_WINDOW (f), - &text); - if (do_free_text_value) - xfree (text.value); - + /* This will set WM_CLIENT_MACHINE and WM_LOCALE_NAME. */ + XSetWMProperties (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), NULL, NULL, + NULL, 0, NULL, NULL, NULL); XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), XInternAtom (FRAME_X_DISPLAY (f), @@ -3343,8 +3367,6 @@ This function is an internal primitive--use `make-frame' instead. */) "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, @@ -3578,7 +3600,8 @@ FRAME nil means use the selected frame. */) DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Internal function called by `color-defined-p', which see. */) + doc: /* Internal function called by `color-defined-p', which see +.\(Note that the Nextstep version of this function ignores FRAME.) */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -4096,11 +4119,12 @@ x_display_info_for_name (Lisp_Object name) DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, - doc: /* Open a connection to an X server. + doc: /* Open a connection to a display server. DISPLAY is the name of the display to connect to. Optional second arg XRM-STRING is a string of resources in xrdb format. If the optional third arg MUST-SUCCEED is non-nil, -terminate Emacs if we can't open the connection. */) +terminate Emacs if we can't open the connection. +\(In the Nextstep version, the last two arguments are currently ignored.) */) (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) { unsigned char *xrm_option; @@ -4179,6 +4203,9 @@ DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0, doc: /* If ON is non-nil, report X errors as soon as the erring request is made. +This function only has an effect on X Windows. With MS Windows, it is +defined but does nothing. + If ON is nil, allow buffering of requests. Turning on synchronization prohibits the Xlib routines from buffering requests and seriously degrades performance, but makes debugging much @@ -4213,12 +4240,12 @@ x_sync (FRAME_PTR f) DEFUN ("x-change-window-property", Fx_change_window_property, Sx_change_window_property, 2, 6, 0, doc: /* Change window property PROP to VALUE on the X window of FRAME. -PROP must be a string. -VALUE may be a string or a list of conses, numbers and/or strings. -If an element in the list is a string, it is converted to -an Atom and the value of the Atom is used. If an element is a cons, -it is converted to a 32 bit number where the car is the 16 top bits and the -cdr is the lower 16 bits. +PROP must be a string. VALUE may be a string or a list of conses, +numbers and/or strings. If an element in the list is a string, it is +converted to an atom and the value of the atom is used. If an element +is a cons, it is converted to a 32 bit number where the car is the 16 +top bits and the cdr is the lower 16 bits. + FRAME nil or omitted means use the selected frame. If TYPE is given and non-nil, it is the name of the type of VALUE. If TYPE is not given or nil, the type is STRING. @@ -4226,9 +4253,7 @@ FORMAT gives the size in bits of each element if VALUE is a list. It must be one of 8, 16 or 32. If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8. If OUTER_P is non-nil, the property is changed for the outer X window of -FRAME. Default is to change on the edit X window. - -Value is VALUE. */) +FRAME. Default is to change on the edit X window. */) (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p) { struct frame *f = check_x_frame (frame); @@ -4329,15 +4354,19 @@ DEFUN ("x-window-property", Fx_window_property, Sx_window_property, 1, 6, 0, doc: /* Value is the value of window property PROP on FRAME. If FRAME is nil or omitted, use the selected frame. -If TYPE is nil or omitted, get the property as a string. Otherwise TYPE -is the name of the Atom that denotes the type expected. + +On MS Windows, this function only accepts the PROP and FRAME arguments. + +On X Windows, the following optional arguments are also accepted: +If TYPE is nil or omitted, get the property as a string. +Otherwise TYPE is the name of the atom that denotes the type expected. If SOURCE is non-nil, get the property on that window instead of from FRAME. The number 0 denotes the root window. If DELETE_P is non-nil, delete the property after retreiving it. If VECTOR_RET_P is non-nil, don't return a string but a vector of values. Value is nil if FRAME hasn't a property with name PROP or if PROP has -no value of TYPE. */) +no value of TYPE (always string in the MS Windows case). */) (Lisp_Object prop, Lisp_Object frame, Lisp_Object type, Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p) { struct frame *f = check_x_frame (frame); @@ -4990,7 +5019,7 @@ change the tooltip's appearance. 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 @@ -5007,7 +5036,7 @@ Text larger than the specified size is clipped. */) int root_x, root_y; struct buffer *old_buffer; struct text_pos pos; - int i, width, height; + int i, width, height, seen_reversed_p; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int old_windows_or_buffers_changed = windows_or_buffers_changed; int count = SPECPDL_INDEX (); @@ -5148,7 +5177,7 @@ Text larger than the specified size is clipped. */) try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Compute width and height of the tooltip. */ - width = height = 0; + width = height = seen_reversed_p = 0; for (i = 0; i < w->desired_matrix->nrows; ++i) { struct glyph_row *row = &w->desired_matrix->rows[i]; @@ -5163,19 +5192,74 @@ Text larger than the specified size is clipped. */) row->full_width_p = 1; row_width = row->pixel_width; - /* There's a glyph at the end of rows that is used to place - the cursor there. Don't include the width of this glyph. */ if (row->used[TEXT_AREA]) { - last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; - if (INTEGERP (last->object)) - row_width -= last->pixel_width; + /* There's a glyph at the end of rows that is used to place + the cursor there. Don't include the width of this glyph. */ + if (!row->reversed_p) + { + last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; + if (INTEGERP (last->object)) + row_width -= last->pixel_width; + } + else + { + /* There could be a stretch glyph at the beginning of R2L + rows that is produced by extend_face_to_end_of_line. + Don't count that glyph. */ + struct glyph *g = row->glyphs[TEXT_AREA]; + + if (g->type == STRETCH_GLYPH && INTEGERP (g->object)) + { + row_width -= g->pixel_width; + seen_reversed_p = 1; + } + } } height += row->height; width = max (width, row_width); } + /* If we've seen partial-length R2L rows, we need to re-adjust the + tool-tip frame width and redisplay it again, to avoid over-wide + tips due to the stretch glyph that extends R2L lines to full + width of the frame. */ + if (seen_reversed_p) + { + /* w->total_cols and FRAME_TOTAL_COLS want the width in columns, + not in pixels. */ + width /= WINDOW_FRAME_COLUMN_WIDTH (w); + w->total_cols = make_number (width); + FRAME_TOTAL_COLS (f) = width; + adjust_glyphs (f); + clear_glyph_matrix (w->desired_matrix); + clear_glyph_matrix (w->current_matrix); + try_window (FRAME_ROOT_WINDOW (f), pos, 0); + width = height = 0; + /* Recompute width and height of the tooltip. */ + for (i = 0; i < w->desired_matrix->nrows; ++i) + { + struct glyph_row *row = &w->desired_matrix->rows[i]; + struct glyph *last; + int row_width; + + if (!row->enabled_p || !row->displays_text_p) + break; + row->full_width_p = 1; + row_width = row->pixel_width; + if (row->used[TEXT_AREA] && !row->reversed_p) + { + last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; + if (INTEGERP (last->object)) + row_width -= last->pixel_width; + } + + height += row->height; + width = max (width, row_width); + } + } + /* Add the frame's internal border to the width and height the X window should have. */ height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f); @@ -5299,9 +5383,7 @@ DEFUN ("x-uses-old-gtk-dialog", Fx_uses_old_gtk_dialog, /* Callback for "OK" and "Cancel" on file selection dialog. */ static void -file_dialog_cb (widget, client_data, call_data) - Widget widget; - XtPointer call_data, client_data; +file_dialog_cb (Widget widget, XtPointer client_data, XtPointer call_data) { int *result = (int *) client_data; XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data; @@ -5315,17 +5397,14 @@ file_dialog_cb (widget, client_data, call_data) in this case. */ static void -file_dialog_unmap_cb (widget, client_data, call_data) - Widget widget; - XtPointer call_data, client_data; +file_dialog_unmap_cb (Widget widget, XtPointer client_data, XtPointer call_data) { int *result = (int *) client_data; *result = XmCR_CANCEL; } static Lisp_Object -clean_up_file_dialog (arg) - Lisp_Object arg; +clean_up_file_dialog (Lisp_Object arg) { struct Lisp_Save_Value *p = XSAVE_VALUE (arg); Widget dialog = (Widget) p->pointer; @@ -5345,7 +5424,11 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if specified. If MUSTMATCH is non-nil, the returned file -or directory must exist. ONLY-DIR-P is ignored." */) +or directory must exist. + +This function is only defined on MS Windows, and X Windows with the +Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. +Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p) { int result; @@ -5514,8 +5597,11 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if specified. If MUSTMATCH is non-nil, the returned file -or directory must exist. If ONLY-DIR-P is non-nil, the user can only select -directories. */) +or directory must exist. + +This function is only defined on MS Windows, and X Windows with the +Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. +Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p) { FRAME_PTR f = SELECTED_FRAME (); @@ -6019,5 +6105,3 @@ When using Gtk+ tooltips, the tooltip face is not used. */); #endif /* HAVE_X_WINDOWS */ -/* arch-tag: 55040d02-5485-4d58-8b22-95a7a05f3288 - (do not change this comment) */ diff --git a/src/xftfont.c b/src/xftfont.c index dc82c28b215..a44921a11df 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -32,6 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "blockinput.h" #include "character.h" #include "charset.h" +#include "composite.h" #include "fontset.h" #include "font.h" #include "ftfont.h" @@ -664,6 +665,23 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_b return len; } +Lisp_Object +xftfont_shape (Lisp_Object lgstring) +{ + struct font *font; + struct xftfont_info *xftfont_info; + FT_Face ft_face; + Lisp_Object val; + + CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring), font); + xftfont_info = (struct xftfont_info *) font; + ft_face = XftLockFace (xftfont_info->xftfont); + xftfont_info->ft_size = ft_face->size; + val = ftfont_driver.shape (lgstring); + XftUnlockFace (xftfont_info->xftfont); + return val; +} + static int xftfont_end_for_frame (FRAME_PTR f) { @@ -753,6 +771,9 @@ syms_of_xftfont (void) xftfont_driver.draw = xftfont_draw; xftfont_driver.end_for_frame = xftfont_end_for_frame; xftfont_driver.cached_font_ok = xftfont_cached_font_ok; +#if defined (HAVE_M17N_FLT) && defined (HAVE_LIBOTF) + xftfont_driver.shape = xftfont_shape; +#endif register_font_driver (&xftfont_driver, NULL); } diff --git a/src/xmenu.c b/src/xmenu.c index 68b442388a5..e8be9c6ad4c 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -89,6 +89,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #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" @@ -2532,13 +2535,16 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, #endif /* HAVE_MENUS */ -/* Detect if a dialog or menu has been posted. */ +#ifndef MSDOS +/* Detect if a dialog or menu has been posted. MSDOS has its own + implementation on msdos.c. */ int popup_activated (void) { return popup_activated_flag; } +#endif /* not MSDOS */ /* The following is used by delayed window autoselection. */ @@ -2577,5 +2583,3 @@ syms_of_xmenu (void) #endif } -/* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242 - (do not change this comment) */ diff --git a/src/xml.c b/src/xml.c index a686e55f0b0..fde9d4d382a 100644 --- a/src/xml.c +++ b/src/xml.c @@ -62,7 +62,7 @@ Lisp_Object make_dom (xmlNode *node) return Fnreverse (result); } - else if (node->type == XML_TEXT_NODE) + else if (node->type == XML_TEXT_NODE || node->type == XML_CDATA_SECTION_NODE) { if (node->content) return build_string (node->content); @@ -105,7 +105,8 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int html doc = htmlReadMemory (BYTE_POS_ADDR (CHAR_TO_BYTE (istart)), bytes, burl, "utf-8", HTML_PARSE_RECOVER|HTML_PARSE_NONET| - HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR); + HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR| + HTML_PARSE_NOBLANKS); else doc = xmlReadMemory (BYTE_POS_ADDR (CHAR_TO_BYTE (istart)), bytes, burl, "utf-8", diff --git a/src/xrdb.c b/src/xrdb.c index d2898e1d8f8..90a85e287bb 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -48,6 +48,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "lisp.h" +#ifdef USE_MOTIF +/* For Vdouble_click_time. */ +#include "keyboard.h" +#endif + extern char *getenv (const char *); extern struct passwd *getpwuid (uid_t); diff --git a/src/xselect.c b/src/xselect.c index 7479f245a77..7b91d6f69b9 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2527,14 +2527,26 @@ are ignored. */) (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 @@ are ignored. */) 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 @@ are ignored. */) } x_uncatch_errors (); UNBLOCK_INPUT; - - return Qnil; } diff --git a/src/xsettings.c b/src/xsettings.c index 0d9c9cadb27..83ca87ed0bd 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -627,7 +627,9 @@ init_gconf (void) #if defined (HAVE_GCONF) && defined (HAVE_XFT) char *s; +#ifdef HAVE_G_TYPE_INIT g_type_init (); +#endif gconf_client = gconf_client_get_default (); s = gconf_client_get_string (gconf_client, SYSTEM_MONO_FONT, NULL); if (s) @@ -656,18 +658,10 @@ init_gconf (void) 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); diff --git a/src/xsmfns.c b/src/xsmfns.c index 79dccfa55e1..7b82fd4e61e 100644 --- a/src/xsmfns.c +++ b/src/xsmfns.c @@ -410,8 +410,8 @@ create_client_leader_window (struct x_display_info *dpyinfo, char *client_id) 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; diff --git a/src/xterm.c b/src/xterm.c index d9d908d4396..a571d025571 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1,7 +1,8 @@ /* X Communication module for terminals which understand the X protocol. - Copyright (C) 1989, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 - Free Software Foundation, Inc. + +Copyright (C) 1989, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, + 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -46,9 +47,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <sys/types.h> #endif /* makedev */ -#ifdef HAVE_SYS_IOCTL_H #include <sys/ioctl.h> -#endif /* ! defined (HAVE_SYS_IOCTL_H) */ #include "systime.h" @@ -441,7 +440,6 @@ x_display_info_for_display (Display *dpy) } #define OPAQUE 0xffffffff -#define OPACITY "_NET_WM_WINDOW_OPACITY" void x_set_frame_alpha (struct frame *f) @@ -485,7 +483,7 @@ x_set_frame_alpha (struct frame *f) 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); @@ -503,7 +501,7 @@ x_set_frame_alpha (struct frame *f) } 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 (); @@ -547,22 +545,22 @@ static void x_update_window_begin (struct window *w) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct x_display_info *display_info = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); updated_window = w; set_output_cursor (&w->cursor); BLOCK_INPUT; - if (f == display_info->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { /* Don't do highlighting for mouse motion during the update. */ - display_info->mouse_face_defer = 1; + hlinfo->mouse_face_defer = 1; /* If F needs to be redrawn, simply forget about any prior mouse highlighting. */ if (FRAME_GARBAGED_P (f)) - display_info->mouse_face_window = Qnil; + hlinfo->mouse_face_window = Qnil; } UNBLOCK_INPUT; @@ -602,7 +600,7 @@ x_draw_vertical_window_border (struct window *w, int x, int y0, int y1) static void x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritten_p) { - struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame)); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); if (!w->pseudo_window_p) { @@ -623,9 +621,9 @@ x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritt XTframe_up_to_date to redisplay the mouse highlight. */ if (mouse_face_overwritten_p) { - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; } updated_window = NULL; @@ -639,7 +637,7 @@ static void x_update_end (struct frame *f) { /* Mouse highlight may be displayed again. */ - FRAME_X_DISPLAY_INFO (f)->mouse_face_defer = 0; + MOUSE_HL_INFO (f)->mouse_face_defer = 0; #ifndef XFlush BLOCK_INPUT; @@ -658,17 +656,17 @@ XTframe_up_to_date (struct frame *f) { if (FRAME_X_P (f)) { - struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - if (dpyinfo->mouse_face_deferred_gc - || f == dpyinfo->mouse_face_mouse_frame) + if (hlinfo->mouse_face_deferred_gc + || f == hlinfo->mouse_face_mouse_frame) { BLOCK_INPUT; - if (dpyinfo->mouse_face_mouse_frame) - note_mouse_highlight (dpyinfo->mouse_face_mouse_frame, - dpyinfo->mouse_face_mouse_x, - dpyinfo->mouse_face_mouse_y); - dpyinfo->mouse_face_deferred_gc = 0; + if (hlinfo->mouse_face_mouse_frame) + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, + hlinfo->mouse_face_mouse_x, + hlinfo->mouse_face_mouse_y); + hlinfo->mouse_face_deferred_gc = 0; UNBLOCK_INPUT; } } @@ -969,7 +967,7 @@ x_set_mouse_face_gc (struct glyph_string *s) struct face *face; /* What face has to be used last for the mouse face? */ - face_id = FRAME_X_DISPLAY_INFO (s->f)->mouse_face_face_id; + face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; face = FACE_FROM_ID (s->f, face_id); if (face == NULL) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); @@ -1329,6 +1327,83 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s) } +/* Draw the foreground of glyph string S for glyphless characters. */ + +static void +x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +{ + struct glyph *glyph = s->first_glyph; + XChar2b char2b[8]; + int x, i, j; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (s->face && s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + eabs (s->face->box_line_width); + else + x = s->x; + + s->char2b = char2b; + + for (i = 0; i < s->nchars; i++, glyph++) + { + char buf[7], *str = NULL; + int len = glyph->u.glyphless.len; + + if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (len > 0 + && CHAR_TABLE_P (Vglyphless_char_display) + && (CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) + >= 1)) + { + Lisp_Object acronym + = (! glyph->u.glyphless.for_no_font + ? CHAR_TABLE_REF (Vglyphless_char_display, + glyph->u.glyphless.ch) + : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (STRINGP (acronym)) + str = (char *) SDATA (acronym); + } + } + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) + { + sprintf ((char *) buf, "%0*X", + glyph->u.glyphless.ch < 0x10000 ? 4 : 6, + glyph->u.glyphless.ch); + str = buf; + } + + if (str) + { + int upper_len = (len + 1) / 2; + unsigned code; + + /* It is assured that all LEN characters in STR is ASCII. */ + for (j = 0; j < len; j++) + { + code = s->font->driver->encode_char (s->font, str[j]); + STORE_XCHAR2B (char2b + j, code >> 8, code & 0xFF); + } + s->font->driver->draw (s, 0, upper_len, + x + glyph->slice.glyphless.upper_xoff, + s->ybase + glyph->slice.glyphless.upper_yoff, + 0); + s->font->driver->draw (s, upper_len, len, + x + glyph->slice.glyphless.lower_xoff, + s->ybase + glyph->slice.glyphless.lower_yoff, + 0); + } + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) + XDrawRectangle (s->display, s->window, s->gc, + x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1); + x += glyph->pixel_width; + } +} + #ifdef USE_X_TOOLKIT static struct frame *x_frame_of_widget (Widget); @@ -2655,6 +2730,14 @@ x_draw_glyph_string (struct glyph_string *s) x_draw_composite_glyph_string_foreground (s); break; + case GLYPHLESS_GLYPH: + if (s->for_overlaps) + s->background_filled_p = 1; + else + x_draw_glyph_string_background (s, 1); + x_draw_glyphless_glyph_string_foreground (s); + break; + default: abort (); } @@ -5702,6 +5785,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventp, int *finish, struct frame *f = NULL; struct coding_system coding; XEvent event = *eventp; + Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; *finish = X_EVENT_NORMAL; @@ -6151,12 +6235,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventp, int *finish, /* If mouse-highlight is an integer, input clears out mouse highlighting. */ - if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) + if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) && (f == 0 - || !EQ (f->tool_bar_window, dpyinfo->mouse_face_window))) + || !EQ (f->tool_bar_window, hlinfo->mouse_face_window))) { - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_hidden = 1; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = 1; } #if defined USE_MOTIF && defined USE_TOOLKIT_SCROLL_BARS @@ -6513,12 +6597,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventp, int *finish, f = x_top_window_to_frame (dpyinfo, event.xcrossing.window); if (f) { - if (f == dpyinfo->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { /* If we move outside the frame, then we're certainly no longer on any text in the frame. */ - clear_mouse_face (dpyinfo); - dpyinfo->mouse_face_mouse_frame = 0; + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; } /* Generate a nil HELP_EVENT to cancel a help-echo. @@ -6551,10 +6635,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventp, int *finish, else f = x_window_to_frame (dpyinfo, event.xmotion.window); - if (dpyinfo->mouse_face_hidden) + if (hlinfo->mouse_face_hidden) { - dpyinfo->mouse_face_hidden = 0; - clear_mouse_face (dpyinfo); + hlinfo->mouse_face_hidden = 0; + clear_mouse_face (hlinfo); } #ifdef USE_GTK @@ -6572,7 +6656,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventp, int *finish, 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 @@ -6609,7 +6693,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventp, int *finish, /* If we move outside the frame, then we're certainly no longer on any text in the frame. */ - clear_mouse_face (dpyinfo); + clear_mouse_face (hlinfo); } /* If the contents of the global variable help_echo_string @@ -6711,7 +6795,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventp, int *finish, 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) @@ -7669,44 +7753,43 @@ x_connection_closed (Display *dpy, const char *error_message) delete_frame (frame, Qnoelisp); } - /* We have to close the display to inform Xt that it doesn't - exist anymore. If we don't, Xt will continue to wait for - events from the display. As a consequence, a sequence of - - M-x make-frame-on-display RET :1 RET - ...kill the new frame, so that we get an IO error... - M-x make-frame-on-display RET :1 RET - - will indefinitely wait in Xt for events for display `:1', opened - in the first call to make-frame-on-display. - - Closing the display is reported to lead to a bus error on - OpenWindows in certain situations. I suspect that is a bug - in OpenWindows. I don't know how to circumvent it here. */ - + /* If DPYINFO is null, this means we didn't open the display in the + first place, so don't try to close it. */ if (dpyinfo) { #ifdef USE_X_TOOLKIT - /* If DPYINFO is null, this means we didn't open the display - in the first place, so don't try to close it. */ - { - fatal_error_signal_hook = x_fatal_error_signal; - XtCloseDisplay (dpy); - fatal_error_signal_hook = NULL; - } -#endif + /* We have to close the display to inform Xt that it doesn't + exist anymore. If we don't, Xt will continue to wait for + events from the display. As a consequence, a sequence of + + M-x make-frame-on-display RET :1 RET + ...kill the new frame, so that we get an IO error... + M-x make-frame-on-display RET :1 RET + + will indefinitely wait in Xt for events for display `:1', + opened in the first call to make-frame-on-display. + + Closing the display is reported to lead to a bus error on + OpenWindows in certain situations. I suspect that is a bug + in OpenWindows. I don't know how to circumvent it here. */ + fatal_error_signal_hook = x_fatal_error_signal; + XtCloseDisplay (dpy); + fatal_error_signal_hook = NULL; +#endif /* USE_X_TOOLKIT */ #ifdef USE_GTK - /* Due to bugs in some Gtk+ versions, just exit here if this - is the last display/terminal. */ - if (terminal_list->next_terminal == NULL) - { - fprintf (stderr, "%s\n", error_msg); - Fkill_emacs (make_number (70)); - /* NOTREACHED */ - } - xg_display_close (dpyinfo->display); -#endif + /* A long-standing GTK bug prevents proper disconnect handling + (https://bugzilla.gnome.org/show_bug.cgi?id=85715). Once, + the resulting Glib error message loop filled a user's disk. + To avoid this, kill Emacs unconditionally on disconnect. */ + shut_down_emacs (0, 0, Qnil); + fprintf (stderr, "%s\n\ +When compiled with GTK, Emacs cannot recover from X disconnects.\n\ +This is a GTK bug: https://bugzilla.gnome.org/show_bug.cgi?id=85715\n\ +For details, see etc/PROBLEMS.\n", + error_msg); + abort (); +#endif /* USE_GTK */ /* Indicate that this display is dead. */ dpyinfo->display = 0; @@ -8199,12 +8282,11 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_ 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; @@ -8212,15 +8294,13 @@ wm_supports (struct frame *f, const char *atomname) 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); @@ -8255,10 +8335,10 @@ wm_supports (struct frame *f, const char *atomname) 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); @@ -8276,7 +8356,6 @@ wm_supports (struct frame *f, const char *atomname) } 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; @@ -8288,31 +8367,33 @@ wm_supports (struct frame *f, const char *atomname) } static void -set_wm_state (Lisp_Object frame, int add, const char *what, const char *what2) +set_wm_state (Lisp_Object frame, int add, Atom atom, Atom value) { - 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 */ + 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. @@ -8320,7 +8401,7 @@ x_set_sticky (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) STICKY is set to 1 if the sticky state is set, 0 if not. */ static void -get_current_vm_state (struct frame *f, +get_current_wm_state (struct frame *f, Window window, int *size_state, int *sticky) @@ -8371,7 +8452,7 @@ get_current_vm_state (struct frame *f, 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; @@ -8386,23 +8467,21 @@ get_current_vm_state (struct frame *f, 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; - get_current_vm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy); + get_current_wm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy); /* 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); @@ -8414,33 +8493,38 @@ do_ewmh_fullscreen (struct frame *f) 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; @@ -8470,7 +8554,7 @@ x_handle_net_wm_state (struct frame *f, XPropertyEvent *event) Lisp_Object lval; int sticky = 0; - get_current_vm_state (f, event->window, &value, &sticky); + get_current_wm_state (f, event->window, &value, &sticky); lval = Qnil; switch (value) { @@ -8880,17 +8964,17 @@ x_ewmh_activate_frame (FRAME_PTR f) /* 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))); } } @@ -8910,13 +8994,13 @@ xembed_set_info (struct frame *f, enum xembed_info flags) { 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); } @@ -9300,6 +9384,7 @@ x_free_frame_resources (struct frame *f) struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); Lisp_Object bar; struct scroll_bar *b; + Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; BLOCK_INPUT; @@ -9393,15 +9478,15 @@ x_free_frame_resources (struct frame *f) if (f == dpyinfo->x_highlight_frame) dpyinfo->x_highlight_frame = 0; - if (f == dpyinfo->mouse_face_mouse_frame) + if (f == hlinfo->mouse_face_mouse_frame) { - dpyinfo->mouse_face_beg_row - = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row - = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_window = Qnil; - dpyinfo->mouse_face_deferred_gc = 0; - dpyinfo->mouse_face_mouse_frame = 0; + hlinfo->mouse_face_beg_row + = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row + = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_deferred_gc = 0; + hlinfo->mouse_face_mouse_frame = 0; } UNBLOCK_INPUT; @@ -9778,6 +9863,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) struct terminal *terminal; struct x_display_info *dpyinfo; XrmDatabase xrdb; + Mouse_HLInfo *hlinfo; BLOCK_INPUT; @@ -9908,6 +9994,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo = (struct x_display_info *) xmalloc (sizeof (struct x_display_info)); memset (dpyinfo, 0, sizeof *dpyinfo); + hlinfo = &dpyinfo->mouse_highlight; terminal = x_create_terminal (dpyinfo); @@ -10030,16 +10117,16 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->bitmaps_size = 0; dpyinfo->bitmaps_last = 0; dpyinfo->scratch_cursor_gc = 0; - dpyinfo->mouse_face_mouse_frame = 0; - dpyinfo->mouse_face_deferred_gc = 0; - dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1; - dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1; - dpyinfo->mouse_face_face_id = DEFAULT_FACE_ID; - dpyinfo->mouse_face_window = Qnil; - dpyinfo->mouse_face_overlay = Qnil; - dpyinfo->mouse_face_mouse_x = dpyinfo->mouse_face_mouse_y = 0; - dpyinfo->mouse_face_defer = 0; - dpyinfo->mouse_face_hidden = 0; + hlinfo->mouse_face_mouse_frame = 0; + hlinfo->mouse_face_deferred_gc = 0; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_overlay = Qnil; + hlinfo->mouse_face_mouse_x = hlinfo->mouse_face_mouse_y = 0; + hlinfo->mouse_face_defer = 0; + hlinfo->mouse_face_hidden = 0; dpyinfo->x_focus_frame = 0; dpyinfo->x_focus_event_frame = 0; dpyinfo->x_highlight_frame = 0; @@ -10107,88 +10194,97 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) 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; @@ -10682,9 +10778,11 @@ selected window or cursor position is preserved. */); x_mouse_click_focus_ignore_position = 0; DEFVAR_LISP ("x-toolkit-scroll-bars", &Vx_toolkit_scroll_bars, - doc: /* What X toolkit scroll bars Emacs uses. -A value of nil means Emacs doesn't use X toolkit scroll bars. -Otherwise, value is a symbol describing the X toolkit. */); + doc: /* Which toolkit scroll bars Emacs uses, if any. +A value of nil means Emacs doesn't use toolkit scroll bars. +With the X Window system, the value is a symbol describing the +X toolkit. Possible values are: gtk, motif, xaw, or xaw3d. +With MS Windows, the value is t. */); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_MOTIF Vx_toolkit_scroll_bars = intern_c_string ("motif"); @@ -10750,5 +10848,3 @@ default is nil, which is the same as `super'. */); #endif /* HAVE_X_WINDOWS */ -/* arch-tag: 6d4e4cb7-abc1-4302-9585-d84dcfb09d0f - (do not change this comment) */ diff --git a/src/xterm.h b/src/xterm.h index d884945f985..fbfb043601a 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -190,36 +190,9 @@ struct x_display_info /* Reusable Graphics Context for drawing a cursor in a non-default face. */ GC scratch_cursor_gc; - /* These variables describe the range of text currently shown in its - mouse-face, together with the window they apply to. As long as - the mouse stays within this range, we need not redraw anything on - its account. Rows and columns are glyph matrix positions in - MOUSE_FACE_WINDOW. */ - int mouse_face_beg_row, mouse_face_beg_col; - int mouse_face_beg_x, mouse_face_beg_y; - int mouse_face_end_row, mouse_face_end_col; - int mouse_face_end_x, mouse_face_end_y; - int mouse_face_past_end; - Lisp_Object mouse_face_window; - int mouse_face_face_id; - Lisp_Object mouse_face_overlay; - - /* 1 if a mouse motion event came and we didn't handle it right away because - gc was in progress. */ - int mouse_face_deferred_gc; - - /* FRAME and X, Y position of mouse when last checked for - highlighting. X and Y can be negative or out of range for the frame. */ - struct frame *mouse_face_mouse_frame; - int mouse_face_mouse_x, mouse_face_mouse_y; - - /* Nonzero means defer mouse-motion highlighting. */ - int mouse_face_defer; - - /* Nonzero means that the mouse highlight should not be shown. */ - int mouse_face_hidden; - - int mouse_face_image_state; + /* Information about the range of text currently shown in + mouse-face. */ + Mouse_HLInfo mouse_highlight; char *x_id_name; @@ -297,7 +270,7 @@ struct x_display_info 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 @@ -359,15 +332,17 @@ struct x_display_info /* 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; @@ -375,6 +350,11 @@ struct x_display_info /* 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 @@ -1038,6 +1018,13 @@ extern void x_handle_selection_notify (XSelectionEvent *); 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 *, diff --git a/test/ChangeLog b/test/ChangeLog index feae114f862..3b1921c5987 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,17 @@ +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. + +2010-10-23 Glenn Morris <rgm@gnu.org> + + * comint-testsuite.el + (comint-testsuite--test-comint-password-prompt-regexp): + Add "Please enter the password". (Bug#7224) + 2010-09-20 Stefan Monnier <monnier@iro.umontreal.ca> * indent/prolog.prolog: Use normal spacing around !. diff --git a/test/comint-testsuite.el b/test/comint-testsuite.el index 35b946cf3da..9a4e7eae3b7 100644 --- a/test/comint-testsuite.el +++ b/test/comint-testsuite.el @@ -34,7 +34,8 @@ (interactive) (let ((password-strings '("foo@example.net's password: " ;ssh - "Password for foo@example.org: " ; knit + "Password for foo@example.org: " ; kinit + "Please enter the password for foo@example.org: " ; kinit "Kerberos password for devnull/root <at> GNU.ORG: " ; ksu "Enter passphrase: " ; ssh-add "Enter passphrase (empty for no passphrase): " ; ssh-keygen diff --git a/test/indent/modula2.mod b/test/indent/modula2.mod new file mode 100644 index 00000000000..f8fbcb7f4e5 --- /dev/null +++ b/test/indent/modula2.mod @@ -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. diff --git a/test/indent/octave.m b/test/indent/octave.m index dc6f8448152..768f3d85e01 100644 --- a/test/indent/octave.m +++ b/test/indent/octave.m @@ -17,15 +17,21 @@ function res = tcomp (fn) cnty = repmat(x(:,1)(:), 10, 1); pop = x(:,1:10)(:); - bir = x(:,11:20)(:); - dth = x(:,21:30)(:); - imig = x(:,31:40)(:); - dmig = x(:,41:50)(:); - gq = x(:,51:60)(:); - - yrs = repmat(2000:2009, 39, 1)(:); - - res = [yrs, cnty, pop, bir, dth, imig, dmig, gq]; + ## Here and below, we test if the indentation aligns with a previous + ## fixindented line. This is important so as to make it easier for the + ## user to verride some indentation somewhere, and also because it + ## reflects the fact that the indentation decision is taken with a minimum + ## amount of work (i.e. in the present case, without having to walk back + ## until the `function' line). + bir = x(:,11:20)(:); # fixindent + dth = x(:,21:30)(:); + imig = x(:,31:40)(:); + dmig = x(:,41:50)(:); + gq = x(:,51:60)(:); + + yrs = repmat(2000:2009, 39, 1)(:); + + res = [yrs, cnty, pop, bir, dth, imig, dmig, gq]; endfunction |